PureBasic Forums - English

Code: Select all

UseZipPacker()
;UseLZMAPacker()
;UseBriefLZPacker()

; ------------------------------------------------------------
;
;   PureBasic - Compressor example file
;
;    (c) 2002 - Fantaisie Software
;
; ------------------------------------------------------------
;
; This procedure is a 'Callback'. This means there will be called
; automatically by the program at regular interval, so we could
; see the progress of the compression
; 
Procedure PackerProgress(SourcePosition, DestinationPosition)
	Shared FileLength 
	Result.f = (SourcePosition/FileLength)*100
	SetGadgetState(0, Round(Result,0))
	While (WindowEvent()) : Wend  ; Process all the window event befor quit
	ProcedureReturn 1
EndProcedure

If OpenWindow(0, 100, 200, 300, 40, "Packer - Progress Window")
	ProgressBarGadget(0, 10, 10, 280, 20, 0, 100)
	If ReadFile(0, OpenFileRequester("Choose a file to compress", "", "*.*", 0))
		FileLength = Lof(0)
		; Allocate the 2 memory buffers needed for compression..
		*Source = AllocateMemory(FileLength)
		*Target = AllocateMemory(FileLength+8)
		If FileLength And *Source And *Target
			ReadData(0, *Source, FileLength) ; Read the whole file in the memory buffer
			PackerCallback(@PackerProgress())
			; Compress our file, which is in memory (and use a timer to see the time spend by compression..)
			CompressedLength = CompressMemory(*Source, FileLength, *Target, FileLength)
			If CompressedLength
				DecompressedLength = UncompressMemory(*Target, CompressedLength, *Source, FileLength)
				If DecompressedLength = FileLength
					MessageRequester("Info", "De/Compression succeded:"+#LF$+#LF$+"Old size: "+Str(FileLength)+#LF$+"New size:"+Str(CompressedLength))
				EndIf      
			Else
				MessageRequester("Error", "Can't compress the file")
			EndIf 
		EndIf
		FreeMemory(*Source)
		FreeMemory(*Target)
		CloseFile(0)
	EndIf
EndIf

Code: Select all

[ERROR] PackerCallback(): The Procedure specified in '@ProcedureName()' does not have the required argument or returntype.

Procedure PackerProgress(SourcePosition.q, DestinationPosition.q) -> OK for 32/64-bit

Code: Select all

Debug OpenHID(0, #USB_VID, #USB_PID)

ExamineHIDs(#USB_VID, #USB_PID)
If NextHID()
  Debug OpenHIDPath(0, HIDInfo(#PB_HID_Path))
  Debug HIDInfo(#PB_HID_Path)
EndIf