FileSystemObject Enumerate Files

[Norm Cook]

Jose, in the PB forum http://www.powerbasic.com/support/pbforums/showthread.php?t=24527
I found your code for the subject, but further down it said that the code was obsolete.  I made a few changes
and it worked perfectly in PB10.04.  Is it still obsolete, or just inefficient?

EnumFiles.bas

Code Select Expand


#Compile Exe
#Dim All
#Include Once "win32api.inc"
#Include Once "ienum.inc" 
           
%lstFiles = 1000
Global hDlg As DWord

Function PBMain () As Long
Dialog New Pixels, %HWND_Desktop, "FSO Enumerate Files", , ,250, 400, %WS_Sysmenu To hDlg
Control Add ListBox, hDlg, %lstFiles, , 0, 0, 250, 375
Control Add Button, hDlg, %IDCancel, "Cancel", 75, 377, 75, 20
Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
Select Case CB.Msg
  Case %WM_InitDialog
   EnumerateFiles Exe.Path$ '& "\"  seems to be optional
  Case %WM_Command 
   Select Case CbCtl
    Case %IDCancel
     Dialog End CbHndl
   End Select
End Select
End Function

Sub EnumerateFiles(ByVal FilePath As String)
' Local oFso As ScriptingFileSystemObject
' Set oFso = New ScriptingFileSystemObject In "Scripting.FileSystemObject"
' Create an instance of the object.
Local oFso As IDispatch
' Set oFso = New Dispatch In "Scripting.FileSystemObject"
Let oFso = NEWCOM "Scripting.FileSystemObject"
If IsFalse IsObject(oFso) Then Exit Sub
' Get a reference to the Folder object
Local oFolder As Dispatch
Local vFolder As Variant
Local vPath As Variant
vPath = FilePath
Object Call oFso.GetFolder(vPath) To vFolder
Set oFolder = vFolder
' Get a reference to the Files collection
Local oFiles As Dispatch
Local vFiles As Variant
Object Get oFolder.Files To vFiles
Set oFiles = vFiles
' Get the number of files
' Local vFilesCount As Variant
' Object Get oFiles.Count To vFilesCount'vFiles
' ? "Files count: " & Str$(Variant#(vFilesCount))      not needed
' Enumerate the Folder collection
' Local lpUnk As DWord
Local oItem As Dispatch
Local vVar As Variant
Local vName As Variant
Local i As Long
Local lpFiles As DWord
Dim aFiles(0) As DWord
lpFiles = ObjPtr(oFiles)
If FSO_EnumerateFiles(lpFiles, vVar) Then
  aFiles() = vVar
  vVar = Empty
  For i = LBound(aFiles) To UBound(aFiles)
   FsoMakeDispatch aFiles(i), vVar
   Set oItem = vVar
   Object Get oItem.Name To vName
   ListBox Add hDlg, %lstFiles, Variant$(vName)
   If ObjResult Then Exit For
  Next
End If
' Release the FileSystemObject object
Set oFso = Nothing
End Sub


IEnum.inc

Code Select Expand


' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' enumerator
' enumerates a collection and returns its contents in a safearray.
' compiler : powerbasic for windows, version 7.02, pbcc 3.02
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' safearray api structures
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

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

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' safearray api functions
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 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 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 CDECL(ByVal punk As DWord, ByRef riid As Guid, ByVal ppvobj As DWord) 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 CDECL(ByVal pthis As DWord) 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 CDECL(ByVal pthis As DWord) 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 CDECL(ByVal pthis As DWord, ByVal celt As DWord, ByRef rgelt As Variant, ByRef pceltfetched As DWord) 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 CDECL(ByVal pthis As DWord, ByVal celt As DWord) 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 CDECL(ByVal pthis As DWord) 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 CDECL(ByVal pthis As DWord, ByVal ppenum As DWord) 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
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' hresult _newenum([out, retval] * unknown preturn)
' returns a a reference to the iunknown interface of the drive collection.
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Declare Function template_idrivecollection__newenum CDECL(ByVal pthis As DWord, ByRef preturn As DWord) As DWord
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Function idrivecollection__newenum (ByVal lpdrives As DWord) Export As DWord
Local hresult 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_idrivecollection__newenum(lpdrives, lpunk) To hresult
Function = lpunk
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

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' see if 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
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' helper procedure to the scrrun wrapper functions.
' puts the address of an object in a variant and marks it as containing a dispatch variable
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Sub fsomakedispatch ( _
  ByVal lpobj As DWord, _ ' address of the object instance
  ByRef vobj As Variant _ ' variant to contain this address
  ) Export

