home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "modMain"
- Global selected As Boolean
- Global tFile As String
- Global Sel_dir As String
- Private Type BrowseInfo
- hWndOwner As Long
- pIDLRoot As Long
- pszDisplayName As Long
- lpszTitle As Long
- ulFlags As Long
- lpfnCallback As Long
- lParam As Long
- iImage As Long
- End Type
-
- Private Const BIF_RETURNONLYFSDIRS = 1
- Private Const MAX_PATH = 260
-
- Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
-
- Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
- (ByVal lpString1 As String, ByVal lpString2 As String) As Long
-
- Private Declare Function SHBrowseForFolder Lib "shell32" _
- (lpbi As BrowseInfo) As Long
-
- Private Declare Function SHGetPathFromIDList Lib "shell32" _
- (ByVal pidList As Long, ByVal lpBuffer As String) As Long
- Sub Wait(WaitSeconds As Single)
-
- Dim StartTime As Single
-
- StartTime = Timer
-
- Do While Timer < StartTime + WaitSeconds
- DoEvents
- Loop
- End Sub
-
- Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As String
-
- Dim iNull As Integer
- Dim lpIDList As Long
- Dim lResult As Long
- Dim sPath As String
- Dim udtBI As BrowseInfo
-
- With udtBI
- .hWndOwner = hWndOwner
- .lpszTitle = lstrcat(sPrompt, "")
- .ulFlags = BIF_RETURNONLYFSDIRS
- End With
-
- lpIDList = SHBrowseForFolder(udtBI)
-
- If lpIDList Then
- sPath = String$(MAX_PATH, 0)
- lResult = SHGetPathFromIDList(lpIDList, sPath)
- Call CoTaskMemFree(lpIDList)
- iNull = InStr(sPath, vbNullChar)
-
- If iNull Then
- sPath = Left
- = Single
-
- StartTime = Timer
- ime As Single
-
- Starttrl = ome = Timer
- ime As SeeebLirsi