4805
社区成员
- 主页
- 语言基础/算法/系统设计
- 数据库相关
- 图形处理/多媒体
- 网络通信/分布式开发
- VCL组件开发及应用
- Windows SDK/API
- 问答
...全文
请发表友善的回复…
发表回复
zswangII 2003-12-31
//Ctrl+C、Ctrl+V
//参考如下代码～～
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons;
type
TForm1 = class(TForm)
ButtonCompression: TButton;
ButtonDecompression: TButton;
EditFileName: TEdit;
EditDirectory: TEdit;
SpeedButtonFileName: TSpeedButton;
SpeedButtonDirectory: TSpeedButton;
OpenDialog1: TOpenDialog;
procedure ButtonCompressionClick(Sender: TObject);
procedure ButtonDecompressionClick(Sender: TObject);
procedure SpeedButtonFileNameClick(Sender: TObject);
procedure SpeedButtonDirectoryClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
(*//
标题:压缩和解压目录
说明:利用ZLib单元;不处理空目录
设计:Zswang
日期:2003-09-06
支持:wjhu111@21cn.com
//*)
///////Begin Source
uses ZLib, FileCtrl;
const cBufferSize = $4096;
function FileCompression(mFileName: TFileName; mStream: TStream): Integer;
var
vFileStream: TFileStream;
vBuffer: array[0..cBufferSize]of Char;
vPosition: Integer;
I: Integer;
begin
Result := -1;
if not FileExists(mFileName) then Exit;
if not Assigned(mStream) then Exit;
vPosition := mStream.Position;
vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
with TCompressionStream.Create(clMax, mStream) do try
for I := 1 to vFileStream.Size div cBufferSize do begin
vFileStream.Read(vBuffer, cBufferSize);
Write(vBuffer, cBufferSize);
end;
I := vFileStream.Size mod cBufferSize;
if I > 0 then begin
vFileStream.Read(vBuffer, I);
Write(vBuffer, I);
end;
finally
Free;
vFileStream.Free;
end;
Result := mStream.Size - vPosition; //增量
end; { FileCompression }
function FileDecompression(mFileName: TFileName; mStream: TStream): Integer;
var
vFileStream: TFileStream;
vBuffer: array[0..cBufferSize]of Char;
I: Integer;
begin
Result := -1;
if not Assigned(mStream) then Exit;
ForceDirectories(ExtractFilePath(mFileName)); //创建目录
vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);
with TDecompressionStream.Create(mStream) do try
repeat
I := Read(vBuffer, cBufferSize);
vFileStream.Write(vBuffer, I);
until I = 0;
Result := vFileStream.Size;
finally
Free;
vFileStream.Free;
end;
end; { FileDecompression }
function StrLeft(const mStr: string; mDelimiter: string): string;
begin
Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }
function StrRight(const mStr: string; mDelimiter: string): string;
begin
if Pos(mDelimiter, mStr) > 0 then
Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)
else Result := '';
end; { StrRight }
type
TFileHead = packed record
rIdent: string[3]; //标识
rVersion: Byte; //版本
end;
const
cIdent: string[3] = 'zsf';
cVersion = $01;
cErrorIdent = -1;
cErrorVersion = -2;
function DirectoryCompression(mDirectory, mFileName: TFileName): Integer;
var
vFileInfo: TStrings;
vFileInfoSize: Integer;
vFileInfoBuffer: PChar;
vFileHead: TFileHead;
vMemoryStream: TMemoryStream;
vFileStream: TFileStream;
procedure pAppendFile(mSubFile: TFileName);
begin
vFileInfo.Append(Format('%s|%d',
[StringReplace(mSubFile, mDirectory + '\', '', [rfReplaceAll, rfIgnoreCase]),
FileCompression(mSubFile, vMemoryStream)]));
Inc(Result);
end; { pAppendFile }
procedure pSearchFile(mPath: TFileName);
var
vSearchRec: TSearchRec;
K: Integer;
begin
K := FindFirst(mPath + '\*.*', faAnyFile, vSearchRec);
while K = 0 do begin
if (vSearchRec.Attr and faDirectory > 0) and
(Pos(vSearchRec.Name, '..') = 0) then
pSearchFile(mPath + '\' + vSearchRec.Name)
else if Pos(vSearchRec.Name, '..') = 0 then
pAppendFile(mPath + '\' + vSearchRec.Name);
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end; { pSearchFile }
begin
Result := 0;
if not DirectoryExists(mDirectory) then Exit;
vFileInfo := TStringList.Create;
vMemoryStream := TMemoryStream.Create;
mDirectory := ExcludeTrailingPathDelimiter(mDirectory);
vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);
try
pSearchFile(mDirectory);
vFileInfoBuffer := vFileInfo.GetText;
vFileInfoSize := StrLen(vFileInfoBuffer);
{ DONE -oZswang -c添加 : 写入头文件信息 }
vFileHead.rIdent := cIdent;
vFileHead.rVersion := cVersion;
vFileStream.Write(vFileHead, SizeOf(vFileHead));
vFileStream.Write(vFileInfoSize, SizeOf(vFileInfoSize));
vFileStream.Write(vFileInfoBuffer^, vFileInfoSize);
vMemoryStream.Position := 0;
vFileStream.CopyFrom(vMemoryStream, vMemoryStream.Size);
finally
vFileInfo.Free;
vMemoryStream.Free;
vFileStream.Free;
end;
end; { DirectoryCompression }
function DirectoryDecompression(mDirectory, mFileName: TFileName): Integer;
var
vFileInfo: TStrings;
vFileInfoSize: Integer;
vFileHead: TFileHead;
vMemoryStream: TMemoryStream;
vFileStream: TFileStream;
I: Integer;
begin
Result := 0;
if not FileExists(mFileName) then Exit;
vFileInfo := TStringList.Create;
vMemoryStream := TMemoryStream.Create;
mDirectory := ExcludeTrailingPathDelimiter(mDirectory);
vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
try
if vFileStream.Size < SizeOf(vFileHead) then Exit;
{ DONE -oZswang -c添加 : 读取头文件信息 }
vFileStream.Read(vFileHead, SizeOf(vFileHead));
if vFileHead.rIdent <> cIdent then Result := cErrorIdent;
if vFileHead.rVersion <> cVersion then Result := cErrorVersion;
if Result <> 0 then Exit;
vFileStream.Read(vFileInfoSize, SizeOf(vFileInfoSize));
vMemoryStream.CopyFrom(vFileStream, vFileInfoSize);
vMemoryStream.Position := 0;
vFileInfo.LoadFromStream(vMemoryStream);
for I := 0 to vFileInfo.Count - 1 do begin
vMemoryStream.Clear;
vMemoryStream.CopyFrom(vFileStream,
StrToIntDef(StrRight(vFileInfo[I], '|'), 0));
vMemoryStream.Position := 0;
FileDecompression(mDirectory + '\' + StrLeft(vFileInfo[I], '|'),
vMemoryStream);
end;
Result := vFileInfo.Count;
finally
vFileInfo.Free;
vMemoryStream.Free;
vFileStream.Free;
end;
end; { DirectoryDeompression }
///////End Source
///////Begin Demo
procedure TForm1.ButtonCompressionClick(Sender: TObject);
begin
Caption := 'DirectoryCompression:' +
IntToStr(DirectoryCompression(EditDirectory.Text, EditFileName.Text));
end;
procedure TForm1.ButtonDecompressionClick(Sender: TObject);
begin
Caption := 'DirectoryDecompression:' +
IntToStr(DirectoryDecompression(EditDirectory.Text, EditFileName.Text));
end;
procedure TForm1.SpeedButtonFileNameClick(Sender: TObject);
begin
if not OpenDialog1.Execute then Exit;
EditFileName.Text := OpenDialog1.FileName;
end;
procedure TForm1.SpeedButtonDirectoryClick(Sender: TObject);
var
vDirectory: string;
begin
vDirectory := EditDirectory.Text;
if not SelectDirectory('Select', '', vDirectory) then Exit;
EditDirectory.Text := vDirectory;
end;
///////End Demo
end.
//参考如下代码～～
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons;
type
TForm1 = class(TForm)
ButtonCompression: TButton;
ButtonDecompression: TButton;
EditFileName: TEdit;
EditDirectory: TEdit;
SpeedButtonFileName: TSpeedButton;
SpeedButtonDirectory: TSpeedButton;
OpenDialog1: TOpenDialog;
procedure ButtonCompressionClick(Sender: TObject);
procedure ButtonDecompressionClick(Sender: TObject);
procedure SpeedButtonFileNameClick(Sender: TObject);
procedure SpeedButtonDirectoryClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
(*//
标题:压缩和解压目录
说明:利用ZLib单元;不处理空目录
设计:Zswang
日期:2003-09-06
支持:wjhu111@21cn.com
//*)
///////Begin Source
uses ZLib, FileCtrl;
const cBufferSize = $4096;
function FileCompression(mFileName: TFileName; mStream: TStream): Integer;
var
vFileStream: TFileStream;
vBuffer: array[0..cBufferSize]of Char;
vPosition: Integer;
I: Integer;
begin
Result := -1;
if not FileExists(mFileName) then Exit;
if not Assigned(mStream) then Exit;
vPosition := mStream.Position;
vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
with TCompressionStream.Create(clMax, mStream) do try
for I := 1 to vFileStream.Size div cBufferSize do begin
vFileStream.Read(vBuffer, cBufferSize);
Write(vBuffer, cBufferSize);
end;
I := vFileStream.Size mod cBufferSize;
if I > 0 then begin
vFileStream.Read(vBuffer, I);
Write(vBuffer, I);
end;
finally
Free;
vFileStream.Free;
end;
Result := mStream.Size - vPosition; //增量
end; { FileCompression }
function FileDecompression(mFileName: TFileName; mStream: TStream): Integer;
var
vFileStream: TFileStream;
vBuffer: array[0..cBufferSize]of Char;
I: Integer;
begin
Result := -1;
if not Assigned(mStream) then Exit;
ForceDirectories(ExtractFilePath(mFileName)); //创建目录
vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);
with TDecompressionStream.Create(mStream) do try
repeat
I := Read(vBuffer, cBufferSize);
vFileStream.Write(vBuffer, I);
until I = 0;
Result := vFileStream.Size;
finally
Free;
vFileStream.Free;
end;
end; { FileDecompression }
function StrLeft(const mStr: string; mDelimiter: string): string;
begin
Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }
function StrRight(const mStr: string; mDelimiter: string): string;
begin
if Pos(mDelimiter, mStr) > 0 then
Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)
else Result := '';
end; { StrRight }
type
TFileHead = packed record
rIdent: string[3]; //标识
rVersion: Byte; //版本
end;
const
cIdent: string[3] = 'zsf';
cVersion = $01;
cErrorIdent = -1;
cErrorVersion = -2;
function DirectoryCompression(mDirectory, mFileName: TFileName): Integer;
var
vFileInfo: TStrings;
vFileInfoSize: Integer;
vFileInfoBuffer: PChar;
vFileHead: TFileHead;
vMemoryStream: TMemoryStream;
vFileStream: TFileStream;
procedure pAppendFile(mSubFile: TFileName);
begin
vFileInfo.Append(Format('%s|%d',
[StringReplace(mSubFile, mDirectory + '\', '', [rfReplaceAll, rfIgnoreCase]),
FileCompression(mSubFile, vMemoryStream)]));
Inc(Result);
end; { pAppendFile }
procedure pSearchFile(mPath: TFileName);
var
vSearchRec: TSearchRec;
K: Integer;
begin
K := FindFirst(mPath + '\*.*', faAnyFile, vSearchRec);
while K = 0 do begin
if (vSearchRec.Attr and faDirectory > 0) and
(Pos(vSearchRec.Name, '..') = 0) then
pSearchFile(mPath + '\' + vSearchRec.Name)
else if Pos(vSearchRec.Name, '..') = 0 then
pAppendFile(mPath + '\' + vSearchRec.Name);
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end; { pSearchFile }
begin
Result := 0;
if not DirectoryExists(mDirectory) then Exit;
vFileInfo := TStringList.Create;
vMemoryStream := TMemoryStream.Create;
mDirectory := ExcludeTrailingPathDelimiter(mDirectory);
vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);
try
pSearchFile(mDirectory);
vFileInfoBuffer := vFileInfo.GetText;
vFileInfoSize := StrLen(vFileInfoBuffer);
{ DONE -oZswang -c添加 : 写入头文件信息 }
vFileHead.rIdent := cIdent;
vFileHead.rVersion := cVersion;
vFileStream.Write(vFileHead, SizeOf(vFileHead));
vFileStream.Write(vFileInfoSize, SizeOf(vFileInfoSize));
vFileStream.Write(vFileInfoBuffer^, vFileInfoSize);
vMemoryStream.Position := 0;
vFileStream.CopyFrom(vMemoryStream, vMemoryStream.Size);
finally
vFileInfo.Free;
vMemoryStream.Free;
vFileStream.Free;
end;
end; { DirectoryCompression }
function DirectoryDecompression(mDirectory, mFileName: TFileName): Integer;
var
vFileInfo: TStrings;
vFileInfoSize: Integer;
vFileHead: TFileHead;
vMemoryStream: TMemoryStream;
vFileStream: TFileStream;
I: Integer;
begin
Result := 0;
if not FileExists(mFileName) then Exit;
vFileInfo := TStringList.Create;
vMemoryStream := TMemoryStream.Create;
mDirectory := ExcludeTrailingPathDelimiter(mDirectory);
vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
try
if vFileStream.Size < SizeOf(vFileHead) then Exit;
{ DONE -oZswang -c添加 : 读取头文件信息 }
vFileStream.Read(vFileHead, SizeOf(vFileHead));
if vFileHead.rIdent <> cIdent then Result := cErrorIdent;
if vFileHead.rVersion <> cVersion then Result := cErrorVersion;
if Result <> 0 then Exit;
vFileStream.Read(vFileInfoSize, SizeOf(vFileInfoSize));
vMemoryStream.CopyFrom(vFileStream, vFileInfoSize);
vMemoryStream.Position := 0;
vFileInfo.LoadFromStream(vMemoryStream);
for I := 0 to vFileInfo.Count - 1 do begin
vMemoryStream.Clear;
vMemoryStream.CopyFrom(vFileStream,
StrToIntDef(StrRight(vFileInfo[I], '|'), 0));
vMemoryStream.Position := 0;
FileDecompression(mDirectory + '\' + StrLeft(vFileInfo[I], '|'),
vMemoryStream);
end;
Result := vFileInfo.Count;
finally
vFileInfo.Free;
vMemoryStream.Free;
vFileStream.Free;
end;
end; { DirectoryDeompression }
///////End Source
///////Begin Demo
procedure TForm1.ButtonCompressionClick(Sender: TObject);
begin
Caption := 'DirectoryCompression:' +
IntToStr(DirectoryCompression(EditDirectory.Text, EditFileName.Text));
end;
procedure TForm1.ButtonDecompressionClick(Sender: TObject);
begin
Caption := 'DirectoryDecompression:' +
IntToStr(DirectoryDecompression(EditDirectory.Text, EditFileName.Text));
end;
procedure TForm1.SpeedButtonFileNameClick(Sender: TObject);
begin
if not OpenDialog1.Execute then Exit;
EditFileName.Text := OpenDialog1.FileName;
end;
procedure TForm1.SpeedButtonDirectoryClick(Sender: TObject);
var
vDirectory: string;
begin
vDirectory := EditDirectory.Text;
if not SelectDirectory('Select', '', vDirectory) then Exit;
EditDirectory.Text := vDirectory;
end;
///////End Demo
end.