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;
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);
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;
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