Tweet
' Wrapper functions and procedures to use the Drive object
' included in the Microsoft Scriptin Runtime (scrrun.dll).
' The routines access directly the COM functions through the VTable
' which is faster than the Invoke method used by COM Automation.
' Another advantage is that each routine returns an error code,
' instead of the infamous %DISP_E_EXCEPTION (decimal -2147614729,
' hexadecimal &H80020009)
------------------
[This message has been edited by JOSE ROCA (edited September 08, 2003).]
' included in the Microsoft Scriptin Runtime (scrrun.dll).
' The routines access directly the COM functions through the VTable
' which is faster than the Invoke method used by COM Automation.
' Another advantage is that each routine returns an error code,
' instead of the infamous %DISP_E_EXCEPTION (decimal -2147614729,
' hexadecimal &H80020009)
Code:
' *********************************************************************************************
' DRIVE OBJECT
' Provides access to the properties of a particular disk drive or network share.
' *********************************************************************************************
#DIM ALL
#DEBUG ERROR ON
#INCLUDE "win32api.INC"
GLOBAL Drv_Error_Code AS DWORD
' MIDL___MIDL_itf_scrrun_0094_0001:
%MIDL___MIDL_itf_scrrun_0094_0001_UnknownType = 0
%MIDL___MIDL_itf_scrrun_0094_0001_Removable = 1
%MIDL___MIDL_itf_scrrun_0094_0001_Fixed = 2
%MIDL___MIDL_itf_scrrun_0094_0001_Remote = 3
%MIDL___MIDL_itf_scrrun_0094_0001_CDRom = 4
%MIDL___MIDL_itf_scrrun_0094_0001_RamDisk = 5
TYPE SAFEARRAYBOUNDTYPE
cElements AS DWORD
lLbound AS LONG
END TYPE
TYPE SAFEARRAYTYPE
cDims AS WORD
fFeatures AS WORD
cbElements AS DWORD
cLocks AS DWORD
pvData AS DWORD
rgsabound(0 TO 1) AS SAFEARRAYBOUNDTYPE
END TYPE
DECLARE FUNCTION SafeArrayCreate LIB "OLEAUT32.DLL" ALIAS "SafeArrayCreate" (BYVAL vt AS WORD, BYVAL cDims AS DWORD, BYREF rgsabound AS SAFEARRAYBOUNDTYPE) AS DWORD
DECLARE FUNCTION SafeArrayDestroy LIB "OLEAUT32.DLL" ALIAS "SafeArrayDestroy" (BYVAL psa AS DWORD) AS DWORD
DECLARE FUNCTION SafeArrayGetElement LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetElement" (BYVAL psa AS DWORD, BYVAL rgIndices AS LONG, BYVAL pv AS DWORD) AS DWORD
DECLARE FUNCTION SafeArrayGetLBound LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetLBound" (BYVAL psa AS DWORD, BYVAL nDim AS DWORD, BYREF plLbound AS LONG) AS DWORD
DECLARE FUNCTION SafeArrayGetUBound LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetUBound" (BYVAL psa AS DWORD, BYVAL nDim AS DWORD, BYREF plUbound AS LONG) AS DWORD
DECLARE FUNCTION SafeArrayPutElement LIB "OLEAUT32.DLL" ALIAS "SafeArrayPutElement" (BYVAL psa AS DWORD, BYVAL rgIndices AS LONG, BYVAL pv AS DWORD) AS DWORD
' *********************************************************************************************
' HRESULT Drives([out,retval] **IDriveCollection pReturn)
' Returns a Drives collection consisting of all Drive objects available on the local machine.
' Example: lpDrives = IDrive_GetDrives(lpFso)
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetDrives CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetDrives (BYVAL lpFso AS DWORD) EXPORT AS DWORD
LOCAL lpDrives AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpFso
pvtbl = @ppthis
ppmethod = pvtbl + 28
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetDrives(lpFso, lpDrives) TO Drv_Error_Code
FUNCTION = lpDrives
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT GetDrive([in] BSTR DriveSpec, [out,retval] **IDrive pReturn)
' Returns a Drive object corresponding to the drive in a specified path.
' Example: lpDrive = IDrive_GetDrive(lpFso, "C:")
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetDrive CDECL(BYVAL pThis AS DWORD, BYVAL DriveSpec AS DWORD, BYREF pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetDrive (BYVAL lpFso AS DWORD, strDriveSpec AS STRING) EXPORT AS DWORD
LOCAL lpDrive AS DWORD
LOCAL uDriveSpec AS STRING
uDriveSpec = UCODE$(strDriveSpec)
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpFSO
pvtbl = @ppthis
ppmethod = pvtbl + 76
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetDrive(lpFso, STRPTR(uDriveSpec), lpDrive) TO Drv_Error_Code
FUNCTION = lpDrive
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT Path([out,retval] *BSTR pReturn)
' Returns the path for a specified drive.
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetDrivePath CDECL(BYVAL pThis AS DWORD, BYVAL pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetDrivePath (BYVAL lpDrive AS DWORD) EXPORT AS STRING
LOCAL uPath AS STRING
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 28
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetDrivePath(lpDrive, VARPTR(uPath)) TO Drv_Error_Code
FUNCTION = ACODE$(uPath)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT DriveLetter([out,retval] *BSTR pReturn)
' Returns the drive letter of a physical local drive or a network share. Read-only.
' Example:
' lpFile = IDrive_GetFile(lpFso, "H:\Archivos de Programa\Image Browser")
' strDriveLetter = IDrive_GetDriveLetter(lpFile)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetDriveLetter CDECL(BYVAL pThis AS DWORD, BYVAL pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetDriveLetter (BYVAL lpDrive AS DWORD) EXPORT AS STRING
LOCAL uDriveLetter AS STRING
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 32
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetDriveLetter(lpDrive, VARPTR(uDriveLetter)) TO Drv_Error_Code
FUNCTION = ACODE$(uDriveLetter)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT ShareName([out,retval] *BSTR pReturn)
' Returns the network share name for a specified drive.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' strShareName = IDrive_GetShareName(lpDrive)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetShareName CDECL(BYVAL pThis AS DWORD, BYVAL pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetShareName (BYVAL lpDrive AS DWORD) EXPORT AS STRING
LOCAL uShareName AS STRING
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 36
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetShareName(lpDrive, VARPTR(uShareName)) TO Drv_Error_Code
FUNCTION = ACODE$(uShareName)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT DriveType([out,retval] *DriveTypeConst pReturn)
' Returns a value indicating the type of a specified drive.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' lType = IDrive_GetDriveType(lpDrive)
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetDriveType CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS LONG) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetDriveType (BYVAL lpDrive AS DWORD) EXPORT AS LONG
LOCAL lpType AS LONG
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 40
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetDriveType(lpDrive, lpType) TO Drv_Error_Code
FUNCTION = lpType
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT RootFolder([out,retval] **IFolder pReturn)
' Returns a Folder object representing the root folder of a specified drive. Read-only.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' lpRootfolder = IDrive_GetRootFolder(lpDrive)
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetRootFolder CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetRootFolder (BYVAL lpDrive AS DWORD) EXPORT AS DWORD
LOCAL lpRootFolder AS LONG
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 44
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetRootFolder(lpDrive, lpRootFolder) TO Drv_Error_Code
FUNCTION = lpRootFolder
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT AvailableSpace([out,retval] *VARIANT pReturn)
' Returns the amount of space available to a user on the specified drive or network share.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' qSize = IDrive_GetAvailableSpace(lpDrive)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetAvailableSpace CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS VARIANT) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetAvailableSpace (BYVAL lpDrive AS DWORD) EXPORT AS QUAD
LOCAL qSpace AS QUAD
LOCAL vSpace AS VARIANT
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 48
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetAvailableSpace(lpDrive, vSpace) TO Drv_Error_Code
FUNCTION = VARIANT#(vSpace)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT FreeSpace([out,retval] *VARIANT pReturn)
' Returns the amount of free space available to a user on the specified drive or network share.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' qSize = IDrive_GetFreeSpace(lpDrive)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetFreeSpace CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS VARIANT) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetFreeSpace (BYVAL lpDrive AS DWORD) EXPORT AS QUAD
LOCAL qSpace AS QUAD
LOCAL vSpace AS VARIANT
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 52
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetFreeSpace(lpDrive, vSpace) TO Drv_Error_Code
FUNCTION = VARIANT#(vSpace)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT TotalSize([out,retval] *VARIANT pReturn)
' Returns the total space, in bytes, of a drive or network share.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' qSize = IDrive_GetTotalSize(lpDrive)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetTotalSize CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS VARIANT) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetTotalSize (BYVAL lpDrive AS DWORD) EXPORT AS QUAD
LOCAL qSize AS QUAD
LOCAL vSize AS VARIANT
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 56
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetTotalSize(lpDrive, vSize) TO Drv_Error_Code
FUNCTION = VARIANT#(vSize)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT VolumeName([out,retval] *BSTR pReturn)
' Sets or returns the volume name of the specified drive. Read/write.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' strVolumeName = IDrive_GetVolumeName(lpDrive)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetVolumeName CDECL(BYVAL pThis AS DWORD, BYVAL pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetVolumeName (BYVAL lpDrive AS DWORD) EXPORT AS STRING
LOCAL uVolumeName AS STRING
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 60
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetVolumeName(lpDrive, VARPTR(uVolumeName)) TO Drv_Error_Code
FUNCTION = ACODE$(uVolumeName)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT VolumeName([in] BSTR Par0)
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' IDrive_PutVolumeName lpDrive, "NEW_LABEL"
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_PutVolumeName CDECL(BYVAL pThis AS DWORD, BYVAL Par0 AS DWORD) AS DWORD
' **********************************************************************************************
SUB IDrive_PutVolumeName (BYVAL lpDrive AS DWORD, strName AS STRING) EXPORT
LOCAL uName AS STRING
uName = UCODE$(strName)
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 64
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_PutVolumeName(lpDrive, STRPTR(uName)) TO Drv_Error_Code
END SUB
' **********************************************************************************************
' *********************************************************************************************
' HRESULT FileSystem([out,retval] *BSTR pReturn)
' Returns the type of file system in use for the specified drive.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' strFileSystem = IDrive_GetFileSystem(lpDrive)
' **********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetFileSystem CDECL(BYVAL pThis AS DWORD, BYVAL pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetFileSystem (BYVAL lpDrive AS DWORD) EXPORT AS STRING
LOCAL uFileSystem AS STRING
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 68
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetFileSystem(lpDrive, VARPTR(uFileSystem)) TO Drv_Error_Code
FUNCTION = ACODE$(uFileSystem)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT SerialNumber([out,retval] *I4 pReturn)
' Returns the decimal serial number used to uniquely identify a disk volume.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' lSerialNumber = IDrive_GetSerialNumber(lpDrive)
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_GetSerialNumber CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS LONG) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_GetSerialNumber (BYVAL lpDrive AS DWORD) EXPORT AS LONG
LOCAL lpSerialNumber AS LONG
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 72
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_GetSerialNumber(lpDrive, lpSerialNumber) TO Drv_Error_Code
FUNCTION = lpSerialNumber
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT IsReady([out,retval] *BOOL pReturn)
' Returns True if the specified drive is ready; False if it is not.
' Example:
' lpDrive = IDrive_GetDrive(lpFso, "A")
' lBool = IDrive_DriveIsReady(lpDrive)
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_DriveIsReady CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS LONG) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_DriveIsReady (BYVAL lpDrive AS DWORD) EXPORT AS LONG
LOCAL lpReady AS LONG
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrive
pvtbl = @ppthis
ppmethod = pvtbl + 76
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_DriveIsReady(lpDrive, lpReady) TO Drv_Error_Code
FUNCTION = CINT(lpReady)
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' Returns an error message
' *********************************************************************************************
FUNCTION DrvObjError (BYVAL dwError AS DWORD) EXPORT AS STRING
IF dwError = 0 THEN EXIT FUNCTION
LOCAL pBuffer AS ASCIIZ PTR
LOCAL ncbBuffer AS DWORD
ncbBuffer = FormatMessage(%FORMAT_MESSAGE_ALLOCATE_BUFFER OR _
%FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_IGNORE_INSERTS, _
BYVAL %NULL, dwError, BYVAL MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _
BYVAL VARPTR(pBuffer), 0, BYVAL %NULL)
IF ncbBuffer THEN
FUNCTION = "Error " & FORMAT$(dwError) & " [&H" & HEX$(dwError, 8) & "] " & @pBuffer
LocalFree pBuffer
ELSE
FUNCTION = "Error " & FORMAT$(dwError) & " [&H" & HEX$(dwError, 8) & "]
END IF
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT QueryInterface([in] *GUID riid, [out] **VOID ppvObj)
' Determines whether the object supports a particular COM interface. If it does, the system
' increases the object's reference count, and the application can use that interface
' Parameters:
' pUnk [in] : Pointer to the interface to be queried.
' riid [in] : A Guid, passed by reference, that is the interface identifier (IID) of the
' requested interface.
' ppvObj [out] : Address of pointer variable that receives the interface pointer requested in
' riid. Upon successful return, *ppvObject contains the requested interface pointer to
' the object. If the object does not support the interface specified in iid, *ppvObject
' is set to NULL.
' Return Value:
' %S_OK if the interface is supported, %E_NOINTERFACE if not.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_QueryInterface CDECL(BYVAL pUnk AS DWORD, BYREF riid AS GUID, BYVAL ppvObj AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_QueryInterface (BYVAL pUnk AS DWORD, BYREF riid AS GUID, BYVAL ppvObj AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pUnk
pvtbl = @ppthis
ppmethod = pvtbl
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_QueryInterface(pUnk, riid, ppvObj) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' UI4 AddRef()
' Increments the reference count on the specified interface.
' Returns an integer from 1 to n, the value of the new reference count. This information is
' meant to be used for diagnostic/testing purposes only, because, in certain situations, the
' value may be unstable.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_AddRef CDECL(BYVAL pThis AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_AddRef (BYVAL pThis AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pThis
pvtbl = @ppthis
ppmethod = pvtbl + 4
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_AddRef(pThis) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' UI4 Release()
' Decrements the reference count on the specified interface. If the reference count on the
' object falls to 0, the object is freed from memory.
' Returns the resulting value of the reference count, which is used for diagnostic/testing
' purposes only.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_Release CDECL(BYVAL pThis AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_Release (BYVAL pThis AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pThis
pvtbl = @ppthis
ppmethod = pvtbl + 8
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_Release(pThis) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT Next([in] UI4 celt, [in] *VARIANT rgvar, [out] *UI4 pceltFetched)
' The Next method enumerates the next celt elements in the enumerator's list, returning them in
' rgelt along with the actual number of enumerated elements in pceltFetched.
' Parameters:
' celt : [in] Number of items in the array.
' rgelt : [out] Address of array containing items.
' pceltFetched: [out] Address of variable containing actual number of items.
' Return Value:
' Returns %S_OK if the method succeeds.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_Next CDECL(BYVAL pThis AS DWORD, BYVAL celt AS DWORD, BYREF rgelt AS VARIANT, BYREF pceltFetched AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_Next (BYVAL pThis AS DWORD, BYVAL celt AS DWORD, BYREF rgelt AS VARIANT, BYREF pceltFetched AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pThis
pvtbl = @ppthis
ppmethod = pvtbl + 12
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_Next(pThis,celt,rgelt,pceltFetched) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT Skip([in] UI4 celt)
' The Skip method Instructs the enumerator to skip the next celt elements in the enumeration so
' the next call to IENumVARIANT_Next does not return those elements.
' Parameter:
' celt : [in] Number of items to skip.
' Return Value:
' Returns %S_OK if the method succeeds.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_Skip CDECL(BYVAL pThis AS DWORD, BYVAL celt AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_Skip (BYVAL pThis AS DWORD, BYVAL celt AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pThis
pvtbl = @ppthis
ppmethod = pvtbl + 16
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_Skip(pThis,celt) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT Reset()
' The Reset method instructs the enumerator to position itself at the beginning of the list
' of elements.
' Return Value:
' Returns %S_OK if the method succeeds.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_Reset CDECL(BYVAL pThis AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_Reset (BYVAL pThis AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pThis
pvtbl = @ppthis
ppmethod = pvtbl + 20
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_Reset(pThis) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT Clone([out] **IEnumVARIANT ppenum)
' The Clone method creates another items enumerator with the same state as the current
' enumerator to iterate over the same list. This method makes it possible to record a point in
' the enumeration sequence in order to return to that point at a later time.
' Parameters:
' pThis : Pointer
' ppenum [out] Address of a variable that receives the IEnumVARIANT interface pointer.
' Return Value:
' Returns %S_OK if the method succeeds.
' Remarks
' The caller must release the new enumerator separately from the first enumerator.
' *********************************************************************************************
DECLARE FUNCTION Template_IEnumVARIANT_Clone CDECL(BYVAL pThis AS DWORD, BYVAL ppenum AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IEnumVARIANT_Clone (BYVAL pThis AS DWORD, BYVAL ppenum AS DWORD) EXPORT AS DWORD
LOCAL HRESULT AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = pThis
pvtbl = @ppthis
ppmethod = pvtbl + 24
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IEnumVARIANT_Clone(pThis,ppenum) TO hresult
FUNCTION = HRESULT
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' ENUMERATOR - Helper function to enumerate collectios.
' Parameter:
' pUnk = Pointer to the collection.
' Return Value:
' Returns a pointer to a safe array containing the contents of the collection or %Null.
' It is responsability of the caller to free this safe array.
' *********************************************************************************************
FUNCTION FsoEnumerator (BYVAL pUnk AS DWORD) EXPORT AS DWORD
LOCAL IID_IEnumVariant AS GUID
IID_IEnumVARIANT = GUID$("{00020404-0000-0000-c000-000000000046}")
LOCAL HRESULT AS DWORD
LOCAL pIEnumVARIANT AS DWORD
LOCAL nElements AS DWORD
LOCAL celtFetched AS DWORD
LOCAL vRes AS VARIANT
LOCAL aBound AS SAFEARRAYBOUNDTYPE
LOCAL hsa AS DWORD
LOCAL idx AS LONG
IF pUnk = 0 THEN EXIT FUNCTION
' ------------------------------------------------------------------
' Find is the interface is supported
' ------------------------------------------------------------------
HRESULT = IEnumVARIANT_QueryInterface (pUnk, IID_IEnumVARIANT, VARPTR(pIEnumVARIANT))
IF HRESULT <> %S_OK THEN EXIT FUNCTION
' ------------------------------------------------------------------
' Position the enumerator at the beginning of the list of elements
' ------------------------------------------------------------------
HRESULT = IEnumVARIANT_Reset (pIEnumVARIANT)
IF HRESULT <> %S_OK THEN
IEnumVARIANT_Release pIEnumVARIANT
EXIT FUNCTION
END IF
' ------------------------------------------------------------------
' Count the number of elements in the collection
' ------------------------------------------------------------------
nElements = 0
DO
HRESULT = IEnumVARIANT_Next (pIEnumVARIANT, 1, vRes, celtFetched)
IF HRESULT <> %S_OK OR celtFetched < 1 THEN EXIT DO
nElements = nElements + 1
LOOP
' ------------------------------------------------------------------
' Exit if the collection is empty
' ------------------------------------------------------------------
IF nElements = 0 THEN
IEnumVARIANT_Release pIEnumVARIANT
EXIT FUNCTION
END IF
' ------------------------------------------------------------------
' Create the safe array
' ------------------------------------------------------------------
aBound.cElements = nElements
aBound.lLBound = 1
hsa = SafeArrayCreate (%VT_VARIANT, 1, aBound)
IF hsa = 0 THEN
IEnumVARIANT_Release pIEnumVARIANT
EXIT FUNCTION
END IF
' ------------------------------------------------------------------
' Position the enumerator at the beginning of the list of elements
' ------------------------------------------------------------------
HRESULT = IEnumVARIANT_Reset (pIEnumVARIANT)
IF HRESULT <> %S_OK THEN
IEnumVARIANT_Release pIEnumVARIANT
EXIT FUNCTION
END IF
' ------------------------------------------------------------------
' Fill the safe array
' ------------------------------------------------------------------
idx = 1
DO
HRESULT = IEnumVARIANT_Next (pIEnumVARIANT, 1, vRes, celtFetched)
IF HRESULT <> %S_OK OR celtFetched < 1 THEN EXIT DO
SafeArrayPutElement hsa, BYVAL VARPTR(idx), BYVAL VARPTR(vRes)
idx = idx + 1
LOOP
' ------------------------------------------------------------------
' Release the collection and return a pointer to the safe array
' ------------------------------------------------------------------
HRESULT = IEnumVARIANT_Release(pIEnumVARIANT)
FUNCTION = hsa
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' HRESULT _NewEnum([out,retval] *UNKNOWN pReturn)
' Returns a a reference to the IUnknown interface of the Drive collection.
' *********************************************************************************************
DECLARE FUNCTION Template_IDrive_NewEnum CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS DWORD) AS DWORD
' *********************************************************************************************
FUNCTION IDrive_NewEnum (BYVAL lpDrives AS DWORD) EXPORT AS DWORD
LOCAL lpUnk AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
LOCAL pmethod AS DWORD
ppthis = lpDrives
pvtbl = @ppthis
ppmethod = pvtbl + 32
pmethod = @ppmethod
CALL DWORD pmethod USING Template_IDrive_NewEnum(lpDrives,lpUnk) TO Drv_Error_Code
FUNCTION = lpUnk
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' Enumerates the Drives collection and returns an array of dwords in a VARIANT.
' *********************************************************************************************
' Example:
'
' DIM vRes AS VARIANT
' DIM aDrives(0) AS DWORD
' DIM i AS LONG
' IF IDrive_EnumerateDrives(lpFso, vRes) THEN
' aDrives() = vRes
' FOR i = LBOUND(aDrives) TO UBOUND(aDrives)
' STDOUT "Drive: " & IDrive_GetDriveLetter(aDrives(i))
' NEXT
' END IF
' *********************************************************************************************
FUNCTION IDrive_EnumerateDrives (BYVAL lpDrives AS DWORD, vRes AS VARIANT) EXPORT AS LONG
LOCAL lpUnk AS DWORD
LOCAL hsa AS DWORD
LOCAL IEnumLBound AS LONG
LOCAL iEnumUBound AS LONG
LOCAL hr AS DWORD
LOCAL vVar AS VARIANT
LOCAL i AS LONG
lpUnk = IDrive_NewEnum(lpDrives)
IF lpUnk THEN
hsa = FsoEnumerator(lpUnk)
IF hsa THEN
SafeArrayGetLBound hsa, 1, IEnumLBound
SafeArrayGetUBound hsa, 1, IEnumUBound
REDIM aDrives(IEnumLBound TO iEnumUBound) AS DWORD
FOR i = IEnumLBound TO IEnumUBound
hr = SafearrayGetElement(hsa, BYVAL VARPTR(i), BYVAL VARPTR(vVar))
IF hr THEN EXIT FOR
aDrives(i) = VARIANT#(vVar)
NEXT
SafeArrayDestroy(hsa) '// Destroy the SafeArray
vRes = aDrives() '// Return the array in a VARIANT
FUNCTION = -1 '// The mark of success
END IF
END IF
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
FUNCTION ShowDriveType (BYVAL lpDrive AS DWORD) AS STRING
DIM S AS STRING
SELECT CASE IDrive_GetDriveType (lpDrive)
CASE %MIDL___MIDL_itf_scrrun_0094_0001_Removable
S = "Removable"
CASE %MIDL___MIDL_itf_scrrun_0094_0001_Fixed
S = "Fixed"
CASE %MIDL___MIDL_itf_scrrun_0094_0001_Remote
S = "Remote"
CASE %MIDL___MIDL_itf_scrrun_0094_0001_CDRom
S = "CD-ROM"
CASE %MIDL___MIDL_itf_scrrun_0094_0001_RamDisk
S = "RAM Disk"
CASE ELSE
S = "Unknown"
END SELECT
FUNCTION = S
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
SUB ShowDriveInformation (BYVAL lpFso AS DWORD)
DIM S AS STRING
LOCAL lpDrives AS DWORD
LOCAL i AS LONG
lpDrives = IDrive_GetDrives(lpFso)
DIM vRes AS VARIANT
DIM aDrives(0) AS DWORD
IF IDrive_EnumerateDrives(lpDrives, vRes) THEN
aDrives() = vRes
FOR i = LBOUND(aDrives) TO UBOUND(aDrives)
S = S & "Drive letter: " & IDrive_GetDriveLetter(aDrives(i)) & $CRLF
S = S & "Path: " & IDrive_GetDrivePath(aDrives(i)) & $CRLF
S = S & "Drive type: " & ShowDriveType(aDrives(i)) & $CRLF
S = S & "Ready: " & IIF$(IDrive_DriveIsReady(aDrives(i)), "True", "False") & $CRLF
IF IDrive_DriveIsReady(aDrives(i)) THEN
IF IDrive_GetDriveType (aDrives(i)) THEN
S = S & "Share name: " & IDrive_GetShareName(aDrives(i)) & $CRLF
ELSE
S = S & "Volume name: " & IDrive_GetVolumeName(aDrives(i)) & $CRLF
END IF
S = S & "File system: " & IDrive_GetFileSystem(aDrives(i)) & $CRLF
S = S & "Total size: " & STR$(IDrive_GetTotalSize(aDrives(i))) & $CRLF
S = S & "Free space: " & STR$(IDrive_GetFreeSpace(aDrives(i))) & $CRLF
S = S & "Available space: " & STR$(IDrive_GetAvailableSpace(aDrives(i))) & $CRLF
S = S & "Serial number: " & STR$(IDrive_GetSerialNumber(aDrives(i))) & $CRLF
END IF
MSGBOX s, %MB_ICONINFORMATION, "Drive information"
S = ""
NEXT
END IF
END SUB
' *********************************************************************************************
' *********************************************************************************************
' ** Main **
' *********************************************************************************************
FUNCTION PBMAIN
' -------------------------------------------------------------------------
' ** STARTUP **
' -------------------------------------------------------------------------
' Create an instance of the object.
' -------------------------------------------------------------------------
LOCAL oFso AS DISPATCH
SET oFso = NEW DISPATCH IN "Scripting.FileSystemObject"
IF ISFALSE ISOBJECT(oFso) THEN EXIT FUNCTION
' -------------------------------------------------------------------------
' -------------------------------------------------------------------------
' Get the object pointer to be used with the wrapper functions
' -------------------------------------------------------------------------
LOCAL lpFso AS DWORD
lpFso = OBJPTR(oFso)
' --------------------------------------------------------------------------
ShowDriveInformation (lpFso)
' Example of how obtain the total size of a drive
' LOCAL lpDrive AS DWORD
' lpDrive = IDrive_GetDrive(lpFso, "C")
' MSGBOX STR$(IDrive_GetTotalSize(lpDrive))
' -------------------------------------------------------------------------
' ** CLEANUP **
' -------------------------------------------------------------------------
' Release the FileSystem object
' -------------------------------------------------------------------------
SET oFso = NOTHING
END FUNCTION
' *********************************************************************************************
------------------
[This message has been edited by JOSE ROCA (edited September 08, 2003).]