Local lpvobj As variantapi Ptr ' pointer to a variantapi structure
Let vobj = Empty ' make sure is empty to avoid memory leaks
lpvobj = VarPtr(vobj) ' get the variant address
@lpvobj.vt = %VT_Dispatch ' mark it as containing a dispatch variable
@lpvobj.vd.pdispval = lpobj ' set the dispatch pointer address

End Sub
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' enumerates the drives collection and returns an array of dwords in a variant.
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Function fso_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 = idrivecollection__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     
Declare Function Template_IFileCollection__NewEnum CDECL(ByVal pThis As DWord, ByRef pReturn As DWord) As DWord
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Function IFileCollection__NewEnum (ByVal lpFiles As DWord) Export As DWord
Local HRESULT 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 = lpFiles
pvtbl = @ppthis
ppmethod = pvtbl + 32
pmethod = @ppmethod
Call DWord pmethod Using Template_IFileCollection__NewEnum(lpFiles, lpUnk) To HRESULT
Function = lpUnk
End Function
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' Enumerates the File collection and returns an array of dwords in a VARIANT.
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Function FSO_Enumeratefiles (ByVal lpFiles 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 = IFileCollection__NewEnum(lpFiles)
If lpUnk Then
  hsa = FsoEnumerator(lpUnk)
  If hsa Then
   SafeArrayGetLBound hsa, 1, IEnumLBound
   SafeArrayGetUBound hsa, 1, IEnumUBound
   ReDim aFiles(IEnumLBound To iEnumUBound) As DWord
   For i = IEnumLBound To IEnumUBound
    hr = SafearrayGetElement(hsa, ByVal VarPtr(i), ByVal VarPtr(vVar))
    If hr Then Exit For
    aFiles(i) = Variant#(vVar)
   Next
   SafeArrayDestroy(hsa) ' / / Destroy the SafeArray
   vRes = aFiles() ' / / Return the array in a VARIANT
   Function = - 1 ' / / The mark of success
  End If
End If
End Function


[José Roca]

That is very old code, from a time when PB had not low-level COM support. With the new compilers and my include files, you can do:

Code Select Expand


#INCLUDE "windows.inc"
#INCLUDE "scrrun.inc"

DIM fso AS IFileSystem
DIM pFolder AS IFolder
DIM pFiles AS IFileCollection
DIM pEnum AS IEnumVARIANT
DIM vItem AS VARIANT
DIM celtFetched AS LONG

' Create an instance of the FileSystemObject
fso = NEWCOM "Scripting.FileSystemObject"
' Get a reference to the IFolder interface
pFolder = fso.GetFolder("C:\MyFolder")
' Get a reference to the IFileCollection interface
pFiles = pFolder.Files
' Enumerate the collectiion
pEnum = pFiles.NewEnum_
DO
   pEnum.Next 1, vItem, celtFetched
   IF celtFetched = 0 THEN EXIT DO
   pFile = vItem
   MSGBOX pFile.Name
LOOP


[Norm Cook]

Many thanks, Jose.
Ran without error after two additions:
#Include "oaidl.inc"      'for IEnumVARIANT
Dim pFile As IFile

[Norm Cook]

For interest, here's a recursive routine that reads all the Folders/Files in
a given directory.  Tried to use the For/Each approach with no success.

Code Select Expand


Sub ReadFolder(InFolder As IFolder)
pFiles = InFolder.Files
pEnum = pFiles.NewEnum_

pEnum.Next 1, vItem, celtFetched           'read the files in the passed folder
Do While celtFetched > 0                               
  pFile = vItem
  ReadF InFolder, pFile
  pEnum.Next 1, vItem, celtFetched
Loop

pFolders = InFolder.SubFolders            'now recurse the passed folder
pEnum = pFolders.NewEnum_

pEnum.Next 1, vItem, celtFetched
Do While celtFetched > 0
  pFolder = vItem
  ReadFolder pFolder 'recurse
  pEnum.Next 1, vItem, celtFetched
Loop
End Sub

Sub ReadF(Fol As IFolder, Fil As IFile)
?Fol.Path & "\" & Fil.Name
End Sub


[Norm Cook]

Forget, here's how I called ReadFolder

Code Select Expand


fso = NEWCOM "Scripting.FileSystemObject"
pFolder = fso.GetFolder("C:\SomeFolder")     '*******hard coded, change***********
ReadFolder pFolder