home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / UPX_FrontE1944871112005.psc / Module1.bas < prev    next >
BASIC Source File  |  2005-11-01  |  4KB  |  112 lines
  1. Attribute VB_Name = "Module1"
  2. 'This module contains all the declarations to use the
  3. 'Windows 95 Shell API to use the browse for folders
  4. 'dialog box.  To use the browse for folders dialog box,
  5. 'please call the BrowseForFolders function using the
  6. 'syntax: stringFolderPath=BrowseForFolders(Hwnd,TitleOfDialog)
  7. '
  8. 'For contacting information, see other module
  9.  
  10. Option Explicit
  11.  
  12. Public Type BrowseInfo      'receive information about the folder selected by user.
  13.      
  14.      hWndOwner As Long      'Handle to th owner window for the dialog box.
  15.      pIDLRoot As Long       'Pointer to an itemlist structure.
  16.      pszDisplayName As Long 'Add. of buffer -receive the display name of folder selected.
  17.      lpszTitle As Long      'Display above the tree view control.
  18.      ulFlags As Long        'specifying the options for the dialog box (notify event).
  19.      lpfnCallback As Long   'Add. of application-defined funtion.
  20.      lParam As Long         'Application-defined value pass to callback function.
  21.                             '(receives messages from the operating system.)
  22.      iImage As Long         'Receive image associated with the selected folder.
  23.  
  24. End Type
  25.  
  26. Public Const BIF_RETURNONLYFSDIRS = 1
  27. Public Const MAX_PATH = 260
  28.  
  29. Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  30. Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  31. Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  32.  
  33. Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  34.  
  35. Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String
  36. 'Creates a dialog box (select a folder and returns the selected folder's Folder object).
  37.  
  38.     'declare variables to be used
  39.      Dim iNull As Integer
  40.      Dim lpIDList As Long
  41.      Dim lResult As Long
  42.      Dim sPath As String
  43.      Dim udtBI As BrowseInfo
  44.  
  45.     'initialise variables
  46.      With udtBI
  47.         .hWndOwner = hWndOwner
  48.         .lpszTitle = lstrcat(sPrompt, "")
  49.         .ulFlags = BIF_RETURNONLYFSDIRS
  50.      End With
  51.  
  52.     'Call the browse for folder API
  53.      lpIDList = SHBrowseForFolder(udtBI)
  54.      
  55.     'get the resulting string path
  56.      If lpIDList Then
  57.         sPath = String$(MAX_PATH, 0)
  58.         lResult = SHGetPathFromIDList(lpIDList, sPath)
  59.         iNull = InStr(sPath, vbNullChar)
  60.         If iNull Then sPath = Left$(sPath, iNull - 1)
  61.      End If
  62.  
  63.     'If cancel was pressed, sPath = ""
  64.      BrowseForFolder = sPath
  65.  
  66. End Function
  67.  
  68. Function cPath() As String
  69. If Right(App.Path, 1) <> "\" Then
  70.    cPath = App.Path & "\"
  71. End If
  72. End Function
  73.  
  74. Function PathExists(ByVal strPathName As String) As Boolean
  75. On Error GoTo errHandle
  76.  
  77. If Dir(strPathName, vbDirectory) <> "" Then
  78.    PathExists = True
  79. Else
  80.    PathExists = False
  81. End If
  82.  
  83. Exit Function
  84. errHandle:
  85. PathExists = False
  86. End Function
  87.  
  88.  
  89. Function FileExists(ByVal strPathName As String) As Boolean
  90. On Error GoTo errHandle
  91.     
  92.     Open strPathName For Input As #1
  93.     Close #1
  94.     FileExists = True
  95.     
  96. Exit Function
  97. errHandle:
  98. FileExists = False
  99. End Function
  100.  
  101. Function Get_WinPath() As String
  102. Dim rtn
  103. Dim Buffer As String 'declare the needed variables
  104.    
  105.    Buffer = Space(MAX_PATH)
  106.    rtn = GetWindowsDirectory(Buffer, Len(Buffer))  'get the path
  107.    Get_WinPath = Left(Buffer, rtn) 'parse the path to the global string
  108.    If Right(Get_WinPath, 1) <> "\" Then
  109.       Get_WinPath = Get_WinPath & "\"
  110.    End If
  111. End Function
  112.