PureBasic Forums - English

Code: Select all

UseZipPacker()

; Create the packed file
If CreatePack(0, "mycompressedfiles.zip") 
  ; add your files 
  Debug AddPackFile(0, "File.iso", "File.iso")
  ClosePack(0) 
EndIf

Code: Select all

EnableExplicit

UseZipPacker()

CompilerIf Defined(FormatMessage, #PB_Procedure) = #False

  Procedure.s FormatMessage(ErrorNumber.l)

    Protected *Buffer, len, result.s
   
    len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,ErrorNumber,0,@*Buffer,0,0)
    If len
      result = PeekS(*Buffer, len - 2)
      LocalFree_(*Buffer)
      ProcedureReturn result
    Else
      ProcedureReturn "Errorcode: " + Hex(ErrorNumber)
    EndIf
   
  EndProcedure

CompilerEndIf

Procedure CreateFileSize(sFilename.s, qFilesize.q)
	; Purpose: instantly create a file with a given size (file has random content)
	
	; 20161009 .. nalor .. created
	
	Protected iFileHdl.i=0
	Protected lLoSize.l
	Protected lHiSize.l
	Protected iReturn.i
	Protected iLastError.i
	Protected iTmp.i
	
	Repeat ; single repeat
		iFileHdl = CreateFile_(sFilename, #GENERIC_WRITE, 0, 0, #CREATE_ALWAYS, 0, 0)
		iLastError=GetLastError_()
		If iFileHdl=#INVALID_HANDLE_VALUE
			Debug "ERROR! CreateFile_ failed ("+FormatMessage(iLastError)+")"
			iReturn=-1
			Break
		EndIf
		
		lLoSize=qFilesize & $FFFFFFFF
		lHiSize=(qFilesize>>32) & $FFFFFFFF
		
		iTmp=SetFilePointer_(iFileHdl, lLoSize, @lHiSize, #FILE_BEGIN)
		iLastError=GetLastError_()
		If iTmp=#INVALID_SET_FILE_POINTER And iLastError<>#NO_ERROR
			Debug "ERROR! SetFilePointer_ failed ("+FormatMessage(iLastError)+")"
			iReturn=-1
			Break
		EndIf
		
		iTmp=SetEndOfFile_(iFileHdl)
		iLastError=GetLastError_()
		If iTmp=0
			Debug "ERROR! SetEndOfFile_ failed ("+FormatMessage(iLastError)+")"
			iReturn=-2
			Break
		EndIf
		
		iReturn=#True
		
	Until #True
	
	If iFileHdl<>0
		iTmp=CloseHandle_(iFileHdl)
		iLastError=GetLastError_()
		If iTmp=0
			Debug "ERROR! CloseHandle_ failed ("+FormatMessage(iLastError)+")"
			iReturn=-3
		EndIf
	EndIf
	
	If iReturn<0
		DeleteFile(sFilename)
	EndIf
	
	ProcedureReturn iReturn
	
EndProcedure

Procedure.s CMSTR_FormatFileSizeAuto(qSizeByte.q)
	
	; 20160807 ... nalor ... created
	
	Protected fValue.f=qSizeByte
	Protected sUnit.s=" B"
	
	If qSizeByte>=1024
		fValue=qSizeByte/1024
		sUnit="KB"
	Else
		ProcedureReturn Str(fValue)+sUnit
	EndIf
	
	If fValue>=1024
		fValue=fValue/1024
		sUnit="MB"
	EndIf
	
	If fValue>=1024
		fValue=fValue/1024
		sUnit="GB"
	EndIf
	
	If fValue>=1024
		fValue=fValue/1024
		sUnit="TB"
	EndIf
	
	ProcedureReturn StrF(fValue, 2)+sUnit	
	
EndProcedure

Define iFileHdl.i
Define sBigfile.s="c:\tmp\bigfile.test"
Define qBigFileSize.q=1024 * 1024 * 1024 * 15 ; 15 GB

Define iPkgHdl.i
Define sDstFile.s="c:\tmp\bigfile.zip"


; create huge test-file


Debug "#### Create big file with size >"+CMSTR_FormatFileSizeAuto(qBigFileSize)+"<"

If Not CreateFileSize(sBigfile, qBigFileSize)
	Debug "File NOT Created"
	End
EndIf

Debug "---- file created"

Debug "#### Create pack"

iPkgHdl=CreatePack(#PB_Any, sDstFile, #PB_PackerPlugin_Zip)
If Not iPkgHdl
	Debug "error create pack"
	End
EndIf

Debug "---- pack created"

Debug "#### add big file to pack"

If Not AddPackFile(iPkgHdl, sBigfile, GetFilePart(sBigfile))
	Debug "error add file"
	End
	
EndIf

Debug "---- file added"

Debug "#### close pack"

ClosePack(iPkgHdl)

Debug "---- pack closed"


Debug "#### (re)open pack"

iPkgHdl=OpenPack(#PB_Any, sDstFile, #PB_PackerPlugin_Zip)
If Not iPkgHdl
	Debug "error open pack"
	End
EndIf

Debug "---- pack opened"


Debug "#### list all the entries"
If ExaminePack(iPkgHdl)
	While NextPackEntry(iPkgHdl)
		Debug "Name: " + PackEntryName(iPkgHdl) + ", Size >" + CMSTR_FormatFileSizeAuto(PackEntrySize(iPkgHdl))+"<"
	Wend
EndIf


Debug "---- all entries listed"

Debug "#### close pack"

ClosePack(iPkgHdl)

Debug "---- pack closed"