gbFileMerge - Create GBS File From Samples

Category: Utilities

Date: 03-28-2012

Return to Index


 
'This snippet will create a gbSnippets library file (*.bas) containing every
'*.bas, *.inc, and *.rc file it finds in a target folder.
 
'The snippet below first reads all of the subfolders. Then it reads all of the
'files. Both lists are displayed in listboxes with the full path of the folder/file.
'In the last step, the files are read and converted into a gbSnippets library
'whose location/name is specified by the user.
 
'gbSnippets has the built-in ability to import individual files. This snippet
'provides a batch import capability.
 
 
'Primary Code:
'The snippets in a gbSnippets library are delimited by the string "++-" + "-;;".
'The first line of a snippet is its Tree depth (1-n). All remaining lines in a
'snippet comprise the source code.  The first line of the source code is normally
'used for the title that is displayed in the gbSnippet Tree. In this case, the
'file name is used as the first line of each snippet in order to document the
'source of the code.
 
'Compilable Example:
'Creates two string arrays, Files() and Folders()
'Content of each are displayed in a ListBox
'Commands are avaialable to create the merge, library, and copies.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Include "win32api.inc"
#Resource "gbsnippets.pbr"
Global hDlg As DWord
Global ExtList, LibraryFileName, MergeFileName, DestDir, HomeDir, Files(), Folders() As String
Global FileCount, FolderCount As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "gbFileMerge",300,100,720,180,%WS_OverlappedWindow To hDlg
   Dialog Set Icon hDlg, "aainfo"
 
   Control Add Button, hDlg, 110, "Select Search Folder", 20,10,120,20
   Control Add TextBox, hDlg, 100, HomeDir, 20,40,475,20
   Control Add Label, hDlg, 136, "Extensions", 510,25,100,20
   Control Add TextBox, hDlg, 137, "bas inc rc", 510,40,140,20
 
   Control Add Button, hDlg, 140, "Select Output Folder", 20,75,120,20
   Control Add Button, hDlg,  450, "Open Output Folder", 150, 75,120,20, %BS_Left
   Control Add TextBox, hDlg, 130, DestDir, 20,105,475,20
   Control Add Label, hDlg, 135, "Output File Names", 600,70,100,20
   Control Add TextBox, hDlg, 134, MergeFileName, 600,90,100,20
   Control Add TextBox, hDlg, 131, LibraryFileName, 600,120,100,20
 
   Control Add Button, hDlg,  200, "1. Create Folder List", 10,150,120,20, %BS_Left
   Control Add Button, hDlg,  300, "2. Create File List", 160, 150, 120,20, %BS_Left
 
   Control Add Button, hDlg,  461, "Merge", 510, 90, 80,20, %BS_Left
   Control Add Button, hDlg,  400, "Create Library", 510, 120,80,20, %BS_Left
   Control Add Button, hDlg,  460, "Copy Files To ..", 510, 150,80,20, %BS_Left
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local Style, i As Long
   Style = %LBS_Sort Or %LBS_Notify Or %WS_VScroll Or %WS_HScroll Or %WS_Border Or %WS_TabStop
   Select Case CB.Msg
      Case %WM_InitDialog
         FolderCount = -1 : FileCount = -1
         LibraryFileName = "PBSamples.gbs"
         ExtList = "bas inc pbr"
 
         Settings_INI "get"
         Control Set Text hDlg, 100, HomeDir
         Control Set Text hDlg, 130, DestDir
         Control Set Text hDlg, 131, LibraryFileName
         Control Set Text hDlg, 134, MergeFileName
         Control Set Text hDlg, 137, ExtList
      Case %WM_Destroy
         Settings_INI "save"
      Case %WM_Command
         Select Case CB.Ctl
            Case 110  'Select input folder
               Control Get Text hDlg, 100 To HomeDir
               HomeDir = SelectFolder (HomeDir)
               Control Set Text hDlg, 100, HomeDir
 
            Case 140  'Select Output folder
               Control Get Text hDlg, 130 To DestDir
               DestDir = SelectFolder (DestDir)
               Control Set Text hDlg, 130, DestDir
 
            Case 200  'create folder listing
               Control Get Text hDlg, 100 To HomeDir
               HomeDir = Trim$(HomeDir,"\")
               If IsFalse(IsFolder(HomeDir)) Then  MsgBox "Search folder does not exist!",,"Create Folder List" : Exit Function      'must start with folder
               FolderCount = -1 : FileCount = -1
               Dialog Set Size hDlg, 800,640
               ListBox Reset hDlg,700
               ListBox Reset hDlg,800
               ReDim Folders(100000)   'arbitrarily large
               ListSubFolders(HomeDir)
               ReDim Preserve Folders(FolderCount)
               Control Kill hDlg, 700
               Control Add ListBox, hDlg, 700, Folders(), 10,190,280,420, Style, %WS_Ex_ClientEdge
               Control Send hDlg, 700, %LB_SetHorizontalExtent, 1000, 0
               Dialog Set Text hDlg, "gbFileMerge   " +  Str$(FolderCount+1) + " folders"
 
            Case 300   'create file listing
               If FolderCount = -1 Then MsgBox "Folder list empty!",,"Create File List" : Exit Function
               FileCount = -1
               Control Get Text hDlg, 130 To DestDir
               Control Get Text hDlg, 131 To LibraryFileName
               Dialog Set Size hDlg, 800,640
               ReDim Files(250000)
               Control Get Text hDlg, 137 To ExtList
               If Len(ExtList) = 0 Then Exit Function
               For i = 1 To ParseCount(ExtList," ")
                  ListFiles Parse$(ExtList," ", i)
               Next i
               If FileCount > -1 Then
                  ReDim Preserve Files(FileCount)
                  Control Kill hDlg, 800
                  Control Add ListBox, hDlg, 800, Files(), 310,190,480,420, Style, %WS_Ex_ClientEdge
                  Control Send hDlg, 800, %LB_SetHorizontalExtent, 1000, 0
                  Dialog Set Text hDlg, "gbFileMerge   " + Str$(FolderCount+1) + " folders, " + Str$(FileCount+1) + " files."
               Else
                  MsgBox "No files found!", %MB_Ok, "Create File List"
               End If
            Case 400
               If FileCount = -1 Then MsgBox "File list empty!",,"Create Library" : Exit Function
               CreateGBSFile
               If MsgBox ("File created! Open containing Folder?",%MB_OkCancel,"Create Library File") = %IdOk Then OpenOutputFolder
            Case 450
               OpenOutputFolder
            Case 460
               If FileCount = -1 Then MsgBox "File list empty!",,"Copy Files" : Exit Function
               CopyAllToFolder
            Case 461
               If FileCount = -1 Then MsgBox "File list empty!",,"Merge Files" : Exit Function
               Control Set Text hDlg, 134, MergeFileName
               MergeAllIntoOneFile
         End Select
   End Select
End Function
 
Sub OpenOutputFolder
   Local TargetPath As Asciiz * %Max_Path
   Control Get Text hDlg, 130 To DestDir
   TargetPath = DestDir
   ShellExecute(hDlg, "Explore", TargetPath, $Nul, $Nul, %SW_Restore)
End Sub
 
Sub ListSubFolders(startfolder$)            'Start$ cannot end in \
   'returns list of folder (full paths) in Folder() - unsorted, paths DO NOT end in "\"
   Local temp$, iPOS As Long
   Incr FolderCount
   Folders(FolderCount) = startfolder$
   While Len(Folders(iPOS))
      temp$ = Dir$(Build$(Folders(iPOS),"\*.*"), Only %SubDir)  'subfolders only
      While Len(temp$)
         Incr FolderCount
         Folders(FolderCount) =  Build$(Folders(iPos),"\",temp$)
         temp$ =  Dir$ (Next)
      Wend
      Incr iPOS
   Wend
End Sub
 
Sub ListFiles(FileExt As String)   'uses the Folders() array to populates Files() array
   Dim i As Long, file$       '100K
   For i = 0 To UBound(Folders)
      file$ = Dir$(Folders(i) + "\*." + FileExt)  'the folder paths do not have the ending "\"
      While Len(file$)
         'Replace HomeDir+"\" With "" in Folders(i)
         Incr FileCount
         Files(FileCount) = Folders(i) + "\" + file$
         file$ = Dir$
      Wend
   Next i
End Sub
 
Sub CreateGBSFile
   Local i,j,k, CurrentFolderLevel As Long, fName$, fPath$, temp$, oldPath$, SampleFile$
 
   SampleFile$ = Trim$(DestDir,"\") + "\" + LibraryFileName
 
   Dim Levels(100) As String
   If IsFile(SampleFile) Then Kill SampleFile    'kill pre-existing copy of output file
 
   'Open output file and add root information
   Open SampleFile For Output As #1
   Print #1, "0" + $CrLf + "PowerBASIC Samples" + $CrLf + "PowerBASIC"
 
   'Add each BAS file
   For i = 1 To FileCount + 1
      ListBox Get Text hDlg, 800, i To fName$
 
      Replace HomeDir+"\" With "" In fName$
      fPath$ = RTrim$(PathName$(Path, fName$),"\")
 
      'ensure that parent levels have been written
      CurrentFolderLevel = ParseCount(fPath$,"\")       'highest folder level
 
      'print folder (parent) entries
      For j = 1 To CurrentFolderLevel
         If Parse$(fPath$,"\",j) <> Parse$(oldPath$,"\",j) Then 'print the level
            Print #1, "++-" + "-;;"
            Print #1, Str$(j)
            Print #1, Parse$(fPath$,"\",j)
         End If
      Next j
 
      'read the source file
      Open HomeDir + "\" + fName$ For Binary As #2
      Get$ #2, Lof(2), temp$
      Replace Chr$(0) With $crlf in temp$
      Close #2
 
      'add the source file to SampleFile
      Print #1, "++-" + "-;;"
      Print #1, CurrentFolderLevel + 1             'one more than folder level
      Print #1, PathName$(Namex, fName$)     'filename is line 1 of each snippet
      Print #1, temp$
 
      oldPath$ = fPath$
   Next i
 
   Close #1   'done
End Sub
 
Function SelectFolder (start$) As String
   Local title$, flags&, folder$
   title$ = "Select Folder"    'if "" then "Open" is used
   flags& = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_NoNewFolderButton
   Display Browse  hDlg, 100, 100, title$, start$, flags& To folder$
   If Len(folder$) Then
      Function = folder$
   Else
      Function = start$       'ESC or Cancel
   End If
End Function
 
Sub CopyAllToFolder
   Local tName$, title$, fname$, flags&, folder$, start$, i, iCount As Long
   Control Get Text hDlg, 100 To start$
   title$ = "Select Folder"    'if "" then "Open" is used
   flags& = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_NoNewFolderButton
   Display Browse  hDlg, 100, 100, title$, start$, flags& To folder$
   If Len(folder$) Then
      'copy all to folder$
      For i = 1 To FileCount + 1
         ListBox Get Text hDlg, 800, i To fName$
         tName$ = folder$ + "\" + PathName$(Namex, fName$)
         If fName$ <> tName$ Then
            FileCopy fName$, tName$
            Incr iCount
         End If
      Next i
      If MsgBox ("Files copied (" + Trim$(Str$(iCount))+"). Open containing folder?",%MB_OkCancel,"Copy Files") = %IdOk Then
         Local TargetPath As Asciiz * %Max_Path
         TargetPath = folder$
         ShellExecute(hDlg, "Explore", TargetPath, $Nul, $Nul, %SW_Restore)
      End If
   End If
End Sub
 
Sub MergeAllIntoOneFile
   Local i, iCount As Long, temp, fName, SourceFile As String
 
   SourceFile = Trim$(DestDir,"\") + "\" + MergeFileName
   If IsFile(SourceFile) Then Kill SourceFile    'kill pre-existing copy of output file
 
   'Open output file and add root information
   Open SourceFile For Output As #1
 
   'Add each BAS file
   For i = 1 To FileCount + 1
      ListBox Get Text hDlg, 800, i To fName
      'read the source file
      Open fName For Binary As #2
      Get$ #2, Lof(2), temp
      Close #2
 
      'add the source file to SampleFile
      Print #1, "==File:== " + fName + String$(80,"=")
      Print #1, temp
      Incr iCount
   Next i
 
   Close #1   'done
   If MsgBox ("Files merged: " + Str$(iCount) + ".  Open containing folder?",%MB_OkCancel,"Merge Files") = %IdOk Then
      Local TargetPath As Asciiz * %Max_Path
      TargetPath = DestDir
      ShellExecute(hDlg, "Explore", TargetPath, $Nul, $Nul, %SW_Restore)
   End If
End Sub
 
Sub Settings_INI(Task$)
   Local x As Long, y As Long, iResult&
   Local xResult As Asciiz*%Max_Path, yResult As Asciiz*%Max_Path
   Local temp As Asciiz*%Max_Path, INIFileName As Asciiz*%Max_Path
 
   'defines file name (any file name will work)
   INIFileName = Exe.Path$ + "gbfilemerge.ini"
 
   If Task$ = "getThen
      Getprivateprofilestring "All", "ExtList", "bas inc rc", temp, %Max_Path, INIFileName
      ExtList = temp
      Getprivateprofilestring "All", "HomeDir", "c:\pbwin90\samples", temp, %Max_Path, INIFileName
      HomeDir = temp
      Getprivateprofilestring "All", "DestDir", "c:\pbwin90\samples", temp, %Max_Path, INIFileName
      DestDir = temp
      Getprivateprofilestring "All", "LibraryFileName", "pb_samples.gbs", temp, %Max_Path, INIFileName
      LibraryFileName = temp
      Getprivateprofilestring "All", "MergeFileName", "merge.txt", temp, %Max_Path, INIFileName
      MergeFileName = temp
   End If
 
   If Task$ = "saveThen
      Control Get Text hDlg, 137 To Temp
      WritePrivateProfileString "All", "ExtList", temp, INIFileName
      Control Get Text hDlg, 100 To Temp
      WritePrivateProfileString "All", "HomeDir", temp, INIFileName
      Control Get Text hDlg, 130 To Temp
      WritePrivateProfileString "All", "DestDir", temp, INIFileName
      Control Get Text hDlg, 131 To Temp
      WritePrivateProfileString "All", "LibraryFileName", temp, INIFileName
      Control Get Text hDlg, 134 To Temp
      WritePrivateProfileString "All", "MergeFileName", temp, INIFileName
   End If
End Sub
 
'gbs_00559
'Date: 03-10-2012


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