Entwickler-Ecke
Open Source Units - Packer - Vereinfachung der Verwendung von ZLib
Anonymous - Mi 12.11.03 15:57
Titel: Packer - Vereinfachung der Verwendung von ZLib
Diese Unit vereinfacht die Verwendung von ZLib.
folgende Procedures stehen zur Verfügung:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
| procedure CompressFile(FileName: string); overload;
procedure CompressFile(sfrom, sto: string); overload;
procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer); overload;
procedure DeCompressFile(FileName: string); overload;
procedure DeCompressFile(sfrom, sto: string); overload;
function DeCompressFile(filename: string; var pout: Pointer): integer; overload;
procedure CompressStream(sIn, sOut: TStream);
procedure DeCompressStream(sIn, sOut: TStream); |
CompressFile kann mit einem String aufgerufen werden, dann wird die Datei komprimiert und unter dem selben Namen abgespeichert.
Mit 2 Strings wird die Datei "sfrom" komprimiert unter "sto" gespeichert.
Mit einem String, einem Pointer und einem Integer wird der Inhalt des Pointers Komprimiert in der Datei "FileName" gespeichert. pinsize ist die größe des Pointers.
Mit DeCompressFile verhält es sich umgekehrt.
DeCompressFile mit einem string und einem Pointer gibt die Größe des Pointers zurück.
CompressStream komprimiert einen Stream, DecompressStream dekomprimiert ihn wieder.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
|
unit Packer;
interface
uses Classes, Windows;
procedure CompressFile(FileName: string); overload;
procedure CompressFile(sfrom, sto: string); overload;
procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer); overload;
procedure DeCompressFile(FileName: string); overload;
procedure DeCompressFile(sfrom, sto: string); overload;
function DeCompressFile(filename: string; var pout: Pointer): integer; overload;
procedure CompressStream(sIn, sOut: TStream);
procedure DeCompressStream(sIn, sOut: TStream);
function FileExists(const FileName: string): Boolean;
implementation
uses ZLib;
function DeCompressFile(filename: string; var pout: Pointer): integer;
var
f: File of byte;
pIn: Pointer;
sizeRead,sizeWrite: integer;
begin
pIn := nil; pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
DeCompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
result := sizeWrite;
finally
if pIn <> nil then freemem(pIn);
CloseFile(f);
end;
end;
function FileExists(const FileName: string): Boolean;
var
f: TWin32FindData;
handle: THandle;
begin
handle := FindFirstFile(pChar(FileName), f);
result := (handle <> INVALID_HANDLE_VALUE);
FindClose(Handle);
end;
procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer);
var
f: File of byte;
pOut: Pointer;
sizeWrite: integer;
begin
pOut := nil;
assignfile(f, FileName);
try
CompressBuf(pIn, pinsize, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
finally
if pOut <> nil then freemem(pOut);
CloseFile(f);
end;
end;
procedure CompressFile(FileName: string); overload;
var
f: File of byte;
pIn,pOut: Pointer;
sizeRead,sizeWrite: integer;
begin
pIn := nil; pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
CompressBuf(pIn, sizeRead, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
finally
if pIn <> nil then freemem(pIn);
if pOut <> nil then freemem(pOut);
CloseFile(f);
end;
end;
procedure DeCompressFile(FileName: string); overload;
var
f: File of byte;
pIn,pOut: Pointer;
sizeRead,sizeWrite: integer;
begin
pIn := nil; pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
DeCompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
finally
if pIn <> nil then freemem(pIn);
if pOut <> nil then freemem(pOut);
CloseFile(f);
end;
end;
procedure CompressFile(sfrom, sto: string); overload;
begin
if FileExists(sto) then DeleteFile(pchar(sto));
CopyFile(pchar(sfrom), pchar(sto), true);
CompressFile(sto);
end;
procedure DeCompressFile(sfrom, sto: string); overload;
begin
if FileExists(sto) then DeleteFile(pchar(sto));
CopyFile(pchar(sfrom), pchar(sto), true);
DeCompressFile(sto);
end;
procedure CompressStream(sIn, sOut: TStream);
var
pIn,pOut: Pointer;
sizeRead,sizeWrite: integer;
begin
pIn := nil; pOut := nil;
try
getmem(pIn, sIn.size);
sIn.Position := 0;
sizeRead := sIn.Read(pIn^, sIn.Size);
CompressBuf(pIn, sizeRead, pOut, sizeWrite);
sOut.Write(pOut^, sizeWrite);
finally
if pIn <> nil then freemem(pIn);
if pOut <> nil then freemem(pOut);
end;
end;
procedure DeCompressStream(sIn, sOut: TStream);
var
pIn,pOut: Pointer;
sizeRead,sizeWrite: integer;
begin
pIn := nil; pOut := nil;
try
getmem(pIn, sIn.size);
sIn.Position := 0;
sizeRead := sIn.Read(pIn^, sIn.Size);
DecompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
sOut.Write(pOut^, sizeWrite);
finally
if pIn <> nil then freemem(pIn);
if pOut <> nil then freemem(pOut);
end;
end;
end.
|
Udontknow - Mi 12.11.03 16:33
Hallo!
Woran erkenne ich bei der Routine "procedure DeCompressFile(filename: string; var pout: Pointer)", wieviele Bytes nun zu lesen sind?
Ich bevorzuge eine Ausgabe in einem Stream. Muss ich heute abend an meinem PC noch mal kramen.
Die Routinen CompressFile(procedure CompressFile(sfrom, sto: string); und ihr DecompressFile-Pendant sollten so abgeändert werden, daß die Datei nicht gelöscht wird, wenn sfrom=sto ist.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
| procedure CompressFile(sfrom, sto: string); overload;
begin
if sfrom<>sto then
begin
if FileExists(sto) then DeleteFile(pchar(sto));
CopyFile(pchar(sfrom), pchar(sto), true);
end;
CompressFile(sto);
end; |
Cu, :)
Udontknow
Anonymous - Mi 12.11.03 16:56
So ich habe mal einiges upgedatet.
Stream-Funktionen habe ich auch, aber die sind da nicht drin... vielleicht mache ich sie gleich noch rein...
Delete - Mi 12.11.03 18:18
Du machst immer alles auf einen Schlag:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
| procedure CompressFile(FileName: string); overload;
var
f: File of byte;
pIn,pOut: Pointer;
sizeRead,sizeWrite: integer;
begin
pIn := nil; pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
CompressBuf(pIn, sizeRead, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
finally
if pIn <> nil then freemem(pIn);
if pOut <> nil then freemem(pOut);
CloseFile(f);
end;
end; |
Das ist schlecht. Man kann es dann nämlich nicht mehr abbrechen und eien Fortschrittsanzeige läßt sich so auch nicht implementieren. Besser wäre es das ganze in eine Schleife zu packen und sich aus der Schleife eine Nachricht schicken zu lassen, wie weit er ist.
Anonymous - Mi 12.11.03 21:53
Das ganze braucht bis auf CompressBuf bzw. DeCompressBuf praktisch keine Zeit. Und gerade dabei ist das leider nicht möglich :(
Udontknow - Mi 12.11.03 22:56
Dann benutze doch besser die TCompressionStream-Klasse, die schon in der Unit ZLib drin ist. Da gibt es auch, wenn ich mich nicht irre, ein OnProgress-Event o.ä. .
CU,
Udontknow
Delete - Do 13.11.03 16:47
| obbschtkuche hat folgendes geschrieben: |
| Das ganze braucht bis auf CompressBuf bzw. DeCompressBuf praktisch keine Zeit. Und gerade dabei ist das leider nicht möglich :( |
Hast du es auch schon mit meherem 100 MB großen dateien getestet?
Anonymous - Do 13.11.03 17:02
Naja, da hast du Recht, aber es bringt trotzdem nicht viel, wenn man 2-3x eine Callback-fkt aufruft.
Mit der Stream-Klasse ließe es sich wahrscheinlich schon machen, aber ich habe die Procs nicht für mehrere 100MB große Dateien geschrieben, und wer solche Dateien (ent)packen will hat dann eben in diesem Fall Pech gehabt. :evil:
Delete - Do 13.11.03 17:07
Kunde ist König - oder wie heißt das in der Servicewüste Deutschland? :roll:
Anonymous - Do 13.11.03 17:10
hrhr... Dann will ich aber auch Geld sehen ;)
Tut uns leid, in diesem Fall können wir Ihnen leider nicht weiterhelfen. Sollten Sie eine Lösung für Ihr Problem finden, wären wir Ihnen dankbar, wenn sie die Lösung hier veröffentlichen würden
mimi - So 07.12.03 14:01
@obbschtkuche
man packt doch nicht kleine dateien sondern große, oderr nicht ???
Anonymous - So 07.12.03 14:23
@mini: willst du das pauschalisieren?
mimi - So 07.12.03 16:58
was heißt "pauschalisieren" ????
Raphael O. - So 07.12.03 16:58
pauschalisieren = verallgemeinern
mimi - So 07.12.03 17:14
achso, aber ich verstehe jetzt nur den zusammen hang mit meinem ersten beirag nicht so ganz, was hat es damit zu tuen?
Delete - So 07.12.03 17:23
Man kann nicht pauschal sagen, dass man nur große Dateien packt. Es mahct auch Sinn für den Transport oder aus sonst welchen Gründen viele kleine Dateien zu einem archiv zusammen zu packen.
mimi - So 07.12.03 18:18
ja ok, luckie du hast recht.
aber ein pack programm wurde nur für den zweck geschrieben eine große datei zu verkleinrn. mehr nicht.
Raphael O. - So 07.12.03 18:21
nicht unbedingt...
wei Luckie schon gebrauchen um mehrere Dateien zu einer "zusammenzufügen"
Delete - So 07.12.03 18:34
Man spricht ja auch von Archiven, wenn man Dateien redet, die von Packern erstellt wurden. Und in einem Archiv sind nun mal viele Dokumente zusammen gefasst aufbewart.
datensender. - So 07.12.03 19:07
mal eine ganz allgemeine Frage... woran erkennt man, ob eine deiner Prozeduren erfolgreich ausgeführt wurde oder scheiterte?
Ich habe die Quellen zwar nur überflogen, aber ich finde keine Rückgabewerte, Exceptions usw. vor. Es werden zwar Probleme
prozedur-intern abgefgangen, was hier aber nichts daran ändert,
dass die Operation dennoch fehlgeschlagen ist...
Das wird nach aussen hin aber nicht transparent...
Raphael O. - So 07.12.03 19:27
da müsste man dann aus den Prozeduren Funktionen machen und denen dann jeweils ein Boolean rückgabetyp geben, den man im "except" eines "try-except"-Blocks auf false setzt und ganz am Anfang der Function auf true...
Anonymous - So 07.12.03 19:27
Die Fehler werden nicht behandelt. Finally dient nur dazu später wieder aufzuräumen, wenn was schief geht. Eine Exception bekommst du trotzdem.
mimi - So 07.12.03 20:24
ja aber man sollte unterscheiden zwischen:
packer und Archivern.
ich finde da gibst einen großen unterschied:
Archiver:
Achiviert nur dateien(als fast sie zusammen, wie tar)
Packer, verkleinert dateien und als neben funktion archivert er sie auch.
aber eigenltich kann er nur packen bzw. sollte dies können, wie das alte:
_format.
(was ist schon unter delphi 1 gab, was nur eine datei packen konnte und die dann so aussgehen hat: Datei._abc oder so änlich
datensender. - So 07.12.03 20:24
@obbschtkuche
mhja richtig... dennoch könnte man auf einige Dinge im Vorfeld reagieren... z.B. bei DeCompressStream, ob sIn, sOut = nil sind... usw. und das dann erkenntlicher melden...
Laxans - Fr 19.12.03 16:05
Auf meinem Forular gibts ein 2 memofelder und n button
klickt man auf den button:
Delphi-Quelltext
1:
2:
3:
4:
| memo1.lines.Savetostream(ms1); CompressStream(ms1, ms2); decompressStream(ms2,ms3); memo2.lines.loadfromstream(ms3); |
Warum streht dann nicht in memo2 das gleiche wie in memo1
Anonymous - Fr 19.12.03 16:25
weil die Schreib/Leseposition von ms3 dann ganz am Ende ist. So funzts:
Delphi-Quelltext
1:
2:
3:
4:
5:
| memo1.lines.Savetostream(ms1); CompressStream(ms1, ms2); decompressStream(ms2,ms3); ms3.position := 0;
memo2.lines.loadfromstream(ms3); |
FriFra - Di 12.07.05 20:59
Ich hab gerade mal etwas mit der Unit gespielt... dabei ist mir etwas merkwürdiges aufgefallen...
Wenn ich eine Datei dekomprimiere
Delphi-Quelltext
1:
| DeCompressFile('c:\tritratrullalla.txt'); |
und danach versuche in diese Datei zu schreiben, bekomme ich folgenden Fehler:
| Fehler hat folgendes geschrieben: |
| Datei c:\tritratrullalla.txt kann nicht geöffnet werden. Der Prozess kann nicht auf die Datei zugreifen, da sie von einem anderen Prozess verwendet wird. |
Kommentiere ich die Dekomrimierung aus, dann klappt alles... es liegt also definitiv an DeCompressFile! Nur warum, das verstehe ich nicht ganz, da die Datei ja im finally mit CloseFile geschlossen wird :roll: .
FriFra - Di 12.07.05 22:25
Kleine Ergänzung...
Das Problem tritt anscheinend nur auf, wenn die betreffende Datei nicht gepackt ist.
FriFra - Di 12.07.05 22:43
Ich habs gefunden ;)
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
|
unit Packer;
interface
uses Classes, Windows, SysUtils;
procedure CompressFile(FileName: string); overload;
procedure CompressFile(sfrom, sto: string); overload;
procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer);
overload;
procedure DeCompressFile(FileName: string); overload;
procedure DeCompressFile(sfrom, sto: string); overload;
function DeCompressFile(filename: string; var pout: Pointer): integer; overload;
procedure CompressStream(sIn, sOut: TStream);
procedure DeCompressStream(sIn, sOut: TStream);
implementation
uses ZLib;
function DeCompressFile(filename: string; var pout: Pointer): integer;
var
f: file of byte;
pIn: Pointer;
sizeRead, sizeWrite: integer;
begin
pIn := nil;
pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
DeCompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
result := sizeWrite;
finally
if pIn <> nil then
freemem(pIn);
CloseFile(f);
end;
end;
procedure CompressFile(FileName: string; var pin: Pointer; pinsize: integer);
var
f: file of byte;
pOut: Pointer;
sizeWrite: integer;
begin
pOut := nil;
assignfile(f, FileName);
try
CompressBuf(pIn, pinsize, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
finally
if pOut <> nil then
freemem(pOut);
CloseFile(f);
end;
end;
procedure CompressFile(FileName: string); overload;
var
f: file of byte;
pIn, pOut: Pointer;
sizeRead, sizeWrite: integer;
begin
pIn := nil;
pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
CompressBuf(pIn, sizeRead, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
finally
if pIn <> nil then
freemem(pIn);
if pOut <> nil then
freemem(pOut);
CloseFile(f);
end;
end;
procedure DeCompressFile(FileName: string); overload;
var
f: file of byte;
pIn, pOut: Pointer;
sizeRead, sizeWrite: integer;
begin
pIn := nil;
pOut := nil;
assignfile(f, FileName);
reset(f);
try
getmem(pIn, FileSize(f));
BlockRead(f, pIn^, FileSize(f), sizeRead);
DeCompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
ReWrite(f);
BlockWrite(f, pOut^, sizeWrite);
if pOut <> nil then
freemem(pOut);
finally
if pIn <> nil then
freemem(pIn);
CloseFile(f);
end;
end;
procedure CompressFile(sfrom, sto: string); overload;
begin
if FileExists(sto) then
DeleteFile(pchar(sto));
CopyFile(pchar(sfrom), pchar(sto), true);
CompressFile(sto);
end;
procedure DeCompressFile(sfrom, sto: string); overload;
begin
if FileExists(sto) then
DeleteFile(pchar(sto));
CopyFile(pchar(sfrom), pchar(sto), true);
DeCompressFile(sto);
end;
procedure CompressStream(sIn, sOut: TStream);
var
pIn, pOut: Pointer;
sizeRead, sizeWrite: integer;
begin
pIn := nil;
pOut := nil;
try
getmem(pIn, sIn.size);
sIn.Position := 0;
sizeRead := sIn.Read(pIn^, sIn.Size);
CompressBuf(pIn, sizeRead, pOut, sizeWrite);
sOut.Write(pOut^, sizeWrite);
finally
if pIn <> nil then
freemem(pIn);
if pOut <> nil then
freemem(pOut);
end;
end;
procedure DeCompressStream(sIn, sOut: TStream);
var
pIn, pOut: Pointer;
sizeRead, sizeWrite: integer;
begin
pIn := nil;
pOut := nil;
try
getmem(pIn, sIn.size);
sIn.Position := 0;
sizeRead := sIn.Read(pIn^, sIn.Size);
DecompressBuf(pIn, sizeRead, sizeRead, pOut, sizeWrite);
sOut.Write(pOut^, sizeWrite);
if pOut <> nil then
freemem(pOut);
finally
if pIn <> nil then
freemem(pIn);
end;
end;
end.
|
Moderiert von 
Christian S.: Code- durch Delphi-Tags ersetzt.
Hux - Mi 07.09.05 11:51
Ola...,
Ähm, ich habe noch eine Frage zu deiner Unit:
Kann man eigentlich rausfinden ob eine datei mit dem Befehl:
DeCompressFile('c:\haha.exe');
komprimiert wurde?
dalpers - Mi 07.09.05 16:19
Hi,
Bin noch nicht so bedarft in dem Bereich. Ist es damit auch möglich Dateien so zu packen, dass man sie mit nem Standardprogramm wie winrar wieder entpacken kann?
Irgendwie wird bei mir zwar die Datei verändert, aber ich kann sie danach nicht mehr irgendwie öffnen. Was mache ich falsch?
Habe erstmal nur die funktion CompressFile mit einer Textdatei als Parameter aufgerufen.
Hast du evtl. mal ein Beispiel, wie man aus mehreren Dateien ein Archiv erstellt?
Danke
Denise
Eddie - So 25.06.06 20:48
Hi,
kann man mit den functions auch mehrere Dateien zu einem Archiv packen? Ich habe nämlich ein ListBox mit Dateien und die sollen alle in ein Archiv rein. Kann ich das evtl mit Streams machen? Aber wie bekomme ich mehrere Dateien in einen Stream?
Ich hoffe mir kann das irgendeiner erklären oder sogar Beispiel-Quellcode geben.
Timbo - Mo 14.08.06 16:21
Tach,
ich benutze die CompressStream und DeCompressStream funktionen.
Mir ist aufgefallen, dass danach im OutStream der Zeiger nicht am anfang steht, sollte man villeicht nach
sOut.Write(pOut^, SizeWrite);
mit
sOut.Position:= 0;
korigieren.
Richtig?
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!