|
Attribute VB_Name = "Module1"
OPTION Explicit
Public fMainForm AS frmMain
Public TYPE BROWSEINFO
hOwner AS LONG
pidlRoot AS LONG
pszDisplayName AS STRING
lpszTitle AS STRING
ulFlags AS LONG
lpfn AS LONG
lParam AS LONG
iImage AS LONG
END TYPE
'BROWSEINFO.ulFlags values:
Public CONST BIF_RETURNONLYFSDIRS = &H1
Public CONST BIF_DONTGOBELOWDOMAIN = &H2
Public CONST BIF_STATUSTEXT = &H4
Public CONST BIF_RETURNFSANCESTORS = &H8
Public CONST BIF_BROWSEFORCOMPUTER = &H1000
Public CONST BIF_BROWSEFORPRINTER = &H2000
Public DECLARE FUNCTION SHGetPathFromIDList Lib "shell32.dll" _
ALIAS "SHGetPathFromIDListA" (BYVAL pidl AS LONG, _
BYVAL pszPath AS STRING) AS LONG
Public DECLARE FUNCTION SHBrowseForFolder Lib "shell32.dll" _
ALIAS "SHBrowseForFolderA" (lpBrowseInfo AS BROWSEINFO) AS LONG
Public DECLARE SUB CoTaskMemFree Lib "ole32.dll" (BYVAL pv AS LONG)
Public CONST ERROR_SUCCESS = 0&
Public CONST APINULL = 0&
Public CONST HKEY_LOCAL_MACHINE = &H80000002
Public ReturnCode AS LONG
DECLARE FUNCTION RegCloseKey Lib "advapi32.dll" (BYVAL _
hKey AS LONG) AS LONG
DECLARE FUNCTION RegOpenKey Lib "advapi32.dll" ALIAS _
"RegOpenKeyA" (BYVAL hKey AS LONG, BYVAL lpSubKey AS _
STRING, phkResult AS LONG) AS LONG
DECLARE FUNCTION RegQueryValueEx Lib "advapi32.dll" ALIAS _
"RegQueryValueExA" (BYVAL hKey AS LONG, BYVAL lpValueName _
AS STRING, BYVAL lpReserved AS LONG, lpType AS LONG, _
lpData AS ANY, lpcbData AS LONG) AS LONG
Public FUNCTION ActiveConnection() AS Boolean
DIM hKey AS LONG
DIM lpSubKey AS STRING
DIM phkResult AS LONG
DIM lpValueName AS STRING
DIM lpReserved AS LONG
DIM lpType AS LONG
DIM lpData AS LONG
DIM lpcbData AS LONG
ActiveConnection = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _
phkResult)
IF ReturnCode = ERROR_SUCCESS THEN
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, _
lpReserved, lpType, BYVAL lpData, lpcbData)
lpcbData = LEN(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, _
lpReserved, lpType, lpData, lpcbData)
IF ReturnCode = ERROR_SUCCESS THEN
IF lpData = 0 THEN
ActiveConnection = False
ELSE
ActiveConnection = True
END IF
END IF
RegCloseKey (hKey)
END IF
END FUNCTION
Public FUNCTION GetFolder(BYVAL hWndModal AS LONG) AS STRING
DIM bInf AS BROWSEINFO
DIM RetVal AS LONG
DIM PathID AS LONG
DIM RetPath AS STRING
DIM Offset AS INTEGER
'Set the properties of the folder dialog
bInf.hOwner = hWndModal
bInf.lpszTitle = "Please Select Music Folder:"
bInf.ulFlags = BIF_RETURNONLYFSDIRS
'Show the Browse For Folder dialog
PathID = SHBrowseForFolder(bInf)
RetPath = SPACE$(512)
RetVal = SHGetPathFromIDList(BYVAL PathID, BYVAL RetPath)
IF RetVal THEN
'Trim off the null chars ending the path
'and display the returned folder
Offset = INSTR(RetPath, CHR$(0))
GetFolder = LEFT$(RetPath, Offset - 1)
'Free memory allocated for PIDL
CoTaskMemFree PathID
ELSE
GetFolder = ""
END IF
END FUNCTION
SUB Main()
frmSplash.Show
frmSplash.Refresh
Set fMainForm = New frmMain
Load fMainForm
Unload frmSplash
fMainForm.Show
END SUB
|
