Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
'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
%Unicode=1
#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$ = "get" Then
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$ = "save" Then
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
http://www.garybeene.com/sw/gbsnippets.htm