| |
| |
|
Frank
Abbing | Daten packen ohne Dll, nur mittels API.
================================================================================
================================================================================/
Daten packen/entpacken ohne Dll, nur mittels API.
© 2008 Frank Abbing, http://frabbing.de
Def RtlCompressBuffer(8) !"ntdll.dll", "RtlCompressBuffer"
Def RtlDecompressBuffer(6) !"ntdll.dll", "RtlDecompressBuffer"
Def RtlGetCompressionWorkSpaceSize(3) !"ntdll.dll", "RtlGetCompressionWorkSpaceSize"
Def RtlMoveMemory(3) !"kernel32.dll", "RtlMoveMemory"
Speicherbereich packen. Parameter: (Speicherbereich, Anzahl Bytes im Speicherbereich)
Proc CompressBuffer
Parameters bbereich#, cbx&
Declare cstatus&, bworkspacesize&, fworkspacesize&, cbereich#, workspace#
cstatus&=0
IfNot RtlGetCompressionWorkSpaceSize(2, Addr(bworkspacesize&), Addr(fworkspacesize&))
Dim workspace#,bworkspacesize&
Dim cbereich#,cbx&+400
IfNot RtlCompressBuffer(2,bbereich#,cbx&,cbereich#,cbx&+400,0,Addr(bworkspacesize&),workspace#)
Clear bbereich#
Long bbereich#,0=cbx&
RtlMoveMemory(bbereich#+4,cbereich#,bworkspacesize&)
cstatus&=bworkspacesize&+4
EndIf
Dispose workspace#
Dispose cbereich#
Endif
Return cstatus&
Rückgabe: Anzahl der gepackten Bytes. Die gepackten Daten wurden in den übergebenen Speicherbereich kopiert.
EndProc
Originale Speichergrösse ermitteln. Parameter: (gepackter Speicherbereich#)
Proc GetDecompressSize
Parameters bbereich#
Return Long(bbereich#,0)
EndProc
Speicherbereich entpacken. Parameter: (gepackter Speicherbereich, Anzahl Bytes im gepackten Speicherbereich, freier Speicherbereich)
Proc DecompressBuffer
Parameters bbereich#, cbx&, cbereich#
Declare bworkspacesize&
IfNot RtlDecompressBuffer(2,cbereich#,Long(bbereich#,0),bbereich#+4,cbx&-4,Addr(bworkspacesize&))
Return bworkspacesize&
EndIf
Return 0
Rückgabe: Anzahl der entgepackten Bytes.
EndProc
================================================================================
================================================================================/
====> HAUPTPROGRAMM
Declare bereich#, bereich2#, text$, x&, xcopy&, newbytes&
Cls
While 1
text$=LoadFile$("Datei zum Packen aussuchen","")
If text$<>""
Packen testen
x&=FileSize(text$)
xcopy&=x&
If x&
Dim bereich#, x&+400
BlockRead(text$, bereich#, 0, x&)
newbytes&=CompressBuffer(bereich#, x&)
If newbytes&
Set("Decimals",2)
Print "Dateiname: "+text$
Print "Originalgrösse liegt bei "+Str$(x&)+" Bytes, comprimiert bei "+Str$(newbytes&)+" Bytes."
Print "Packrate liegt bei "+Str$(100-(newbytes&*100/x&))+" Prozent."
text$=text$+".pck"
BlockWrite text$, bereich#, 0, newbytes&
Dispose bereich#
Entpacken testen
x&=FileSize(text$)
If x&
Dim bereich#, x&
BlockRead(text$, bereich#, 0, x&)
newbytes&=GetDecompressSize(bereich#)
Dim bereich2#,newbytes&
x&=DecompressBuffer(bereich#, x&, bereich2#)
If x&
text$=text$+".org"
BlockWrite text$, bereich2#, 0, x&
Print "Dateiname: "+text$
Print "Decomprimierte Originalgrösse beträgt "+Str$(x&)+" Bytes."
Print
Else
Print text$+" konnte nicht entpackt werden."
Print
EndIf
Dispose bereich2#
Dispose bereich#
EndIf
Else
Dispose bereich#
Print text$+" konnte nicht gepackt werden."
EndIf
EndIf
Else
BREAK
EndIf
EndWhile
WaitInput
End
|
|
| |
| |
| |
|
|
 | |
| |
| |
| |
|
|
Frank
Abbing | | Nachtrag: Gibt man als ersten Parameter bei RtlCompressBuffer() und RtlDecomressBuffer() anstelle der 2 eine $102 an, dann erreicht man eine höhere Packrate. Allerdings auf Kosten der Geschwindigkeit. |
|
| |
| |
| |
|
|
| | Wie könnte man am besten sicher prüfen, ob diese Funktion auf dem System auch bereitsteht? Mit XProfan ImportDLL nach Funktion suchen, wenn die DLL existert? |
|
| |
| |
| |
|
|
Frank
Abbing | APIs LoadLibrary() und dann GetProcAddress(). So mach ichs in Assembler. Hatte es hier nicht gemacht, weil es auch so bei mir gut funktionierte. Dafür werden unter 98 die Funktionen nicht gefunden, während sie in meiner Assemblerversion sehr wohl gefunden werden. Aber mir scheint, dort existieren sie zwar, haben aber keine Auswirkungen.
Ab XP (Start der Dokumentation) sind die NTDLL.DLL-Funktionen aber sicher vorhanden, darum empfehle ich eher einen Betriebssystem-Test. |
|
| |
| |
| |
|
|
Jac
de
Lad | Eine typische Frank-Genialität.  |
|
| |
| Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP | 05.09.2008 ▲ |
|
| |
|
|
Michael
Wodrich | | Ja, da schliesse ich mich an... |
|
| |
| Programmieren, das spannendste Detektivspiel der Welt. | 06.09.2008 ▲ |
|
| |
|
|
Frank
Abbing | |
| |
| |
| |
|
|
Bernhard
Künzel | Habe mit der Compress.exe getestet, wobei bei manchen Grafiken eine Fehlermeldung erscheint.
Zu wenig Speicher für Bereichs-Variable! Zeile 413!
Im Anhang sind 4 Grafiken, wo diese Fehlermeldung erscheint. |
|
| |
| |
| |
|
|
Frank
Abbing | Welche Windowsversion (bitte in der Signatur angeben )?
Huh, Zeile 413? Soviel Zeilen hat der Code ja bei Weitem nicht.
Da der Source beigelegt ist, kannst du gerne die Ursache erforschen. Meine Tests verliefen alle fehlerfrei. |
|
| |
| |
| |
|
|
Bernhard
Künzel | Hallo Frank,
Win Version XP Home SP2
Profan Version XProfan11ßRC9
Test mit deiner Compress.exe:
In der MessageBox kommt die Fehlermeldung "Zu wenig Speicher für Bereichs-Variable!"
Zeile 413! und im Profanfenster steht ".....konnte nicht gepackt werden"
Mit deinem Quellcode:
Hier kommt nur die Meldung im Profanfenster ".....konnte nicht gepackt werden"
lg
Bernhard |
|
| |
| |
| |
|
|
Frank
Abbing | Sieht aus, als wäre dein Arbeitsspeicher zur Neige gagangen. Profan kann so viel Speicher nicht mehr reservieren. Das ist dann kein Programmfehler, daher keine Fehlermeldung, sondern ein Abbruch mit Information.
Ich bin deswegen so pingelig, da ich einfach nur sicher stellen möchte, dass der Code fehlerfrei läuft. |
|
| |
| |
| |
|
(950)
! 
Deutsch
English
Français
Español
Italia