| |
|
|
- page 1 - |
|
Frank Abbing | données saisir sans Dll, seulement mittels API.
================================================================================
================================================================================/
données saisir/entpacken sans Dll, seulement 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 saisir. paramètre: (Speicherbereich, Anzahl Bytes im Speicherbereich)
Proc CompressBuffer
Paramètres bbereich#, cbx&
Déclarer cstatus&, bworkspacesize&, fworkspacesize&, cbereich#, workspace#
cstatus&=0
Si non RtlGetCompressionWorkSpaceSize(2, Addr(bworkspacesize&), Addr(fworkspacesize&))
Faible workspace#,bworkspacesize&
Faible cbereich#,cbx&+400
Si non RtlCompressBuffer(2,bbereich#,cbx&,cbereich#,cbx&+400,0,Addr(bworkspacesize&),workspace#)
Claire bbereich#
Long bbereich#,0=cbx&
RtlMoveMemory(bbereich#+4,cbereich#,bworkspacesize&)
cstatus&=bworkspacesize&+4
EndIf
Dispose workspace#
Dispose cbereich#
Endif
Retour cstatus&
Rückgabe: Anzahl qui gepackten Bytes. qui gepackten données wurden dans den übergebenen Speicherbereich kopiert.
ENDPROC
Originale Speichergrösse ermitteln. paramètre: (gepackter Speicherbereich#)
Proc GetDecompressSize
Paramètres bbereich#
Retour Long(bbereich#,0)
ENDPROC
Speicherbereich entpacken. paramètre: (gepackter Speicherbereich, Anzahl Bytes im gepackten Speicherbereich, freier Speicherbereich)
Proc DecompressBuffer
Paramètres bbereich#, cbx&, cbereich#
Déclarer bworkspacesize&
Si non RtlDecompressBuffer(2,cbereich#,Long(bbereich#,0),bbereich#+4,cbx&-4,Addr(bworkspacesize&))
Retour bworkspacesize&
EndIf
Retour 0
Rückgabe: Anzahl qui entgepackten Bytes.
ENDPROC
================================================================================
================================================================================/
====> HAUPTPROGRAMM
Déclarer bereich#, bereich2#, text$, x&, xcopy&, newbytes&
Cls
Tandis que 1
text$=LoadFile$("Datei zum saisir aussuchen",»)
Si text$<>»
saisir testen
x&=FileSize(text$)
xcopy&=x&
Si x&
Faible bereich#, x&+400
BlockRead(text$, bereich#, 0, x&)
newbytes&=CompressBuffer(bereich#, x&)
Si newbytes&
Set("Décimal",2)
Imprimer "Dateiname: "+text$
Imprimer "Originalgrösse liegt chez "+Str$(x&)+" Bytes, comprimiert chez "+Str$(newbytes&)+" Bytes."
Imprimer "Packrate liegt chez "+Str$(100-(newbytes&*100/x&))+" Prozent."
text$=text$+".pck"
BlockWrite text$, bereich#, 0, newbytes&
Dispose bereich#
Entpacken testen
x&=FileSize(text$)
Si x&
Faible bereich#, x&
BlockRead(text$, bereich#, 0, x&)
newbytes&=GetDecompressSize(bereich#)
Faible bereich2#,newbytes&
x&=DecompressBuffer(bereich#, x&, bereich2#)
Si x&
text$=text$+".org"
BlockWrite text$, bereich2#, 0, x&
Imprimer "Dateiname: "+text$
Imprimer "Decomprimierte Originalgrösse beträgt "+Str$(x&)+" Bytes."
Imprimer
D'autre
Imprimer text$+" konnte pas entpackt volonté."
Imprimer
EndIf
Dispose bereich2#
Dispose bereich#
EndIf
D'autre
Dispose bereich#
Imprimer text$+" konnte pas être emballés."
EndIf
EndIf
D'autre
BREAK
EndIf
Endwhile
WaitInput
Fin
|
|
|
| |
|
|
|
| |
|
- page 1 - |
|
Frank Abbing | quelle Version Windows (s'il te plaît dans qui Signatur angeben )? Huh, la ligne 413? Soviel Zeilen hat qui Code oui chez Weitem pas. là qui Source beigelegt ist, peux du volontiers qui Ursache erforschen. mon Tests verliefen alle correct. |
|
|
| |
|
|
|
Bernhard Künzel | allô Frank, Win Version XP Home SP2 Profan Version XProfan11ßRC9 Test avec deiner Compress.exe: dans qui MessageBox venez qui Fehlermeldung "Zu wenig grenier pour Bereichs-Variable!" la ligne 413! et im Profanfenster steht ".....konnte pas emballé werden" avec deinem Quellcode: ici venez seulement qui annonce im Profanfenster ".....konnte pas emballé werden"
lg Bernhard |
|
|
| |
|
|
|
Frank Abbing | Sieht aus, comme wäre dein Arbeitsspeicher zur Neige gagangen. Profan peux so viel grenier pas plus reservieren. c'est ensuite ne...aucune Bug, daher aucun Fehlermeldung, mais un Abbruch avec information. je suis deswegen so pingelig, là je simple seulement sûrement se mettre voudrais, dass qui Code correct fonctionne. |
|
|
| |
|
|
| |
|
- page 2 - |
|
|
Bernhard Künzel | allô Frank, habe une wav Dossier erfolgreich avec sur 38,2 MB emballé daher peux es am Arbeitsspeicher pas liegen. |
|
|
| |
|
|
|
Sebastian Sprenger | je hab qui Ursache... Bernhards Fichiers volonté par cela saisir pas kleiner, mais größer et passen c'est pourquoi pas dans den Bereich, dans dem Frank qui données komprimieren peut. si je qui Bereiche um 399 Bytes größer anlege: marcher vous alle. Salut, 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 | 13.09.2008 ▲ |
|
|
|
|
Frank Abbing | Ist chez Je ne qui le cas. pouvons qui données pas être emballés, "stoppt" qui Routine à temps. Alles autre ist oui aussi Quatsch. |
|
|
| |
|
|
|
Bernhard Künzel | allô Sebastian, tu as qui richtige Ursache trouvé, par deine Changements volonté qui Fichiers maintenant emballé, mais plan avec einem größeren Code comme cela Original.
allô Frank, es betrifft alle Fichiers wohin qui Compression une größeren Code erzeugt. qui Fehlertext ist dans deinem Quellcode (siehe dessus) incorporé D'autre Dispose bereich# Imprimer text$+" konnte pas être emballés." EndIf
mon gesendeten Fichiers peut somit aussi chez dir pas marcher. Dein XProfan wird pas une größeren Bereich reservieren comme chez mir. c'est oui aussi ne...aucune faute dans deinem Code, car si qui gepackte Coder größer wird comme cela Original, ist es pas très sinnvoll cette trop saisir. mais qui Fehlermeldung sollte ensuite lauten "keine Compression möglich" quoi là alles Quatsch son soll, verstehe je wirklich pas. |
|
|
| |
|
|
|
Frank Abbing | qui Packfunktion wird oui qui Grösse qui données transfert. Wird qui Wert überschritten, sollte qui API qui Compression stoppen, et chez mir tut vous cela aussi. je erhalte qui Programme-annonce, mais sans une Absturz. |
|
|
| |
|
|
|
Thomas Freier | Super! et vite. avec cela coutume je mir sur qui Verschlüsselung qui Vereinsdaten aucun Gedanken plus faire. qui *.dbf Fichiers étions wieder einsetzbar et qui qui Kompressionswerte lagen chez 70%. |
|
|
| |
|
|
|
Frank Abbing | oui c'est ca, Thomas. je werde la fois "Verschlüsselung" avec dans den Titel aufnehmen.
@Sebastian: Hab deine Changements dans den Code incorporé, qui 400 Byte 1faire niemandem weh, si es pour überall funktioniert. |
|
|
| |
|
|
|
E.T. | la fois ne Frage: qu'est-ce que c'est eigentlich pour un Format, quoi là raus venez. pouvons qui Datein ensuite seulement avec cette Routine wieder entpackt volonté ??
NACHTRAG: Kann je avec cela aussi une ganzen Dossier sûrement saisir (Statt Dateiname un Verzeichnis transfert) ??
oui.
si du une ganzen Dossier saisir veux, musst du qui données qui individuel Files selber verwalten. alors dir un eigenes Format pour créer. |
|
|
| 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... | 15.12.2008 ▲ |
|
|
|
|
| trop Erstens glaub je "Ja", trop Zweitens glaub je "Nein". |
|
|
| |
|
|