Comple to console, "CompressProject myproject.pbp" (note, i think you have to close your project to get it written to disk)
it's quick&dirty with no frills... mostly x-plat, except for 1 API call to get the full path.
Just found it useful, so I thought I'd share it. (I suppose you could add it as a tool/menu...)
It will grab files from PB project file, and source file XincludeFile, IncludeFile,IncludeBinary, Import.
Code: Select all
; update 2023-04-24
; Use readString() instead of Readdata()
; small windows improvement
;todo grab hard-coded files (like OpenFile(0,"MyFile.exe") or "OpenDatabase()"
UseLZMAPacker()
;- Regex to pull out any file names that are included in project file or source.
CreateRegularExpression(0,"(?i)^[ \t]*(\<(outputfile|file name|inputfile|executable|icon enable)|import|includefile|xincludefile|includebinary).*$",#PB_RegularExpression_MultiLine)
;- If non-windows, you are case-specific, so ignore lcase() calls
; we windows user can be sloppy with file names & capitilization...
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
Macro LCase(a) : a : EndMacro
CompilerEndIf
CompilerIf #PB_Compiler_Debugger ;- if debuger, don't use console...
Macro PrintN(a) : Debug a : EndMacro
Macro OpenConsole() : : EndMacro
Macro CloseConsole() : : EndMacro
Macro Input() : : EndMacro
CompilerEndIf
;- use a map to skip duplicate includes
Global NewMap files.s()
CompilerIf #PB_Compiler_Unicode
#PATH_MAX = 32767
CompilerElse
#PATH_MAX = #MAX_PATH
CompilerEndIf
;- gets fullpath from partial or relative paths
Procedure.s getDirectoryEntry( file.s )
Protected here.s, dir
dir = ExamineDirectory(#PB_Any, GetPathPart(file), GetFilePart(file))
If dir
If NextDirectoryEntry(dir)
here = GetCurrentDirectory()
SetCurrentDirectory( GetPathPart(file))
file = GetCurrentDirectory()+DirectoryEntryName(dir)
SetCurrentDirectory(here)
EndIf
FinishDirectory(dir)
EndIf
ProcedureReturn file
EndProcedure
;- detect if the console was opened by windows or w/in cmd.exe
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Enumeration
#ParentInfoPID
#ParentInfoName
EndEnumeration
Procedure.s GetParentInfo(GetWhat, MyPid = 0 )
Protected lppe.PROCESSENTRY32
Protected hSnap = CreateToolhelp32Snapshot_(#TH32CS_SNAPPROCESS , 0)
Static ParentPID, ParentName.s
Protected.s ReturnInfo
If ParentName = ""
If MyPid = 0
MyPid = GetCurrentProcessId_()
EndIf
If hSnap <> #INVALID_HANDLE_VALUE
lppe\dwSize = SizeOf(PROCESSENTRY32)
If Process32First_(hSnap, @lppe)
Repeat
If lppe\th32ProcessID = mypid
ParentPID = lppe\th32ParentProcessID
Debug "my parent pid is = " + Str(ParentPID)
Break
EndIf
Until Process32Next_(hSnap, @lppe) = 0
EndIf
If Process32First_(hSnap, @lppe)
Repeat
If lppe\th32ProcessID = ParentPID
ParentName = PeekS(@lppe\szExeFile[0])
Debug "and its name is = " + ParentName
Break
EndIf
Until Process32Next_(hSnap, @lppe) = 0
EndIf
EndIf
EndIf
Select GetWhat
Case #ParentInfoName
ReturnInfo = ParentName
Case #ParentInfoPID
ReturnInfo = Str(ParentPID)
EndSelect
ProcedureReturn ReturnInfo
EndProcedure
Macro IsConsole() : Bool(LCase(GetParentInfo(#ParentInfoName)) = "cmd.exe") : EndMacro
CompilerElse ; Sorry, don't have code for linux/mac, so always say "press enter..."
Macro isConsole() : #False : EndMacro
CompilerEndIf
Procedure.s GetFullPathName( cPath.s, bExact = #False )
Protected cFullPath.s, *Buffer, nSize, *FilePart
*Buffer = AllocateMemory(#PATH_MAX * SizeOf(Character))
If *Buffer
nSize = GetFullPathName_(@cPath,#PATH_MAX,*Buffer,@*FilePart)
If nSize
cFullPath = PeekS(*Buffer,nSize)
;If *FilePart
; Debug PeekS(*FilePart)
;EndIf
EndIf
FreeMemory(*Buffer)
Else
Debug "Alloc failure"
EndIf
If bExact : cFullPath = GetDirectoryEntry( cFullPath ) : EndIf
ProcedureReturn cFullPath
EndProcedure
;- just read the text file to a string.
Procedure.s ReadToString( file.s )
Protected fdata.s, s
Select GetExtensionPart(file)
Case "pb","pbp","pbi", "pbf"
If ReadFile(0,file)
fdata = ReadString(0,#PB_File_IgnoreEOL,Lof(0))
EndIf
EndSelect
ProcedureReturn fdata
EndProcedure
;- Look in each file for additional files & go recursively.
Procedure ScanForIncludes( file.s )
Define str.s,path.s, lFile.s, libTmp.s
Dim results.s(0)
File=GetFullPathName(file,#True) : lfile=file;: lFile=LCase(file)
If FindMapElement(files(), lFile)=#False
str = ReadToString( file )
files(lFile)=file
If str<>""
t = ExtractRegularExpression(0,str,results())
path=GetPathPart(file)
While x < t
results(x)=Trim(results(x))
If Left(results(x),3)="<ic"
results(x)=StringField(StringField(results(x),2,">"),1,"<")
ElseIf FindString(results(x),#DQUOTE$)
results(x)=StringField(results(x),2,#DQUOTE$)
EndIf
If LCase(GetExtensionPart(results(x)))="lib"
;- add the dll & exp components to the list.
libTmp=Left(results(x),Len(results(x))-3)
t+2
ReDim results( t )
results(t-1) = libtmp+"dll"
results( t ) = libtmp+"exp"
EndIf
results(x)=path+results(x)
If FindMapElement( files(), LCase(results(x)) )= #False
ScanForIncludes(results(x))
EndIf
x+1
Wend
EndIf
EndIf
EndProcedure
OpenConsole()
Define x, param.s, d, archive.s
x = CountProgramParameters()
If x = 0
PrintN("You must pass at least 1 file to process..(source or project file, wildcads ok)")
Else ;- for each parameter, scan the file ..
PrintN("Scanning...")
While x > 0
x-1
param = ProgramParameter()
;- Load base project or source file.
d = ExamineDirectory(#PB_Any, GetPathPart(param),GetFilePart(param))
If d
While NextDirectoryEntry(d)
If DirectoryEntryType(d)=#PB_DirectoryEntry_File
If archive = ""
archive = GetFilePart(DirectoryEntryName(d),#PB_FileSystem_NoExtension)
EndIf
ScanForIncludes(GetPathPart(param)+DirectoryEntryName(d))
EndIf
Wend
FinishDirectory(d)
EndIf
Wend
;- Get current folder to reduce the folder depth in archive to a relative folder.
Define here.s = GetCurrentDirectory()
;- Pack name.
Define packname.s = FormatDate(here+"\backup\"+archive+"-%yyyy%mm%dd%hh%ii%ss.7z",Date())
PrintN("Archive: "+packname)
;- Ensure backup folder is there.
CreateDirectory(here+"\backup")
;-create the pack
CreatePack(0,packname,#PB_PackerPlugin_Lzma,9)
CompilerIf #False ;- sort the file list.
NewList filesL.s() ;- Move files to a list for sorting
ForEach files()
AddElement(filesl()) : filesl() = files()
Next
SortList(filesl(),#PB_Sort_Ascending) ;- Sort the actual list.
;ClearMap( files() ) : FreeMap(files())
Macro files() : filesL() : EndMacro ;- macro to make the rest of the code work with sorted list.
CompilerEndIf
;- Scan the file list and add to the pack
ForEach files()
If FileSize(files())>=0
PrintN("Adding "+files())
AddPackFile(0, files(), ReplaceString(ReplaceString( files(),here, "", #PB_String_NoCase) , "\", "/" ) )
EndIf
Next
;- Finish up.
ClosePack(0)
FreeRegularExpression(0)
If Not IsConsole() ; don't show 'press enter' if started in cmd.exe
PrintN("Press 'enter' to close")
Input()
EndIf
CloseConsole()
CompilerIf #PB_Compiler_Debugger ;- Open pack if run in IDE
RunProgram(packname, "", here)
CompilerEndIf
EndIf
; IDE Options = PureBasic 6.02 beta 2 LTS (Windows - x64)
; ExecutableFormat = Console
; CursorPosition = 46
; FirstLine = 22
; Folding = 869-83-t2
; Optimizer
; EnableThread
; EnableXP
; Executable = CompressProject.exe
; EnablePurifier
; EnableExeConstant
