FileCopy

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
'Creates two string arrays, Files() and Folders()
'Content of each are displayed in a ListBox
'Files() are copied or merged depending on whether outSpec is a file or folder
'SubFolder varaible determines if Files() contains files from subfolders
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
 
Declare Function PATHMATCHSPEC Lib "SHLWAPI.DLL" Alias "PathMatchSpecA" ( pszFile As AsciiZ, pszSpec As AsciiZ ) As Long
 
Enum Equates Singular
   IDC_Button
   IDC_StatusBar
   IDC_ListBox
End Enum
 
Global hDlg As Dword
Global FileCount, FolderCount, FileHidden, FileSystem, SubFolders As Long
Global Files(), Folders() As DirData
Global InSpec, OutSpec As String
 
Function PBMain() As Long
   Dialog New Pixels, 0, "PowerBASIC",300,300,300,300, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_Button,"Push", 50,10,100,20
   Control Add Statusbar, hDlg, %IDC_StatusBar, "", 0,0,0,0
   Control Add ListBox, hDlg, %IDC_ListBox, , 10,40,280,240
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local i As Long, temp$
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_ButtonA
               InSpec = "c:\data\apps\*.*"
               OutSpec = "c:\temp\"
               SubFolders = 1
               GetFileList "c:\data\apps", PathName$(Namex,InSpec)
               For i = 1 To FileCount
                   ListBox Add hDlg, %IDC_ListBox, Files(i).FileName
               Next i
               If IsFile(OutSpec) Then
                   'merge all files into a single file (outSpec)
                   Kill OutSpec
                   Open OutSpec For Append As #1
                   For i = 1 To FileCount
                      Open Files(i).FileName For Binary As #2 : Get$ #2, Lof(2), temp$ : Close #2
                      Print #1, $CrLf
                      Print #1, temp$
                   Next i
                   Close #1
               Else
                   'copy all to same folder
                   For i = 1 To FileCount
                       FileCopy Files(i).FileName, OutSpec + PathName$(Namex, Files(i).FileName)
                   Next i
               End If
         End Select
   End Select
End Function
 
 
Sub GetFileList (ParentFolder$, FileSpec$)
   Local iPos As Long, tempDIR As DirData, temp$, FileAttributes As Long
   ReDim Folders(500), Files(5000)
   FileAttributes = %Normal + %Hidden*FileHidden + %System*FileSystem + %SubDir*SubFolders
   FileCount = 0 : FolderCount = 0 : Reset Files(), Folders()
   Folders(iPos).FileName = ParentFolder$     'no ending \
   Do While Len(Folders(iPos).FileName)
       temp$ = Dir$(Folders(iPos).FileName + "\*.*", FileAttributes, To tempDir)
       Do While Len(temp$)
           tempDir.FileName = Folders(iPos).FileName + "\" + tempDir.FileName
           If (tempDir.FileAttributes And %File_Attribute_Directory) = 0 Then  'files
               If PathMatchSpec((PathName$(Namex,tempDir.Filename)), (FileSpec$)) Then
                   Incr FileCount  :  Files(FileCount) = tempDir
                   If FileCount >= UBound(Files) Then ReDim Preserve Files(UBound(Files)+500)
               End If
           Else                                                                'folder
               Incr FolderCount    :  Folders(FolderCount) = tempDir
               If FolderCount >= UBound(Folders) Then ReDim Preserve Folders(UBound(Folders)+5000)
           End If
           temp$ = Dir$(Next, To tempDir)
           Statusbar Set Text hDlg, %IDC_StatusBar, 1,0, "Folders Searched: " + Str$(FolderCount) + "        Files Found: " + Str$(FileCount)
       Loop
       Incr iPos
   Loop
End Sub         
 
'gbs_01270
'Date: 05-11-2013

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm