Gupta.narod.ru - примеры программирования на Gupta Team Developer 2005 (GTD, CTD, TOM, Quest, SQLTalk, Report Builder, SQLWindows, SQLBase, Oracle, Web Developer, Team Object Manager)
Return to http://gupta.narod.ru/
.head 0 + Application Description: Centura Builder starter application
.head 1 - Outline Version - 4.0.28
.head 1 + Design-time Settings
.data VIEWINFO
0000: 6F00000001000000 FFFF01000D004347 5458566965775374 6174650400010000
0020: 0000000000A50000 002C000000020000 0003000000FFFFFF FFFFFFFFFFFCFFFF
0040: FFE9FFFFFF000000 0000000000900200 0039010000010000 0001000000010000
0060: 000F4170706C6963 6174696F6E497465 6D00000000
.enddata
.head 2 - Outline Window State: Normal
.head 2 + Outline Window Location and Size
.data VIEWINFO
0000: 6600040003002D00 0000000000000000 0000B71E5D0E0500 1D00FFFF4D61696E
0020: 0000000000000000 0000000000000000 0000003B00010000 00000000000000E9
0040: 1E800A00008600FF FF496E7465726E61 6C2046756E637469 6F6E730000000000
0060: 0000000000000000 0000000000003200 0100000000000000 0000E91E800A0000
0080: DF00FFFF56617269 61626C6573000000 0000000000000000 0000000000000000
00A0: 3000010000000000 00000000F51E100D 0000F400FFFF436C 6173736573000000
00C0: 0000000000000000 0000000000000000
.enddata
.data VIEWSIZE
0000: D000
.enddata
.head 3 - Left: -0.013"
.head 3 - Top: 0.0"
.head 3 - Width: 8.013"
.head 3 - Height: 4.969"
.head 2 + Options Box Location
.data VIEWINFO
0000: D4180909B80B1A00
.enddata
.data VIEWSIZE
0000: 0800
.enddata
.head 3 - Visible? No
.head 3 - Left: 4.15"
.head 3 - Top: 1.885"
.head 3 - Width: 3.8"
.head 3 - Height: 2.073"
.head 2 + Class Editor Location
.head 3 - Visible? No
.head 3 - Left: 0.575"
.head 3 - Top: 0.094"
.head 3 - Width: 5.063"
.head 3 - Height: 2.719"
.head 2 + Tool Palette Location
.head 3 - Visible? No
.head 3 - Left: 6.388"
.head 3 - Top: 0.729"
.head 2 - Fully Qualified External References? Yes
.head 2 - Reject Multiple Window Instances? No
.head 2 - Enable Runtime Checks Of External References? Yes
.head 2 - Use Release 4.0 Scope Rules? No
.head 1 + Libraries
.head 2 - File Include: vtlbx.apl
.head 2 - File Include: vtdos.apl
.head 2 - File Include: vtstr.apl
.head 2 - File Include: vtarray.apl
.head 2 - File Include: vtcomm.apl
.head 2 - File Include: vtmisc.apl
.head 1 + Global Declarations
.head 2 + Window Defaults
.head 3 + Tool Bar
.head 4 - Display Style? Etched
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Form Window
.head 4 - Display Style? Etched
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Dialog Box
.head 4 - Display Style? Etched
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Top Level Table Window
.head 4 - Font Name: MS Sans Serif
.head 4 - Font Size: 8
.head 4 - Font Enhancement: System Default
.head 4 - Text Color: System Default
.head 4 - Background Color: System Default
.head 3 + Data Field
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Multiline Field
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Spin Field
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Background Text
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Pushbutton
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 3 + Radio Button
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Check Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Option Button
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 3 + Group Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Child Table Window
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + List Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Combo Box
.head 4 - Font Name: Use Parent
.head 4 - Font Size: Use Parent
.head 4 - Font Enhancement: Use Parent
.head 4 - Text Color: Use Parent
.head 4 - Background Color: Use Parent
.head 3 + Line
.head 4 - Line Color: Use Parent
.head 3 + Frame
.head 4 - Border Color: Use Parent
.head 4 - Background Color: 3D Face Color
.head 3 + Picture
.head 4 - Border Color: Use Parent
.head 4 - Background Color: Use Parent
.head 2 + Formats
.head 3 - Number: 0'%'
.head 3 - Number: #0
.head 3 - Number: ###000
.head 3 - Number: ###000;'($'###000')'
.head 3 - Date/Time: hhh:mm:ss AMPM
.head 3 - Date/Time: M/d/yy
.head 3 - Date/Time: MM-dd-yy
.head 3 - Date/Time: dd-MMM-yyyy
.head 3 - Date/Time: MMM d, yyyy
.head 3 - Date/Time: MMM d, yyyy hhh:mm AMPM
.head 3 - Date/Time: MMMM d, yyyy hhh:mm AMPM
.head 2 + External Functions
.head 3 + ! Library name: vtexplor.dll
.head 4 - ThreadSafe: No
.head 4 + Function: VisDesktopSize
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 - Parameters
.head 4 + Function: VisDesktopStr
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 + Parameters
.head 6 - Receive String: LPSTR
.head 6 - Number: DWORD
.head 4 + Function: VisMyComputerSize
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 - Parameters
.head 4 + Function: VisMyComputerStr
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 + Parameters
.head 6 - Receive String: LPSTR
.head 6 - Number: DWORD
.head 4 + Function: VisNetExists
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Boolean: BOOL
.head 5 - Parameters
.head 4 + Function: VisNetNeighborhoodSize
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 - Parameters
.head 4 + Function: VisNetNeighborhoodStr
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 + Parameters
.head 6 - Receive String: LPSTR
.head 6 - Number: DWORD
.head 4 + Function: VisNetOpenEnum
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: HANDLE
.head 5 + Parameters
.head 6 - Number: LPVOID
.head 4 + Function: VisNetCloseEnum
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Boolean: BOOL
.head 5 + Parameters
.head 6 - Number: HANDLE
.head 4 + Function: VisNetFreeResource
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Boolean: BOOL
.head 5 + Parameters
.head 6 - Number: LPVOID
.head 4 + Function: VisNetEnumResource
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: LPVOID
.head 5 + Parameters
.head 6 - Number: HANDLE
.head 4 + Function: VisNetGetResourceInt
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 + Parameters
.head 6 - Number: LPVOID
.head 6 - Number: DWORD
.head 4 + Function: VisNetGetResourceSize
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 + Parameters
.head 6 - Number: LPVOID
.head 6 - Number: DWORD
.head 4 + Function: VisNetGetResourceStr
.head 5 - Description:
.head 5 - Export Ordinal: 0
.head 5 + Returns
.head 6 - Number: DWORD
.head 5 + Parameters
.head 6 - Number: LPVOID
.head 6 - Number: DWORD
.head 6 - Receive String: LPSTR
.head 6 - Number: DWORD
.head 2 + Constants
.data CCDATA
0000: 3000000000000000 0000000000000000 00000000
.enddata
.data CCSIZE
0000: 1400
.enddata
.head 3 + System
.head 4 - !
.head 4 - ! *** Visual Toolchest - VTEXPLOR.APL
.head 4 - String: VTEXPLOR_DLLName = 'vtexplor.dll'
.head 4 - !
.head 4 - ! *** Network Resource constants
.head 4 - Number: RESOURCE_Connected = 1
.head 4 - Number: RESOURCE_GlobalNet = 2
.head 4 - Number: RESOURCE_Remembered = 3
.head 4 - Number: RESOURCE_Recent = 4
.head 4 - Number: RESOURCE_Context = 5
.head 4 - Number: RESOURCE_Type_Any = 0
.head 4 - Number: RESOURCE_Type_Disk = 1
.head 4 - Number: RESOURCE_Type_Print = 2
.head 4 - Number: RESOURCE_Type_Unknown = -1
.head 4 - Number: RESOURCE_Usage_Connectable = 1
.head 4 - Number: RESOURCE_Usage_Container = 2
.head 4 - Number: RESOURCE_DisplayType_Generic = 0
.head 4 - Number: RESOURCE_DisplayType_Domain = 1
.head 4 - Number: RESOURCE_DisplayType_Server = 2
.head 4 - Number: RESOURCE_DisplayType_Share = 3
.head 4 - Number: RESOURCE_DisplayType_File = 4
.head 4 - Number: RESOURCE_DisplayType_Group = 5
.head 4 - Number: RESOURCE_DisplayType_Provider = 6
.head 4 - Number: RESOURCE_DisplayType_Entire = 7
.head 4 - Number: RESOURCE_DisplayType_Tree = 10
.head 4 - !
.head 4 - ! *** Network Resource offsets for VisGetNetResource( )
.head 4 - Number: RESOURCEITEM_Scope = 0
.head 4 - Number: RESOURCEITEM_Type = 1
.head 4 - Number: RESOURCEITEM_DisplayType = 2
.head 4 - Number: RESOURCEITEM_Usage = 3
.head 4 - Number: RESOURCEITEM_LocalName = 4
.head 4 - Number: RESOURCEITEM_RemoteName = 5
.head 4 - Number: RESOURCEITEM_Comment = 6
.head 4 - Number: RESOURCEITEM_Provider = 7
.head 4 - !
.head 4 - ! ***** Picture names (these pictures are in the VTEXPLOR DLL)
.head 4 - String: VTPIC_Default = 'default'
.head 4 - String: VTPIC_NetworkServer = 'server'
.head 4 - String: VTPIC_NetworkGroup = 'wkgroup'
.head 4 - String: VTPIC_NetworkProvider = 'provider'
.head 4 - String: VTPIC_EntireNetwork = 'entire'
.head 4 - String: VTPIC_NetworkTree = 'tree'
.head 4 - !
.head 4 - ! ***** List Box Item Flags
.head 4 - Number: ITEM_IsDirectory = 0x00800000
.head 4 - Number: ITEM_IsRoot = 0x00400000
.head 3 - User
.head 3 - Enumerations
.head 2 - Resources
.head 2 - Variables
.head 2 - Internal Functions
.head 2 - Named Menus
.head 2 + Class Definitions
.data RESOURCE 0 0 1 2434750800
0000: 9B02000020010000 0000000000000000 0200000200FFFF01 00160000436C6173
0020: 73566172004F7574 6C696E6552006567 496E666FDD003C00 001063004578706C
0040: 6F726572004C6973 74426F78BE800100 001100000007010D 000000FFFFC90D00
0060: 0001FD00FF071A00 000001F700FF1F27 0000DC000100FF7F 34700000000100FF
0080: FFC14100000001FD 00FF074E00000001 F700FF1F5B0000DC 000100FF7F687000
00A0: 00000100FFFFC175 00000001FD00FF07 8200000001F700FF 1F8F0000DC000100
00C0: FF7F9C7000000001 00FFFFC1A9000000 01FD00FF07B60000 0001F700FF1FC300
00E0: 00DC000100FF7FD0 700000000100FFFF 2101804100000102 00000D63526164F0
0100: 696F4C6901860000 000500009E00010D FD00FF270D000001 F700FFDF1ADC0001
0120: 00FF7F2773000100 FFFFCD340001FD00 FF07
.enddata
.head 3 - !
.head 3 - ! *** Visual Toolchest - VTEXPLOR.APL
.head 3 - !
.head 3 + ! List Box Class: cExplorerListBox
.winattr
.head 4 - Window Location and Size
.head 5 - Left: Default
.head 5 - Top: Default
.head 5 - Width: 1.2"
.head 5 - Width Editable? Yes
.head 5 - Height: 0.717"
.head 5 - Height Editable? Yes
.head 4 - Visible? Yes
.head 4 - Multiple selection? No
.head 4 - Sorted? Yes
.head 4 - Vertical Scroll? Yes
.head 4 - Font Name: Default
.head 4 - Font Size: Default
.head 4 - Font Enhancement: None
.head 4 - Text Color: Default
.head 4 - Background Color: Default
.head 4 - List in Tool Palette? Yes
.head 4 - Property Template:
.head 4 - Class DLL Name:
.end
.head 4 - Description: Displays directory tree in a listbox similar to Win95
.head 4 + Derived From
.head 5 - Class: cOutline
.head 5 - Class: cListBoxExtension
.head 4 + Class Variables
.head 5 - Number: nLoadCount
.head 5 - Number: hPicDrvCD
.head 5 - Number: hPicDrvFloppy
.head 5 - Number: hPicDrvFixed
.head 5 - Number: hPicDrvNet
.head 5 - Number: hPicDrvRAM
.head 5 - Number: hPicFldrOpen
.head 5 - Number: hPicFldr
.head 5 - Number: hPicDesktop
.head 5 - Number: hPicMyComputer
.head 5 - Number: hPicNetNeighborhood
.head 5 - Number: hPicDefault
.head 5 - Number: hPicNetServer
.head 5 - Number: hPicNetGroup
.head 5 - Number: hPicNetProvider
.head 5 - Number: hPicEntireNet
.head 5 - Number: hPicNetTree
.head 4 + Instance Variables
.head 5 - Number: hItemRoot
.head 5 - Number: hItemDesktop
.head 5 - Number: hItemNetNeighborhood
.head 5 - Number: hItemMyComputer
.head 4 + Functions
.head 5 + Function: Collapse
.head 6 - Description:
.head 6 - Returns
.head 6 + Parameters
.head 7 - Number: nIndex
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nCount
.head 7 - Number: nPos
.head 6 + Actions
.head 7 + Loop
.head 8 - Set nCount = SalListQueryCount( hWndItem )
.head 8 - Set nPos = VisListGetFocusIndex( hWndItem )
.head 8 + If VisListCollapse( hWndItem, nIndex )
.head 9 - Set nCount = nCount - SalListQueryCount( hWndItem )
.head 9 + If nPos > nIndex + nCount
.head 10 - Call VisListSetFocusIndex( hWndItem, nPos - nCount )
.head 9 + Else If nPos > nIndex
.head 10 - Call VisListSetFocusIndex( hWndItem, nIndex )
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 5 + Function: EnumDirectory
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - Number: hDirectory
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - String: sChildDir
.head 7 - String: sDirs[*]
.head 7 - Number: nValues[*]
.head 7 - Number: nFlags[*]
.head 7 - Number: nNumItems
.head 7 - Number: nCount
.head 6 + Actions
.head 7 + If VisListGetItemFlags( hDirectory ) & ( ITEM_IsParent | ITEM_CanExpand ) = ITEM_CanExpand
.head 8 - Set sChildDir = GetItemDir( hDirectory )
.head 8 - Set nNumItems = VisDosEnumDirs( sChildDir || '*.*', sDirs )
.head 8 + If nNumItems > 0
.head 9 - Call VisArraySort( sDirs, SORT_Ascending, DT_String )
.head 9 - Call VisArrayFillNumber( nValues, 0, nNumItems )
.head 9 - Call VisArrayFillNumber( nFlags, ITEM_IsDirectory, nNumItems )
.head 9 - !
.head 9 - ! ***** Get handles to children just loaded
.head 9 - Set nCount = 0
.head 9 + While nCount < nNumItems
.head 10 - !
.head 10 - ! ***** If subdirectories exist, set ITEM_CanExpand flag to display corners
.head 10 + If VisDosIsParent( sChildDir || sDirs[nCount] )
.head 11 - Set nFlags[nCount] = ITEM_CanExpand | ITEM_IsDirectory
.head 10 - Set nCount = nCount + 1
.head 9 - !
.head 9 - ! ***** Insert all directories as children
.head 9 + Loop
.head 10 + If VisListLoadChildren( hWndItem, hDirectory, hPicFldr, hPicFldrOpen, sDirs, nValues, nFlags ) = nNumItems
.head 11 - Break
.head 10 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 11 - Call SalQuit()
.head 9 - Return nNumItems
.head 7 - Return 0
.head 5 + Function: EnumDrives
.head 6 - Description:
.head 6 - Returns
.head 6 + Parameters
.head 7 - Number: hItemMyComputer
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nIndex
.head 7 - Number: nNumDrives
.head 7 - String: sDrives[*]
.head 7 - Number: nDriveType
.head 7 - String: sText
.head 7 - Number: hItem
.head 7 - String: sNetName
.head 7 - Number: nPos
.head 7 - Number: nLength
.head 7 - String: sShareName
.head 7 - String: sServerName
.head 6 + Actions
.head 7 - Set nIndex = 0
.head 7 - Set nNumDrives = VisDosEnumDrives( sDrives )
.head 7 + While nIndex < nNumDrives
.head 8 - !
.head 8 - ! ***** Format text based on drive type
.head 8 - Set nDriveType = VisDosGetDriveType( sDrives[nIndex] )
.head 8 + Select Case nDriveType
.head 9 + Case DRIVE_Floppy
.head 10 - Set sText = 'Floppy (' || sDrives[nIndex] || ')'
.head 10 + Loop
.head 11 - Set hItem = VisListLoadChild( hWndItem, hItemMyComputer, hPicDrvFloppy, hPicDrvFloppy, sText, 0, ITEM_CanExpand | ITEM_IsRoot )
.head 11 + If hItem
.head 12 - Break
.head 11 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 12 - Call SalQuit()
.head 10 - Break
.head 9 + Case DRIVE_Fixed
.head 10 - Set sText = VisDosGetVolumeLabel( sDrives[nIndex] || '\\' ) || ' (' || sDrives[nIndex] || ')'
.head 10 + Loop
.head 11 - Set hItem = VisListLoadChild( hWndItem, hItemMyComputer, hPicDrvFixed, hPicDrvFixed, sText, 0, ITEM_CanExpand | ITEM_IsRoot )
.head 11 + If hItem
.head 12 - Break
.head 11 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 12 - Call SalQuit()
.head 10 - Break
.head 9 + Case DRIVE_Network
.head 10 - !
.head 10 - ! ***** Get server name and share name
.head 10 - Set sNetName = VisDosGetNetName( sDrives[nIndex] )
.head 10 - Set nPos = VisStrScanReverse( sNetName, -1, '\\' )
.head 10 - Set nLength = SalStrLength( sNetName )
.head 10 - Set sShareName = VisStrProper( SalStrRightX( sNetName, nLength - nPos - 1 ) )
.head 10 - Set sServerName = VisStrProper( SalStrMidX( sNetName, 2, nPos - 2 ) )
.head 10 - !
.head 10 - ! ***** Format network drive
.head 10 - Set sText = sShareName || ' on \'' || sServerName || '\' (' || sDrives[nIndex] || ')'
.head 10 + Loop
.head 11 - Set hItem = VisListLoadChild( hWndItem, hItemMyComputer, hPicDrvNet, hPicDrvNet, sText, 0, ITEM_CanExpand | ITEM_IsRoot )
.head 11 + If hItem
.head 12 - Break
.head 11 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 12 - Call SalQuit()
.head 10 - Break
.head 9 + Case DRIVE_RAM
.head 10 - Set sText = VisDosGetVolumeLabel( sDrives[nIndex] || '\\' ) || ' (' || sDrives[nIndex] || ')'
.head 10 + Loop
.head 11 - Set hItem = VisListLoadChild( hWndItem, hItemMyComputer, hPicDrvRAM, hPicDrvRAM, sText, 0, ITEM_CanExpand | ITEM_IsRoot )
.head 11 + If hItem
.head 12 - Break
.head 11 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 12 - Call SalQuit()
.head 10 - Break
.head 9 + Case DRIVE_CDROM
.head 10 - Set sText = VisDosGetVolumeLabel( sDrives[nIndex] || '\\' ) || ' (' || sDrives[nIndex] || ')'
.head 10 + Loop
.head 11 - Set hItem = VisListLoadChild( hWndItem, hItemMyComputer, hPicDrvCD, hPicDrvCD, sText, 0, ITEM_CanExpand | ITEM_IsRoot )
.head 11 + If hItem
.head 12 - Break
.head 11 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 12 - Call SalQuit()
.head 10 - Break
.head 8 - !
.head 8 - ! ***** Increment to next drive
.head 8 - Set nIndex = nIndex + 1
.head 5 + Function: EnumNeighborhood
.head 6 - Description:
.head 6 - Returns
.head 6 + Parameters
.head 7 - Number: hItemNetNeighborhood
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nEnum
.head 7 - Number: nResource
.head 7 - Number: nCount
.head 7 - Number: nIndex
.head 7 - Number: nSize
.head 7 - String: sName
.head 7 - String: sNames[*]
.head 7 - Number: hPics[*]
.head 7 - Number: nValues[*]
.head 7 - Number: nFlags[*]
.head 6 + Actions
.head 7 + If VisListGetItemFlags( hItemNetNeighborhood ) & ( ITEM_IsParent | ITEM_CanExpand ) = ITEM_CanExpand
.head 8 - Set nEnum = VisNetOpenEnum( 0 )
.head 8 + If nEnum
.head 9 - Set nResource = VisNetEnumResource( nEnum )
.head 9 + While nResource
.head 10 + If VisNetGetResourceInt( nResource, RESOURCEITEM_Usage ) & RESOURCE_Usage_Container
.head 11 - Set nCount = RESOURCEITEM_RemoteName
.head 11 + Loop
.head 12 - Set nSize = VisNetGetResourceSize( nResource, nCount )
.head 12 + If nSize
.head 13 - Set sName = ''
.head 13 - Call SalStrSetBufferLength( sName, nSize )
.head 13 - Call VisNetGetResourceStr( nResource, nCount, sName, nSize )
.head 13 + If VisNetGetResourceInt( nResource, RESOURCEITEM_DisplayType ) = RESOURCE_DisplayType_Entire
.head 14 - Call VisListLoadChild( hWndItem, hItemNetNeighborhood, hPicEntireNet, hPicEntireNet, sName, nResource, ITEM_CanExpand )
.head 13 + Else
.head 14 - Set sName = GetShortName( SalStrTrimX( sName ) )
.head 14 + If not SalArrayIsEmpty( sNames )
.head 15 - Call VisArrayInsertItem( sNames, 0, DT_String )
.head 14 - Set sNames[0] = sName
.head 14 - Call VisArraySort( sNames, SORT_Ascending, DT_String )
.head 14 - Set nIndex = VisArrayFindString( sNames, sName )
.head 14 - Call SalArrayGetUpperBound( sNames, 1, nCount )
.head 14 + While nIndex < nCount and sNames[ nIndex + 1 ] = sName
.head 15 - Set nIndex = nIndex + 1
.head 14 - Call VisArrayInsertItem( hPics, nIndex, DT_Number )
.head 14 - Set hPics[nIndex] = GetPicOfType( VisNetGetResourceInt( nResource, RESOURCEITEM_DisplayType ) )
.head 14 - Call VisArrayInsertItem( nValues, nIndex, DT_Number )
.head 14 - Set nValues[nIndex] = nResource
.head 14 - Call VisArrayInsertItem( nFlags, nIndex, DT_Number )
.head 14 + If VisNetGetResourceInt( nResource, RESOURCEITEM_Usage ) & RESOURCE_Usage_Connectable
.head 15 - Set nFlags[nIndex] = ITEM_IsRoot | ITEM_CanExpand
.head 14 + Else If VisNetGetResourceInt( nResource, RESOURCEITEM_Usage ) & RESOURCE_Usage_Container
.head 15 - Set nFlags[nIndex] = ITEM_CanExpand
.head 14 + Else
.head 15 - Set nFlags[nIndex] = 0
.head 13 - Break
.head 12 - Set nCount = nCount + 1
.head 12 + If nCount > RESOURCEITEM_Provider
.head 13 - Call VisNetFreeResource( nResource )
.head 13 - Break
.head 10 + Else
.head 11 - Call VisNetFreeResource( nResource )
.head 10 - Set nResource = VisNetEnumResource( nEnum )
.head 9 - Call VisNetCloseEnum( nEnum )
.head 9 + If not SalArrayIsEmpty( sNames )
.head 10 - Call SalArrayGetUpperBound( sNames, 1, nCount )
.head 10 - Set nIndex = 0
.head 10 + While nIndex <= nCount
.head 11 + If not VisListLoadChild( hWndItem, hItemNetNeighborhood, hPics[nIndex], hPics[nIndex], sNames[nIndex], nValues[nIndex], nFlags[nIndex] )
.head 12 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 13 - Call SalQuit()
.head 11 - Set nIndex = nIndex + 1
.head 5 + Function: EnumNetwork
.head 6 - Description:
.head 6 - Returns
.head 6 + Parameters
.head 7 - Number: hItemNetwork
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nHandle
.head 7 - Number: nResource
.head 7 - Number: nCount
.head 7 - Number: nIndex
.head 7 - Number: nSize
.head 7 - String: sName
.head 7 - String: sNames[*]
.head 7 - Number: hPics[*]
.head 7 - Number: nValues[*]
.head 7 - Number: nFlags[*]
.head 6 + Actions
.head 7 + If VisListGetItemFlags( hItemNetwork ) & ( ITEM_IsParent | ITEM_CanExpand ) = ITEM_CanExpand
.head 8 - Set nHandle = VisNetOpenEnum( VisListGetItemValue( hItemNetwork ) )
.head 8 + If nHandle
.head 9 - Set nResource = VisNetEnumResource( nHandle )
.head 9 + While nResource
.head 10 - Set nCount = RESOURCEITEM_RemoteName
.head 10 + Loop
.head 11 - Set nSize = VisNetGetResourceSize( nResource, nCount )
.head 11 + If nSize
.head 12 - Set sName = ''
.head 12 - Call SalStrSetBufferLength( sName, nSize )
.head 12 - Call VisNetGetResourceStr( nResource, nCount, sName, nSize )
.head 12 - Set sName = GetShortName( SalStrTrimX( sName ) )
.head 12 + If not SalArrayIsEmpty( sNames )
.head 13 - Call VisArrayInsertItem( sNames, 0, DT_String )
.head 12 - Set sNames[0] = sName
.head 12 - Call VisArraySort( sNames, SORT_Ascending, DT_String )
.head 12 - Set nIndex = VisArrayFindString( sNames, sName )
.head 12 - Call VisArrayInsertItem( hPics, nIndex, DT_Number )
.head 12 - Set hPics[nIndex] = GetPicOfType( VisNetGetResourceInt( nResource, RESOURCEITEM_DisplayType ) )
.head 12 - Call VisArrayInsertItem( nValues, nIndex, DT_Number )
.head 12 - Set nValues[nIndex] = nResource
.head 12 - Call VisArrayInsertItem( nFlags, nIndex, DT_Number )
.head 12 + If VisNetGetResourceInt( nResource, RESOURCEITEM_Usage ) & RESOURCE_Usage_Connectable
.head 13 - Set nFlags[nIndex] = ITEM_IsRoot | ITEM_CanExpand
.head 12 + Else If VisNetGetResourceInt( nResource, RESOURCEITEM_Usage ) & RESOURCE_Usage_Container
.head 13 - Set nFlags[nIndex] = ITEM_CanExpand
.head 12 + Else
.head 13 - Set nFlags[nIndex] = 0
.head 12 - Break
.head 11 - Set nCount = nCount + 1
.head 11 + If nCount > RESOURCEITEM_Provider
.head 12 - Call VisNetFreeResource( nResource )
.head 12 - Break
.head 10 - Set nResource = VisNetEnumResource( nHandle )
.head 9 - Call VisNetCloseEnum( nHandle )
.head 9 + If not SalArrayIsEmpty( sNames )
.head 10 - Call SalArrayGetUpperBound( sNames, 1, nCount )
.head 10 - Set nIndex = 0
.head 10 + While nIndex <= nCount
.head 11 - Call VisListLoadChild( hWndItem, hItemNetwork, hPics[nIndex], hPics[nIndex], sNames[nIndex], nValues[nIndex], nFlags[nIndex] )
.head 11 - Set nIndex = nIndex + 1
.head 5 + Function: Expand
.head 6 - Description:
.head 6 - Returns
.head 6 + Parameters
.head 7 - Number: nIndex
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nPos
.head 7 - Number: nCount
.head 7 - Number: nNumItems
.head 7 - Number: nTop
.head 7 - Number: nBottom
.head 6 + Actions
.head 7 - Set nPos = VisListGetFocusIndex( hWndItem )
.head 7 - Set nCount = SalListQueryCount( hWndItem )
.head 7 + If VisListExpand( hWndItem, nIndex )
.head 8 - Set nCount = SalListQueryCount( hWndItem ) - nCount
.head 8 - Set nNumItems = VisListGetVisibleRange( hWndItem, nTop, nBottom )
.head 8 + If nPos > nIndex
.head 9 - Call VisListSetFocusIndex( hWndItem, nPos + nCount )
.head 8 + If nCount >= nNumItems
.head 9 - Call VisListScroll( hWndItem, nIndex )
.head 8 + Else If nIndex + nCount > nBottom
.head 9 - Call VisListScroll( hWndItem, nIndex + nCount + 1 - nNumItems )
.head 5 + Function: FreeChildren
.head 6 - Description:
.head 6 - Returns
.head 6 + Parameters
.head 7 - Number: hItem
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: hItems[ * ]
.head 7 - Number: nNumItems
.head 7 - Number: nItem
.head 7 - Number: nResource
.head 6 + Actions
.head 7 - Set nNumItems = VisListEnumChildren( hItem, hItems )
.head 7 - Set nItem = 0
.head 7 + While nItem < nNumItems
.head 8 - Set nResource = VisListGetValue( hWndItem, hItems[nItem] )
.head 8 + If nResource
.head 9 - Call VisNetFreeResource( nResource )
.head 9 - Call FreeChildren( hItems[nItem] )
.head 8 - Set nItem = nItem + 1
.head 5 + Function: GetDesktop
.head 6 - Description:
.head 6 + Returns
.head 7 - String:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nSize
.head 7 - String: sName
.head 6 + Actions
.head 7 - Set nSize = VisDesktopSize( )
.head 7 + If nSize != 1
.head 8 - Set sName = ''
.head 8 - Call SalStrSetBufferLength( sName, nSize )
.head 8 - Call VisDesktopStr( sName, nSize )
.head 8 - Return sName
.head 7 + Else
.head 8 - Return 'Desktop'
.head 5 + Function: GetItemDir
.head 6 - Description: Retrieves directory for specified item handle.
.head 6 + Returns
.head 7 - String:
.head 6 + Parameters
.head 7 - Number: hItem
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - String: sCurDir
.head 7 - Number: nResource
.head 7 - String: sRoot
.head 6 + Actions
.head 7 - !
.head 7 - ! ***** Get text of item selected
.head 7 - Set sCurDir = ''
.head 7 - !
.head 7 - ! ***** For all child levels, build path
.head 7 + While VisListGetItemFlags( hItem ) & ITEM_IsDirectory
.head 8 - Set sCurDir = VisListGetItemText( hItem ) || '\\' || sCurDir
.head 8 - Set hItem = VisListGetParent( hItem )
.head 7 - !
.head 7 - ! ***** Search for parens for drive letter
.head 7 - Set nResource = VisListGetItemValue( hItem )
.head 7 + If nResource
.head 8 - Set sRoot = GetRemoteName( nResource )
.head 7 + Else
.head 8 - Set sRoot = SalStrLeftX( SalStrRightX( VisListGetItemText( hItem ), 3 ), 2 )
.head 7 - Return sRoot || '\\' || sCurDir
.head 5 + Function: GetMyComputer
.head 6 - Description:
.head 6 + Returns
.head 7 - String:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nSize
.head 7 - String: sName
.head 6 + Actions
.head 7 - Set nSize = VisMyComputerSize( )
.head 7 + If nSize != 1
.head 8 - Set sName = ''
.head 8 - Call SalStrSetBufferLength( sName, nSize )
.head 8 - Call VisMyComputerStr( sName, nSize )
.head 8 - Return sName
.head 7 + Else
.head 8 - Return 'My Computer'
.head 5 + Function: GetNetNeighborhood
.head 6 - Description:
.head 6 + Returns
.head 7 - String:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nSize
.head 7 - String: sName
.head 6 + Actions
.head 7 - Set nSize = VisNetNeighborhoodSize( )
.head 7 + If nSize != 1
.head 8 - Set sName = ''
.head 8 - Call SalStrSetBufferLength( sName, nSize )
.head 8 - Call VisNetNeighborhoodStr( sName, nSize )
.head 8 - Return sName
.head 7 + Else
.head 8 - Return 'Network Neighborhood'
.head 5 + Function: GetPicOfType
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - Number: nType
.head 6 - Static Variables
.head 6 - Local variables
.head 6 + Actions
.head 7 + Select Case nType
.head 8 + Case LB_Err
.head 9 - Return 0
.head 8 + Case RESOURCE_DisplayType_Domain
.head 9 - Return hPicNetGroup
.head 8 + Case RESOURCE_DisplayType_Server
.head 9 - Return hPicNetServer
.head 8 + Case RESOURCE_DisplayType_Share
.head 9 - Return hPicFldr
.head 8 + Default
.head 9 - Return hPicDefault
.head 8 + Case RESOURCE_DisplayType_Group
.head 9 - Return hPicNetGroup
.head 8 + Case RESOURCE_DisplayType_Provider
.head 9 - Return hPicNetProvider
.head 8 + Case RESOURCE_DisplayType_Entire
.head 9 - Return hPicEntireNet
.head 8 + Case RESOURCE_DisplayType_Tree
.head 9 - Return hPicNetTree
.head 5 + Function: GetRemoteName
.head 6 - Description:
.head 6 + Returns
.head 7 - String:
.head 6 + Parameters
.head 7 - Number: hResource
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - String: sName
.head 7 - Number: nSize
.head 6 + Actions
.head 7 - Set sName = ''
.head 7 - Set nSize = VisNetGetResourceSize( hResource, RESOURCEITEM_RemoteName )
.head 7 + If nSize
.head 8 - Call SalStrSetBufferLength( sName, nSize )
.head 8 - Call VisNetGetResourceStr( hResource, RESOURCEITEM_RemoteName, sName, nSize )
.head 7 - Return sName
.head 5 + Function: GetSelectedDir
.head 6 - Description: Retrieves currently selected directory.
.head 6 + Returns
.head 7 - String:
.head 6 - Parameters
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nIndex
.head 6 + Actions
.head 7 - !
.head 7 - ! ***** Get text of selected item
.head 7 - Set nIndex = SalListQuerySelection( hWndItem )
.head 7 + If nIndex >= 0
.head 8 - !
.head 8 - ! ***** Get item handle and build path
.head 8 + If VisListGetFlags( hWndItem, nIndex ) & ( ITEM_IsDirectory | ITEM_IsRoot )
.head 9 - Return GetItemDir( VisListGetItemHandle( hWndItem, nIndex ) )
.head 7 - Return STRING_Null
.head 5 + Function: GetShortName
.head 6 - Description:
.head 6 + Returns
.head 7 - String:
.head 6 + Parameters
.head 7 - String: sName
.head 6 - Static Variables
.head 6 - Local variables
.head 6 + Actions
.head 7 + If SalStrLeftX( sName, 2 ) = '\\\\'
.head 8 - Set sName = SalStrMidX( sName, VisStrScanReverse( sName, -1, '\\' ) + 1, SalStrLength( sName ) )
.head 8 + If SalStrLeftX( sName, 1 ) = '.'
.head 9 - Call SalStrLop( sName )
.head 9 + If SalStrScan( sName, '.' ) > 0
.head 10 - Set sName = SalStrLeftX( sName, SalStrScan( sName, '.' ) )
.head 7 - Return sName
.head 5 + Function: ScanForDirectory
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - String: sDirectory
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nCount
.head 7 - Number: nPos
.head 7 - Number: nIndex
.head 7 - Number: hDrives[*]
.head 7 - Number: hNetPaths[*]
.head 7 - Number: hNetPath
.head 7 - String: sDrive
.head 7 - String: sNetPath
.head 6 + Actions
.head 7 - Set nIndex = LB_Err
.head 7 - Set sDirectory = SalStrUpperX( sDirectory )
.head 7 + If SalStrMidX( sDirectory, 1, 1 ) = ':'
.head 8 - Set sDrive = SalStrLeftX( sDirectory, 2 ) || ')'
.head 8 - Set nCount = VisListEnumChildren( hItemMyComputer, hDrives )
.head 8 - Set nPos = 0
.head 8 + While nPos < nCount and SalStrRightX( VisListGetItemText( hDrives[nPos] ), 3 ) < sDrive
.head 9 - Set nPos = nPos + 1
.head 8 + If nPos < nCount and SalStrRightX( VisListGetItemText( hDrives[nPos] ), 3 ) = sDrive
.head 9 - Set nIndex = 0
.head 9 + While VisListGetItemHandle( hWndItem, nIndex ) != hItemMyComputer
.head 10 - Set nIndex = nIndex + 1
.head 9 - Call Expand( nIndex )
.head 9 + While VisListGetItemHandle( hWndItem, nIndex ) != hDrives[nPos]
.head 10 - Set nIndex = nIndex + 1
.head 9 - Set nIndex = ScanForSubdirectory( SalStrMidX( sDirectory, 2, SalStrLength( sDirectory ) ), nIndex, hDrives[nPos] )
.head 7 + Else If hItemNetNeighborhood and SalStrLeftX( sDirectory, 2 ) = '\\\\'
.head 8 - Call EnumNeighborhood( hItemNetNeighborhood )
.head 8 - Set nPos = SalStrScan( SalStrMidX( sDirectory, 2, SalStrLength( sDirectory ) ), '\\\\' )
.head 8 + If nPos < 0
.head 9 - Set nPos = SalStrLength( sDirectory )
.head 8 + Else
.head 9 - Set nPos = nPos + 2
.head 8 - Set sNetPath = SalStrLeftX( sDirectory, nPos )
.head 8 - Set nCount = ScanForServer( hItemNetNeighborhood, sNetPath, hNetPaths )
.head 8 + If nCount
.head 9 - Set nIndex = 0
.head 9 + While VisListGetItemHandle( hWndItem, nIndex ) != hItemNetNeighborhood
.head 10 - Set nIndex = nIndex + 1
.head 9 - Set nPos = nCount
.head 9 + While nPos > 0
.head 10 - Call Expand( nIndex )
.head 10 - Set nPos = nPos - 1
.head 10 + While VisListGetItemHandle( hWndItem, nIndex ) != hNetPaths[nPos]
.head 11 - Set nIndex = nIndex + 1
.head 9 + If SalStrLength( sDirectory ) >= SalStrLength( sNetPath )
.head 10 - Set hNetPath = hNetPaths[0]
.head 10 - Call EnumNetwork( hNetPath )
.head 10 + If SalStrLength( sDirectory ) > SalStrLength( sNetPath )
.head 11 - Set nPos = SalStrScan( SalStrMidX( sDirectory, SalStrLength( sNetPath ) + 3, SalStrLength( sDirectory ) ), '\\\\' )
.head 11 + If nPos < 0
.head 12 - Set nPos = SalStrLength( sDirectory )
.head 11 + Else
.head 12 - Set nPos = nPos + SalStrLength( sNetPath ) + 3
.head 11 - Set sNetPath = SalStrLeftX( sDirectory, nPos )
.head 11 - Set nCount = ScanForShare( hNetPath, sNetPath, hNetPaths )
.head 11 + If nCount
.head 12 - Set nPos = nCount
.head 12 + While nPos > 0
.head 13 - Call Expand( nIndex )
.head 13 - Set nPos = nPos - 1
.head 13 + While VisListGetItemHandle( hWndItem, nIndex ) != hNetPaths[nPos]
.head 14 - Set nIndex = nIndex + 1
.head 12 - Set nIndex = ScanForSubdirectory( SalStrMidX( sDirectory, SalStrLength( sNetPath ), SalStrLength( sDirectory ) ), nIndex, hNetPaths[0] )
.head 10 + Else
.head 11 - Call Expand( nIndex )
.head 7 - Return nIndex
.head 5 + Function: ScanForServer
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - Number: hItemNetwork
.head 7 - String: sNetServer
.head 7 - Number: hPath[*]
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nCount
.head 7 - Number: nPos
.head 7 - Number: nDepth
.head 7 - Number: hItems[*]
.head 6 + Actions
.head 7 - Call EnumNetwork( hItemNetwork )
.head 7 - Set nCount = VisListEnumChildren( hItemNetwork, hItems )
.head 7 - Set nPos = 0
.head 7 + While nPos < nCount
.head 8 + If SalStrUpperX( GetRemoteName( VisListGetItemValue( hItems[nPos] ) ) ) = sNetServer
.head 9 - Set hPath[0] = hItems[nPos]
.head 9 - Return 1
.head 8 - Set nPos = nPos + 1
.head 7 - Set nPos = 0
.head 7 + While nPos < nCount
.head 8 + If SalStrLeftX( GetRemoteName( VisListGetItemValue( hItems[nPos] ) ), 2 ) != '\\\\'
.head 9 - Set nDepth = ScanForServer( hItems[nPos], sNetServer, hPath )
.head 9 + If nDepth
.head 10 - Set hPath[nDepth] = hItems[nPos]
.head 10 - Return nDepth + 1
.head 8 - Set nPos = nPos + 1
.head 7 - Return 0
.head 5 + Function: ScanForShare
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - Number: hItemNetwork
.head 7 - String: sNetShare
.head 7 - Number: hPath[*]
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nCount
.head 7 - Number: nPos
.head 7 - Number: nDepth
.head 7 - Number: hItems[*]
.head 6 + Actions
.head 7 - Call EnumNetwork( hItemNetwork )
.head 7 - Set nCount = VisListEnumChildren( hItemNetwork, hItems )
.head 7 - Set nPos = 0
.head 7 + While nPos < nCount
.head 8 + If SalStrUpperX( GetRemoteName( VisListGetItemValue( hItems[nPos] ) ) ) = sNetShare
.head 9 - Set hPath[0] = hItems[nPos]
.head 9 - Return 1
.head 8 - Set nPos = nPos + 1
.head 7 - Set nPos = 0
.head 7 + While nPos < nCount
.head 8 + If not VisNetGetResourceInt( VisListGetItemValue( hItems[nPos] ), RESOURCEITEM_Usage ) & RESOURCE_Usage_Connectable
.head 9 - Set nDepth = ScanForShare( hItems[nPos], sNetShare, hPath )
.head 9 + If nDepth
.head 10 - Set hPath[nDepth] = hItems[nPos]
.head 10 - Return nDepth + 1
.head 8 - Set nPos = nPos + 1
.head 7 - Return 0
.head 5 + Function: ScanForSubdirectory
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - String: sDirectory
.head 7 - Number: nIndex
.head 7 - Number: hItem
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nPos
.head 7 - Number: nCount
.head 7 - String: sSubdir
.head 7 - String: sDirs
.head 7 - Number: hDirs[*]
.head 6 + Actions
.head 7 + While sDirectory != ''
.head 8 - Call EnumDirectory( hItem )
.head 8 - Call Expand( nIndex )
.head 8 + While SalStrLeftX( sDirectory, 1 ) = '\\'
.head 9 - Call SalStrLop( sDirectory )
.head 8 - Set nPos = SalStrScan( sDirectory, '\\\\' )
.head 8 + If nPos < 0
.head 9 - Set nPos = SalStrLength( sDirectory )
.head 8 - Set sSubdir = SalStrLeftX( sDirectory, nPos )
.head 8 - Set sDirectory = SalStrMidX( sDirectory, nPos, SalStrLength( sDirectory ) )
.head 8 - Set nCount = VisListEnumChildren( hItem, hDirs )
.head 8 - Set nPos = 0
.head 8 + While nPos < nCount and SalStrUpperX( VisListGetItemText( hDirs[nPos] ) ) != sSubdir
.head 9 - Set nPos = nPos + 1
.head 8 + If nPos < nCount
.head 9 - Set hItem = hDirs[nPos]
.head 9 + While VisListGetItemHandle( hWndItem, nIndex ) != hItem
.head 10 - Set nIndex = nIndex + 1
.head 8 + Else
.head 9 - Set sDirectory = ''
.head 7 - Return nIndex
.head 5 + Function: SelectDirectory
.head 6 - Description:
.head 6 + Returns
.head 7 - Number:
.head 6 + Parameters
.head 7 - String: sDirectory
.head 6 - Static Variables
.head 6 + Local variables
.head 7 - Number: nRet
.head 6 + Actions
.head 7 - Call SalWaitCursor( TRUE )
.head 7 - Set nRet = VisListSetFocusIndex( hWndItem, ScanForDirectory( sDirectory ) )
.head 7 - Call SalWaitCursor( FALSE )
.head 7 - Return nRet
.head 4 - List Initialization
.head 4 + Message Actions
.head 5 + On SAM_Create
.head 6 - !
.head 6 - ! ***** Get root item handle
.head 6 + Loop
.head 7 - Set hItemRoot = GetRoot( )
.head 7 + If hItemRoot
.head 8 - Break
.head 7 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 8 - Call SalQuit()
.head 6 - !
.head 6 - ! ***** Load Desktop item
.head 6 + Loop
.head 7 - Set hItemDesktop = VisListLoadChild( hWndItem, hItemRoot, hPicDesktop, hPicDesktop, GetDesktop( ), 0, 0 )
.head 7 + If hItemDesktop
.head 8 - Break
.head 7 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 8 - Call SalQuit()
.head 6 - !
.head 6 - ! ***** Load My Computer
.head 6 + Loop
.head 7 - Set hItemMyComputer = VisListLoadChild( hWndItem, hItemDesktop, hPicMyComputer, hPicMyComputer, GetMyComputer( ), 0, 0 )
.head 7 + If hItemMyComputer
.head 8 - Break
.head 7 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 8 - Call SalQuit()
.head 6 - !
.head 6 - ! ***** Load Entire Network
.head 6 + If VisNetExists( )
.head 7 + ! Loop
.head 8 - Set hItemEntireNet = VisListLoadChild( hWndItem, hItemDesktop, hPicEntireNet, hPicEntireNet, 'Entire Network', 0, 0x00500000 )
.head 8 + If hItemEntireNet
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hItemNetNeighborhood = VisListLoadChild( hWndItem, hItemDesktop, hPicNetNeighborhood, hPicNetNeighborhood, GetNetNeighborhood( ), 0, ITEM_CanExpand )
.head 8 + If hItemNetNeighborhood
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 6 - !
.head 6 - ! ***** Enumerate all available drives
.head 6 - Call EnumDrives( hItemMyComputer )
.head 6 - !
.head 6 - ! ***** Show outline
.head 6 - Call ShowOutline( SHOW_AllLevels )
.head 5 + On SAM_Destroy
.head 6 - ! ***** Free all resources
.head 6 - Call FreeChildren( hItemNetNeighborhood )
.head 6 - !
.head 6 - ! ***** Free all pictures loaded
.head 6 - Set nLoadCount = nLoadCount - 1
.head 6 + If nLoadCount = 0
.head 7 - Call VisPicFree( hPicDrvCD )
.head 7 - Call VisPicFree( hPicDrvFloppy )
.head 7 - Call VisPicFree( hPicDrvFixed )
.head 7 - Call VisPicFree( hPicDrvNet )
.head 7 - Call VisPicFree( hPicDrvRAM )
.head 7 - Call VisPicFree( hPicFldr )
.head 7 - Call VisPicFree( hPicFldrOpen )
.head 7 - Call VisPicFree( hPicDesktop )
.head 7 - Call VisPicFree( hPicMyComputer )
.head 7 - Call VisPicFree( hPicNetNeighborhood )
.head 7 - Call VisPicFree( hPicDefault )
.head 7 - Call VisPicFree( hPicNetServer )
.head 7 - Call VisPicFree( hPicNetGroup )
.head 7 - Call VisPicFree( hPicNetProvider )
.head 7 - Call VisPicFree( hPicEntireNet )
.head 7 - Call VisPicFree( hPicNetTree )
.head 5 + On SAM_DoubleClick
.head 6 - Call SalSendMsg( hWndItem, VTM_OutlineCornerClick, VisListGetFocusIndex( hWndItem ), 0 )
.head 5 - !
.head 5 + On VTM_Create
.head 6 - Call SetStyle( LBS_VisExtensions | LBS_Explorer | LBS_FmtMixedcase )
.head 6 - !
.head 6 - ! ***** Load bitmaps if not already loaded
.head 6 + If nLoadCount = 0
.head 7 + Loop
.head 8 - Set hPicDrvCD = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_DriveCDROM )
.head 8 + If hPicDrvCD
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicDrvFloppy = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_DriveFloppy )
.head 8 + If hPicDrvFloppy
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicDrvFixed = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_DriveFixed )
.head 8 + If hPicDrvFixed
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicDrvNet = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_DriveNetwork )
.head 8 + If hPicDrvNet
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicDrvRAM = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_DriveRAM )
.head 8 + If hPicDrvRAM
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicFldr = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_Folder )
.head 8 + If hPicFldr
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicFldrOpen = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_FolderOpen )
.head 8 + If hPicFldrOpen
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicDesktop = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_Desktop )
.head 8 + If hPicDesktop
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicNetNeighborhood = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_NetworkNeighborhood )
.head 8 + If hPicNetNeighborhood
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicMyComputer = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_MyComputer )
.head 8 + If hPicMyComputer
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicDefault = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_Default )
.head 8 + If hPicDefault
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicNetServer = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_NetworkServer )
.head 8 + If hPicNetServer
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicNetGroup = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_NetworkGroup )
.head 8 + If hPicNetGroup
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicNetProvider = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_NetworkProvider )
.head 8 + If hPicNetProvider
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicEntireNet = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_EntireNetwork )
.head 8 + If hPicEntireNet
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 7 + Loop
.head 8 - Set hPicNetTree = VisPicLoad( PIC_FormatBitmap, VTEXPLOR_DLLName, VTPIC_NetworkTree )
.head 8 + If hPicNetTree
.head 9 - Break
.head 8 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 9 - Call SalQuit()
.head 6 - Set nLoadCount = nLoadCount + 1
.head 5 + On VTM_KeyDown
.head 6 - ! ***** Get selected item
.head 6 - Set nIndex = VisListGetFocusIndex( hWndItem )
.head 6 + If nIndex != LB_Err
.head 7 - Set nItemFlags = VisListGetFlags( hWndItem, nIndex )
.head 7 + If nItemFlags != LB_Err
.head 8 + Select Case wParam
.head 9 + Case VK_Right
.head 10 + If (nItemFlags & ITEM_IsParent) and (nItemFlags & ITEM_IsExpanded)
.head 11 - Break
.head 10 + Else If (nItemFlags & ITEM_IsParent) and Not (nItemFlags & ITEM_IsExpanded)
.head 11 - Call SalSendMsg( hWndItem, SAM_DoubleClick, 0, 0 )
.head 10 + Else If nItemFlags & ITEM_CanExpand
.head 11 - Call SalSendMsg( hWndItem, SAM_DoubleClick, 0, 0 )
.head 10 - Return 0
.head 9 + Case VK_Add ! *** Expand
.head 10 + If (nItemFlags & ITEM_IsParent) and Not (nItemFlags & ITEM_IsExpanded)
.head 11 - Call SalSendMsg( hWndItem, SAM_DoubleClick, 0, 0 )
.head 10 + Else If nItemFlags & ITEM_CanExpand
.head 11 - Call SalSendMsg( hWndItem, SAM_DoubleClick, 0, 0 )
.head 10 - Return 0
.head 9 + Case VK_Left
.head 10 + If ( nItemFlags & ITEM_IsParent ) and ( nItemFlags & ITEM_IsExpanded )
.head 11 - Call SalSendMsg( hWndItem, SAM_DoubleClick, 0, 0 )
.head 10 + Else If nIndex
.head 11 - Set hItem = VisListGetParent( VisListGetItemHandle( hWndItem, nIndex ) )
.head 11 + While VisListGetItemHandle( hWndItem, nIndex ) != hItem
.head 12 - Set nIndex = nIndex - 1
.head 11 - Call VisListSetFocusIndex( hWndItem, nIndex )
.head 10 - Return 0
.head 9 + Case VK_Subtract ! *** Collapse
.head 10 + If (nItemFlags & ITEM_IsParent) and (nItemFlags & ITEM_IsExpanded)
.head 11 - Call SalSendMsg( hWndItem, SAM_DoubleClick, 0, 0 )
.head 10 - Return 0
.head 5 + On VTM_OutlineCornerClick
.head 6 - !
.head 6 - ! ***** Get item flags for selected item
.head 6 - Set nIndex = wParam
.head 6 - Set hItem = VisListGetItemHandle( hWndItem, nIndex )
.head 6 - Set nLevel = VisListGetLevel( hItem )
.head 6 + Loop
.head 7 - Set nItemFlags = VisListGetFlags( hWndItem, nIndex )
.head 7 + If nItemFlags != LB_Err
.head 8 - Break
.head 7 + If VisErrorRecovery( CAPTION_ErrorHandler ) = ACTION_Abort
.head 8 - Call SalQuit()
.head 6 - !
.head 6 - ! ***** Expand or collapse based on item flags
.head 6 + If ( nItemFlags & ITEM_IsParent ) and ( nItemFlags & ITEM_IsExpanded )
.head 7 - !
.head 7 - ! ***** Collapse item selected
.head 7 - Call Collapse( nIndex )
.head 6 + Else If ( nItemFlags & ITEM_IsParent ) and not ( nItemFlags & ITEM_IsExpanded )
.head 7 - !
.head 7 - ! ***** Expand item selected
.head 7 - Call Expand( nIndex )
.head 6 + Else If nItemFlags & ITEM_CanExpand
.head 7 - !
.head 7 - ! ***** Wait cursor on
.head 7 - Call SalWaitCursor( TRUE )
.head 7 - !
.head 7 - ! ***** Enumerate all subdirectories and insert as children of selected item
.head 7 + If nItemFlags & ( ITEM_IsDirectory | ITEM_IsRoot )
.head 8 + If EnumDirectory( hItem ) or VisListGetValue( hWndItem, nIndex )
.head 9 - !
.head 9 - ! ***** Expand item selected
.head 9 - Call Expand( nIndex )
.head 7 + Else If VisListGetValue( hWndItem, nIndex )
.head 8 - Call EnumNetwork( hItem )
.head 8 - !
.head 8 - ! ***** Expand item selected
.head 8 - Call Expand( nIndex )
.head 7 + Else
.head 8 - Call EnumNeighborhood( hItemNetNeighborhood )
.head 8 - !
.head 8 - ! ***** Expand item selected
.head 8 - Call Expand( nIndex )
.head 7 - !
.head 7 - ! ***** Wait cursor off
.head 7 - Call SalWaitCursor( FALSE )
.head 2 + Default Classes
.head 3 - MDI Window: cBaseMDI
.head 3 - Form Window:
.head 3 - Dialog Box:
.head 3 - Table Window:
.head 3 - Quest Window:
.head 3 - Data Field:
.head 3 - Spin Field:
.head 3 - Multiline Field:
.head 3 - Pushbutton:
.head 3 - Radio Button:
.head 3 - Option Button:
.head 3 - ActiveX:
.head 3 - Check Box:
.head 3 - Child Table:
.head 3 - Quest Child Window: cQuickDatabase
.head 3 - List Box:
.head 3 - Combo Box:
.head 3 - Picture:
.head 3 - Vertical Scroll Bar:
.head 3 - Horizontal Scroll Bar:
.head 3 - Column:
.head 3 - Background Text:
.head 3 - Group Box:
.head 3 - Line:
.head 3 - Frame:
.head 3 - Custom Control:
.head 2 - Application Actions
Return to http://gupta.narod.ru/