飞
飞骐
Unregistered / Unconfirmed
GUEST, unregistred user!
头痛,这是我写的一段压缩文件的代码,其中的压缩函数在单线程中使用正常
unit CompressU;
interface
uses
Classes, SysUtils, ZLib;
//ZLib单元在Delphi的安装关盘中的Extra/Zlib目录中
type
TCompressThread = class(TThread)
private
{ Private declarations }
FFileName: string;
FCompressException: Exception;
procedure ShowException;
procedure CompressFile(var CompressingStream: TMemoryStream;
const CompressionLevel: TCompressionLevel);
protected
procedure Execute;
override;
public
constructor Create(const FileName: string);
end;
implementation
uses Forms;
{ TCompressThread }
procedure TCompressThread.CompressFile(
var CompressingStream: TMemoryStream;
const CompressionLevel: TCompressionLevel);
var
Count: integer;
DestStream: TMemoryStream;
SourceStream: TCompressionStream;
begin
Count:= CompressingStream.Size;
DestStream := TMemoryStream.Create;
SourceStream := TCompressionStream.Create(CompressionLevel, DestStream);
try
try
CompressingStream.SaveToStream(SourceStream);
SourceStream.Free;
CompressingStream.Clear;
CompressingStream.WriteBuffer(Count, SizeOf(Count));
CompressingStream.CopyFrom(DestStream, 0);
finally // wrap up
FreeAndNil(SourceStream);
FreeAndNil(DestStream);
end;
// try/finally
except
FCompressException:= ExceptObject as Exception;
Synchronize(ShowException);
end;
// try/except
end;
constructor TCompressThread.Create(const FileName: string);
begin
try
FFileName:= FileName;
inherited Create(False);
except
FCompressException := ExceptObject as Exception;
Synchronize(ShowException);
end;
// try/except
end;
procedure TCompressThread.Execute;
var
fs: TFileStream;
ms: TMemoryStream;
NewFileName: string;
begin
{ Place thread code here }
try
FreeOnTerminate := True;
NewFileName := ChangeFileExt(FFileName, '.dat');
fs:= TFileStream.Create(FFileName, fmOpenRead);
ms:= TMemoryStream.Create;
try
ms.LoadFromStream(fs);
CompressFile(ms, clDefault);
ms.SaveToFile(NewFileName);
finally // wrap up
FreeAndNil(fs);
FreeAndNil(ms);
end;
// try/finally
except
FCompressException := ExceptObject as Exception;
Synchronize(ShowException);
end;
// try/except
end;
procedure TCompressThread.ShowException;
begin
Application.ShowException(FCompressException);
end;
end.
这是主单元:
unit MainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
btnCompress: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
OpenDialog1: TOpenDialog;
procedure btnCompressClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FileName: string;
implementation
uses CompressU;
{$R *.dfm}
procedure TForm1.btnCompressClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Edit1.Text := OpenDialog1.FileName;
FileName:= OpenDialog1.FileName;
TCompressThread.Create(FileName);
end;
end;
end.
unit CompressU;
interface
uses
Classes, SysUtils, ZLib;
//ZLib单元在Delphi的安装关盘中的Extra/Zlib目录中
type
TCompressThread = class(TThread)
private
{ Private declarations }
FFileName: string;
FCompressException: Exception;
procedure ShowException;
procedure CompressFile(var CompressingStream: TMemoryStream;
const CompressionLevel: TCompressionLevel);
protected
procedure Execute;
override;
public
constructor Create(const FileName: string);
end;
implementation
uses Forms;
{ TCompressThread }
procedure TCompressThread.CompressFile(
var CompressingStream: TMemoryStream;
const CompressionLevel: TCompressionLevel);
var
Count: integer;
DestStream: TMemoryStream;
SourceStream: TCompressionStream;
begin
Count:= CompressingStream.Size;
DestStream := TMemoryStream.Create;
SourceStream := TCompressionStream.Create(CompressionLevel, DestStream);
try
try
CompressingStream.SaveToStream(SourceStream);
SourceStream.Free;
CompressingStream.Clear;
CompressingStream.WriteBuffer(Count, SizeOf(Count));
CompressingStream.CopyFrom(DestStream, 0);
finally // wrap up
FreeAndNil(SourceStream);
FreeAndNil(DestStream);
end;
// try/finally
except
FCompressException:= ExceptObject as Exception;
Synchronize(ShowException);
end;
// try/except
end;
constructor TCompressThread.Create(const FileName: string);
begin
try
FFileName:= FileName;
inherited Create(False);
except
FCompressException := ExceptObject as Exception;
Synchronize(ShowException);
end;
// try/except
end;
procedure TCompressThread.Execute;
var
fs: TFileStream;
ms: TMemoryStream;
NewFileName: string;
begin
{ Place thread code here }
try
FreeOnTerminate := True;
NewFileName := ChangeFileExt(FFileName, '.dat');
fs:= TFileStream.Create(FFileName, fmOpenRead);
ms:= TMemoryStream.Create;
try
ms.LoadFromStream(fs);
CompressFile(ms, clDefault);
ms.SaveToFile(NewFileName);
finally // wrap up
FreeAndNil(fs);
FreeAndNil(ms);
end;
// try/finally
except
FCompressException := ExceptObject as Exception;
Synchronize(ShowException);
end;
// try/except
end;
procedure TCompressThread.ShowException;
begin
Application.ShowException(FCompressException);
end;
end.
这是主单元:
unit MainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
btnCompress: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
OpenDialog1: TOpenDialog;
procedure btnCompressClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FileName: string;
implementation
uses CompressU;
{$R *.dfm}
procedure TForm1.btnCompressClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Edit1.Text := OpenDialog1.FileName;
FileName:= OpenDialog1.FileName;
TCompressThread.Create(FileName);
end;
end;
end.