| |
| |
|
| - Page 1 - |
|
Frank
Abbing | data pack without Dll, only through API.
================================================================================
================================================================================/
data pack/entpacken without Dll, only through 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 pack. Parameter: (Speicherbereich, amount Bytes in the 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&
Return: amount the gepackten Bytes. The gepackten data get in whom übergebenen Speicherbereich copies.
ENDPROC
Originale Speichergrösse detect. Parameter: (gepackter Speicherbereich#)
Proc GetDecompressSize
Parameters bbereich#
Return Long(bbereich#,0)
ENDPROC
Speicherbereich entpacken. Parameter: (gepackter Speicherbereich, amount Bytes in the gepackten Speicherbereich, suitor 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
Return: amount the entgepackten Bytes.
ENDPROC
================================================================================
================================================================================/
====> HAUPTPROGRAMM
Declare area#, area2#, Text$, x&, xcopy&, newbytes&
Cls
While 1
Text$=LoadFile $("Datei to that pack aussuchen","")
If Text$<>""
pack testing
x&=FileSize(text $)
xcopy&=x&
If x&
Dim area#, x&+400
BlockRead(Text$, area#, 0, x&)
newbytes&=CompressBuffer(area#, x&)
If newbytes&
Set("Decimals",2)
Print "Dateiname: "+Text$
Print "Originalgrösse lying with "+Str $(x&)+" Bytes, comprimiert with "+Str $(newbytes&)+" Bytes."
Print "Packrate lying with "+Str $(100-(newbytes&*100/x&))+" percent."
Text$=text $+".pck"
BlockWrite Text$, area#, 0, newbytes&
Dispose area#
Entpacken testing
x&=FileSize(text $)
If x&
Dim area#, x&
BlockRead(Text$, area#, 0, x&)
newbytes&=GetDecompressSize(area #)
Dim area2#,newbytes&
x&=DecompressBuffer(area#, x&, area2#)
If x&
Text$=text $+".org"
BlockWrite Text$, area2#, 0, x&
Print "Dateiname: "+Text$
Print "Decomprimierte Originalgrösse totals "+Str $(x&)+" Bytes."
Print
Else
Print Text$+" couldn't entpackt go."
Print
EndIf
Dispose area2#
Dispose area#
EndIf
Else
Dispose area#
Print Text$+" couldn't gepackt go."
EndIf
EndIf
Else
BREAK
EndIf
EndWhile
WaitInput
End
|
|
| |
| |
| |
|
|
| |
| |
| - Page 1 - |
|
Frank
Abbing | which Windowsversion (Please in the Signatur indicate )?
Huh, row 413? so much Lines has the code Yes with Weitem not. 
there the Source settled is, can you gladly The cause explore. My Tests verliefen any fehlerfrei. |
|
| |
| |
| |
|
|
Bernhard
Künzel | Hello Frank,
Win Version XP Home SP2
Profan Version XProfan11ßRC9
Test with your Compress.exe:
in the MessageBox comes The Error Message "Zu little memory for Bereichs-Variable!"
row 413! and in the Profanfenster standing ".....couldn't gepackt werden"
with your Source:
here comes only The Message in the Profanfenster ".....couldn't gepackt werden"
lg
Bernhard |
|
| |
| |
| |
|
|
Frank
Abbing | sees from, as would your main memory to incline gagangen. Profan can so plenty memory not any more reservieren. this is then no Bug, therefore no Error Message, separate one discontinue with information.
i'm therefore so pingelig, I just sure to put would like, that the code fehlerfrei runs. |
|
| |
| |
| |
|
| |
| |
| - Page 2 - |
|
|
Bernhard
Künzel | Hello Frank,
have a wav File successful with over 38,2 MB gepackt
therefore can it on the main memory not lying. |
|
| |
| |
| |
|
|
Sebastian
Sprenger | I Have The cause...
Bernhards Files go by the pack not small, separate larger and fit therefore not whom area, in the Frank The data telescope can. If I The reaches circa 399 Bytes larger anlege:
functions tappt im dunkeln any.
Greeting, Sebastian |
|
| |
|  Profan² 7.0e, XProfan 9, 11.2a, FreeProfan32 Windows Vista Home Premium 32-Bit, 2.8 Ghz, 4 GB RAM Windows Me, 1.8 Ghz, 256 MB RAM | 09/13/08 ▲ |
|
| |
|
|
Frank
Abbing | | is not at me the case. can The data not gepackt go, "stoppt" The routine timely. everything else is indeed balderdash. |
|
| |
| |
| |
|
|
Bernhard
Künzel | Hello Sebastian,
you have The right cause found, through your Changes go The Files now gepackt, but even with a more code as the Original.
Hello Frank,
it concerns any Files where The Compression a more code created.
the Fehlertext is in your Source (see supra) installed
Else
Dispose area#
Print Text$+" couldn't gepackt go."
EndIf
my sent Files can accordingly too with you not functions. your XProfan won't a more area reservieren as by me.
its indeed no Error in your code, because if the gepackte Coder larger becomes as the Original, is not very meaningfully this To pack.
but The Error Message ought to then lauten "keine Compression möglich"
what there everything balderdash his should, understand I really not. |
|
| |
| |
| |
|
|
Frank
Abbing | | The Packfunktion becomes Yes The Size the data transfer. becomes the worth overstepped, ought to The API The Compression stop, and by me does tappt im dunkeln the too. I sustain The Program-Message, but without a crash. |
|
| |
| |
| |
|
|
Thomas
Freier | | super! and quick. so custom I me over The Verschlüsselung the Vereinsdaten no thoughts More make. The *.dbf Files were again einsetzbar and the The Kompressionswerte sites with 70%. |
|
| |
| Gruß Thomas
Windows XP SP2, XProfan X2 | 09/14/08 ▲ |
|
| |
|
|
Frank
Abbing | very, Thomas. i'll time "Verschlüsselung" along into whom cover take in. 
@Sebastian: Have your Changes into code installed, The 400 byte do niemandem painful, if it for everywhere functions.  |
|
| |
| |
| |
|
|
E.T. | time ne question: what's this thing really for a stature, what there out comes.
can The Files then only with this routine again entpackt go ?? 
NACHTRAG: Kann I so too a whole Ordner sure pack (but not Dateiname a directory transfer) ??
Yes.
If you a whole Ordner pack want, must You The data the individual Files yourself manage. means you one own stature for create. |
|
| |
| Grüße aus Sachsen... Mario  WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte... | 12/15/08 ▲ |
|
| |
|
|
 | To in the first mean I "Ja", To secondly mean I "Nein".  |
|
| |
| |
| |
|
(2.655)
Deutsch
English
Français
Español
Italia