Author Topic: FileSystemObject Enumerate Files  (Read 5015 times)

0 Members and 1 Guest are viewing this topic.

Offline Norm Cook

  • Newbie
  • *
  • Posts: 8
  • User-Rate: +0/-0
FileSystemObject Enumerate Files
« on: January 06, 2014, 02:51:59 PM »
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]
#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]
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 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

Offline José Roca

  • Administrator
  • Hero Member
  • *****
  • Posts: 2481
  • User-Rate: +204/-0
Re: FileSystemObject Enumerate Files
« Reply #1 on: January 06, 2014, 03:18:32 PM »
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]
#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

Offline Norm Cook

  • Newbie
  • *
  • Posts: 8
  • User-Rate: +0/-0
Re: FileSystemObject Enumerate Files
« Reply #2 on: January 07, 2014, 02:13:37 PM »
Many thanks, Jose.
Ran without error after two additions:
#Include "oaidl.inc"      'for IEnumVARIANT
Dim pFile As IFile

Offline Norm Cook

  • Newbie
  • *
  • Posts: 8
  • User-Rate: +0/-0
Re: FileSystemObject Enumerate Files
« Reply #3 on: January 07, 2014, 03:30:13 PM »
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]
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

Offline Norm Cook

  • Newbie
  • *
  • Posts: 8
  • User-Rate: +0/-0
Re: FileSystemObject Enumerate Files
« Reply #4 on: January 07, 2014, 03:38:14 PM »
Forget, here's how I called ReadFolder

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