unit AppPackUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons,ZLib,EncdDecd,{$WARNINGS OFF}FileCtrl{$WARNINGS ON};
type
//包头结构
TPackHeader=class(TPersistent)
private
FHeadSize:LongWord;
//包头长度
FAllFileSize:LongWord;
//所有文件总长度
FFileCount:LongWord;
//文件个数
//FCreateTime:Array[0..18] of Char;
//包创建时间
//FModifiedTime:Array[0..18] of Char;
//包最后修改时间
procedure SetHeadSize(Value:LongWord);
procedure SetFileCount(Value:LongWord);
procedure SetAllFileSize(Value:LongWord);
//function GetCreateTime:string;
//procedure SetCreateTime(Value:string);
//function GetModifiedTime:string;
//procedure SetModifiedTime(Value:string);
public
constructor Create(AOwner: TComponent);
destructor Destroy;
override;
procedure LoadFromStream(AStream:TStream);
procedure WriteToStream(AStream:TStream);
procedure Init;
published
property HeadSize:LongWord read FHeadSize write SetHeadSize;
property AllFileSize:LongWord read FAllFileSize write SetAllFileSize;
property FileCount:LongWord read FFileCount write SetFileCount;
//property CreateTime:string read GetCreateTime write SetCreateTime;
//property ModifiedTime:string read GetModifiedTime write SetModifiedTime;
end;
//包内文件信息结构
TFileItem=class(TPersistent)
private
FFileName:string;
//文件名
FFileNameLen:Word;
//文件名长度
FFileSize:LongWord;
//文件尺寸(处理后的长度，比如压缩编码后)
FFileInitSize:LongWord;
//文件的原始长度
FStartPos:LongWord;
//包中文件的初始位置
procedure SetFileName(Value:string);
procedure SetFileSize(Value:LongWord);
procedure SetStartPos(Value:LongWord);
function GetFileNameLen:word;
public
constructor Create(AOwner: TComponent);
destructor Destroy;
override;
procedure LoadFromStream(AStream:TStream);
procedure WriteToStream(AStream:TStream);
published
property FileName:string read FFileName write SetFileName;
property FileSize:LongWord read FFileSize write SetFileSize;
property StartPos:LongWord read FStartPos write SetStartPos;
property FileNameLen:word read GetFileNameLen;
end;
//所有文件信息管理
TFileItems=class(TPersistent)
private
FItems:TList;
function GetItem(Index: Integer):TFileItem;
function GetCount:Integer;
public
constructor Create(AOwner: TComponent);
destructor Destroy;
override;
procedure ClearItems;
procedure WriteToStream(AStream:TStream);
procedure LoadFromStream(AStream: TStream;ACount:Word);
procedure AddItem(AItem:TFileItem);
procedure DeleteItem(AIndex:Integer);
property Items[Index:integer]:TFileItem read GetItem;
property Count:integer read GetCount;
end;
//打包处理
TPackage=class(TComponent)
private
FPackStream: TFileStream;
FPackHeader: TPackHeader;
FFileItems: TFileItems;
//当前目录
DirPath:string;
procedure SetFileItems(const Value:TFileItems);
procedure SetHeader(const Value:TPackHeader);
public
PackFileName:string;
procedure NewPackage(AFileName:string);
procedure InitPackage;
constructor Create(AOwner:TComponent);override;
destructor Destroy;
override;
//增加文件项目,单个增加
procedure AddFileItem(AFileName:string;AddFilename:string);
//从目录加载文件
procedure AddFileFromDir(ADir:string);
//从Epr工程文件里面加载文件(所有的是相对目录)
procedure AddFileFromEpr(AEprName:string);
//删除文件项
procedure DeleteFileItem(Index: Integer);
//装载包文件
procedure LoadPackage(AFileName:string);
//保存包
procedure SavePackage;
//从目录扫描文件
procedure ScanFiles(ADir:string);
//从包中导出文件
procedure FileItemToFile(Index:Integer;AFileName:string);
procedure FileItemToStream(Index:Integer;AStream:TStream);
property FileItems:TFileItems read FFileItems write SetFileItems;
property PackHeader:TPackHeader read FPackHeader write SetHeader;
end;
//窗体
TAppPackForm = class(TForm)
Edit1: TEdit;
SD: TSaveDialog;
CreateBtn: TButton;
AddBtn: TButton;
FileList: TListBox;
OD: TOpenDialog;
Button1: TButton;
Button2: TButton;
Button3: TButton;
SaveFile: TSaveDialog;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure CreateBtnClick(Sender: TObject);
procedure AddBtnClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
FilePackage:TPackage;
{ Public declarations }
end;
var
AppPackForm: TAppPackForm;
implementation
{$R *.dfm}
//////包头////////////////////////////////////
constructor TPackHeader.Create(AOwner: TComponent);
begin
inherited Create;
AllFileSize:=0;
FileCount:=0;
HeadSize:=SizeOf(FHeadSize)+SizeOf(FAllFileSize)+SizeOf(FFileCount);
end;
destructor TPackHeader.Destroy;
begin
inherited Destroy;
end;
procedure TPackHeader.Init;
begin
AllFileSize:=0;
FileCount:=0;
HeadSize:=SizeOf(FHeadSize)+SizeOf(FAllFileSize)+SizeOf(FFileCount);
end;
//流的读写
procedure TPackHeader.LoadFromStream(AStream:TStream);
begin
//按次序读取到变量中
AStream.Read(FHeadSize,SizeOf(FHeadSize));
AStream.Read(FAllFileSize,SizeOf(FAllFileSize));
AStream.Read(FFileCount,SizeOf(FFileCount));
end;
procedure TPackHeader.WriteToStream(AStream:TStream);
begin
AStream.Write(FHeadSize,SizeOf(FHeadSize));
AStream.Write(FAllFileSize,SizeOf(FAllFileSize));
AStream.Write(FFileCount,SizeOf(FFileCount));
end;
//设置值
procedure TPackHeader.SetHeadSize(Value:LongWord);
begin
FHeadSize:=Value;
end;
procedure TPackHeader.SetFileCount(Value:LongWord);
begin
FFileCount:=Value;
end;
procedure TPackHeader.SetAllFileSize(Value:LongWord);
begin
FAllFileSize:=Value;
end;
///包文件项目//////////////////////////
constructor TFileItem.Create(AOwner: TComponent);
begin
inherited Create;
FFileName:='';
FFileSize:=0;
FStartPos:=0;
FFileNameLen:=0;
FFileInitSize:=0;
end;
destructor TFileItem.Destroy;
begin
inherited Destroy;
end;
procedure TFileItem.SetFileName(Value:string);
begin
FFileName:=Value;
end;
procedure TFileItem.SetFileSize(Value:LongWord);
begin
FFileSize:=Value;
end;
procedure TFileItem.SetStartPos(Value:LongWord);
begin
FStartPos:=Value;
end;
function TFileItem.GetFileNameLen:word;
begin
Result:=Length(FFileName);
end;
//流的读写
procedure TFileItem.LoadFromStream(AStream:TStream);
begin
//按次序读取到变量中
//先读文件名长度
AStream.Read(FFileNameLen,SizeOf(FFileNameLen));
SetLength(FFileName,FFileNameLen);
AStream.Read(FFileName[1],FFileNameLen);
AStream.Read(FFileSize,SizeOf(FFileSize));
AStream.Read(FFileInitSize,SizeOf(FFileInitSize));
AStream.Read(FStartPos,SizeOf(FStartPos));
end;
procedure TFileItem.WriteToStream(AStream:TStream);
begin
AStream.Write(FFileNameLen,SizeOf(FFileNameLen));
AStream.Write(FFileName[1],FFileNameLen);
AStream.Write(FFileSize,SizeOf(FFileSize));
AStream.Write(FFileInitSize,SizeOf(FFileInitSize));
AStream.Write(FStartPos,SizeOf(FStartPos));
end;
////////FileItems//////////////
function TFileItems.GetItem(Index:Integer):TFileItem;
begin
Result:=TFileItem(FItems[Index]);
end;
function TFileItems.GetCount:Integer;
begin
Result:=FItems.Count;
end;
constructor TFileItems.Create(AOwner: TComponent);
begin
inherited Create;
FItems:=TList.Create;
end;
destructor TFileItems.Destroy;
begin
Self.ClearItems;
FreeAndNil(FItems);
inherited Destroy;
end;
//清除
procedure TFileItems.ClearItems;
var
i:integer;
begin
if FItems.Count>0 then
begin
for i:=FItems.Count-1do
wnto 0do
begin
TFileItem(FItems).Free;
end;
Fitems.Clear;
end;
end;
//写到流
procedure TFileItems.WriteToStream(AStream:TStream);
var
i:integer;
begin
for i:=0 to FItems.Count-1do
begin
TFileItem(FItems).WriteToStream(AStream);
end;
end;
//从流读取
procedure TFileItems.LoadFromStream(AStream: TStream;ACount:Word);
var
i:integer;
AItem:TFileItem;
begin
for i:=0 to ACount-1do
begin
AItem:=TFileItem.Create(nil);
AItem.LoadFromStream(AStream);
FItems.Add(AItem);
end;
end;
//加入带列表
procedure TFileItems.AddItem(AItem:TFileItem);
begin
FItems.Add(AItem);
end;
//删除
procedure TFileItems.DeleteItem(AIndex:Integer);
begin
TFileItem(FItems[AIndex]).Free;
FItems.Delete(AIndex);
end;
//打包处理/////////////////
constructor TPackage.Create(AOwner:TComponent);
begin
//创建新文件包
inherited Create(AOwner);
FPackHeader:=TPackHeader.Create(Self);
FFileItems:=TFileItems.Create(Self);
DirPath:='';
end;
destructor TPackage.Destroy;
begin
//释放
FreeAndNil(FPackHeader);
FreeAndNil(FFileItems);
if Assigned(FPackStream) then
FreeAndNil(FPackStream);
inherited Destroy;
end;
//文件扫描
procedure TPackage.ScanFiles(ADir:string);
var Sr : TSearchRec;
Err : integer;
FilePath : string;
//AFileName:string;
begin
ChDir(ADir);
Err:=FindFirst('*.*',$37,Sr) ;
While (Err = 0)do
begin
if Sr.Name[1]<>'.' then
begin
if Sr.Attr<>faDirectory then
begin
FilePath:=ExpandFileName(Sr.Name);
//装载文件
//AFileName:=copy(FilePath,length(trim(DirPath))+2,length(FilePath)-Length(trim(DirPath)));
Self.AddFileItem(Filepath,ExtractFileName(FilePath));
end;
end;
If ((Sr.Attr and faDirectory)<>0)AND(Sr.Name[1] <> '.') then
begin
Self.ScanFiles(SR.Name);
ChDir('..') ;
end ;
Err:=FindNext(Sr) ;
end ;
end;
procedure TPackage.SetFileItems(const Value:TFileItems);
begin
FFileItems.Assign(Value);
end;
procedure TPackage.SetHeader(const Value:TPackHeader);
begin
FPackHeader.Assign(Value);
end;
//增加文件项目
procedure TPackage.AddFileItem(AFileName:string;AddFilename:string);
var
AFileItem:TFileItem;
AFileStream:TFileStream;
ZipStream:TCompressionStream;
DestStream:TMemoryStream;
//AEncodeStream:TMemoryStream;
begin
//先判断文件是否存在
if not FileExists(AFilename) then
Exit;
if FPackStream=nil then
exit;
//读取文件
AFileStream:=TFileStream.Create(AFileName,fmOpenRead);
//压缩文件流
DestStream:=TMemoryStream.Create;
ZipStream:=TCompressionStream.Create(clmax,DestStream);
ZipStream.CopyFrom(AFileStream,0);
ZipStream.Free;
DestStream.Position:=0;
//编码转换
{AEncodeStream:=TMemoryStream.Create;
EncodeStream(DestStream,AEncodeStream);
AEncodeStream.Position:=0;
}
//建立文件项
AFileItem:=TFileItem.Create(Self);
AFileItem.FFileName:=AddFilename;
AFileItem.FFileNameLen:=AFileItem.GetFileNameLen;
AFileItem.FFileInitSize:=AFileStream.Size;
AFileItem.FFileSize:=DestStream.Size;
AFileItem.FStartPos:=FPackHeader.FHeadSize+FPackHeader.FAllFileSize;
//写文件到包
FPackStream.Position:=FPackHeader.FHeadSize+FPackHeader.FAllFileSize;
FPackStream.CopyFrom(DestStream,0);
//改变包头
Inc(FPackHeader.FAllFileSize,DestStream.Size);
Inc(FPackHeader.FFileCount);
//加入到项目列表
FFileItems.AddItem(AFileItem);
FreeAndNil(AFileStream);
FreeAndNil(DestStream);
//FreeAndNil(AEncodeStream);
end;
//从目录加载文件
procedure TPackage.AddFileFromDir(ADir:string);
begin
if not DirectoryExists(ADir) then
Exit;
//扫描目录，将文件加入到包
DirPath:=ADir;
Self.ScanFiles(ADir);
end;
procedure TPackage.AddFileFromEpr(AEprName:string);
begin
//通过指定的工程文件装载工程包含的所有文件
{ExtractRelativePath}
end;
//删除文件项目
procedure TPackage.DeleteFileItem(Index: Integer);
begin
FFileItems.DeleteItem(Index);
end;
//新包
procedure TPackage.NewPackage(AFileName:string);
begin
//AFileName是包的文件名
Self.InitPackage;
PackFileName:=AFileName;
//创建包的文件流
FPackStream:=TFileStream.Create(AFileName,fmCreate);
//包的文件流建立以后，将包头写入流
FPackHeader.WriteToStream(FPackStream);
end;
procedure TPackage.InitPackage;
begin
//清空结构
PackFileName:='';
FPackHeader.Init;
FFileItems.ClearItems;
if FPackStream<>nil then
FreeAndNil(FPackStream);
end;
//装载包文件
procedure TPackage.LoadPackage(AFileName:string);
begin
//释放原来的
Self.InitPackage;
PackFileName:=AFileName;
//创建包的文件流
FPackStream:=TFileStream.Create(AFileName,fmOpenReadWrite);
//从流中获取包头
FPackStream.Position:=0;
FPackHeader.LoadFromStream(FPackStream);
if FPackHeader.FFileCount>0 then
begin
FPackStream.Position:=FPackHeader.FHeadSize+FPackHeader.AllFileSize;
FFileItems.LoadFromStream(FPackStream,FPackHeader.FileCount);
end;
end;
//保存包
procedure TPackage.SavePackage;
var
i:integer;
WriteStream,ReadStream:TFileStream;
begin
//保存方法,读写
//释放包流,释放读写权限
if FPackStream=nil then
Exit;
FreeAndNil(FPackStream);
//建立读写包
WriteStream:=TFileStream.Create(PackFileName,fmOpenWrite or fmShareDenyNone);
ReadStream:=TFileStream.Create(PackFileName,fmOpenRead or fmShareDenyNone);
WriteStream.Position:=0;
ReadStream.Position:=0;
//写入包头
FPackHeader.FAllFileSize:=0;
FPackHeader.FFileCount:=0;
FPackHeader.WriteToStream(WriteStream);
//写入包文件
for i:=0 to FFileItems.Count-1do
begin
//获取读文件流中的位置
ReadStream.Position:=FFileItems.Items.FStartPos;
//设置在写文件流中的位置
TFileItem(FFileItems.Items).FStartPos:=WriteStream.Position;
//写入到写文件流
WriteStream.CopyFrom(ReadStream,FFileItems.Items.FFileSize);
//修改头
Inc(FPackHeader.FAllFileSize,FFileItems.Items.FFileSize);
Inc(FPackHeader.FFileCount);
end;
//设定写文件流大小
WriteStream.Size:=WriteStream.Position;
//重新写入头
WriteStream.Position:=0;
FPackHeader.WriteToStream(WriteStream);
//写入包尾
WriteStream.Position:=WriteStream.Size;
FFileItems.WriteToStream(WriteStream);
//释放
WriteStream.Free;
ReadStream.Free;
//重新装载
FPackStream:=TFileStream.Create(PackFileName,fmOpenReadWrite);
FPackStream.Position:=FPackHeader.FHeadSize+FPackHeader.FAllFileSize;
end;
//从包中导出文件
procedure TPackage.FileItemToFile(Index:Integer;AFileName:string);
var
AFileStream: TFileStream;
AMemoryStream:TMemoryStream;
//ADecodeStream:TMemoryStream;
UnZipStream:TDecompressionStream;
begin
AFileStream := TFileStream.Create(AFileName, fmCreate);
AMemoryStream:=TMemoryStream.Create;
//ADecodeStream:=TMemoryStream.Create;
UnZipStream:=nil;
try
//先获取压缩流
FPackStream.Position := FFileItems.Items[Index].FStartPos;
AMemoryStream.CopyFrom(FPackStream, FFileItems.Items[Index].FFileSize);
AMemoryStream.Position:=0;
//解码
//DecodeStream(AMemoryStream,ADecodeStream);
//ADecodeStream.Position:=0;
//然后解压缩
UnZipStream:=TDecompressionStream.Create(AMemoryStream);
AFileStream.CopyFrom(UnZipStream,FFileItems.Items[Index].FFileInitSize);
finally
AMemoryStream.Free;
UnZipStream.Free;
AFileStream.Free;
//ADecodeStream.Free;
end;
end;
//从包中导出到流
procedure TPackage.FileItemToStream(Index:Integer;AStream:TStream);
var
AMemoryStream:TMemoryStream;
//ADecodeStream:TMemoryStream;
UnZipStream:TDecompressionStream;
begin
if AStream=nil then
Exit;
AMemoryStream:=TMemoryStream.Create;
//ADecodeStream:=TMemoryStream.Create;
UnZipStream:=nil;
try
//先获取压缩流
FPackStream.Position := FFileItems.Items[Index].FStartPos;
AMemoryStream.CopyFrom(FPackStream, FFileItems.Items[Index].FFileSize);
AMemoryStream.Position:=0;
//解码
//DecodeStream(AMemoryStream,ADecodeStream);
//ADecodeStream.Position:=0;
//然后解压缩
UnZipStream:=TDecompressionStream.Create(AMemoryStream);
AStream.CopyFrom(UnZipStream,FFileItems.Items[Index].FFileInitSize);
AStream.Position:=0;
finally
AMemoryStream.Free;
UnZipStream.Free;
//ADecodeStream.Free;
end;
end;
///**************************************///////////
procedure TAppPackForm.FormCreate(Sender: TObject);
begin
//创建文件
FilePackage:=TPackage.Create(Self);
end;
procedure TAppPackForm.CreateBtnClick(Sender: TObject);
begin
if SD.Execute then
begin
Edit1.Text:=ExtractFilePath(SD.FileName)+ExtractFileName(SD.FileName);
FilePackage.NewPackage(Edit1.Text);
end;
end;
procedure TAppPackForm.AddBtnClick(Sender: TObject);
var
AFileName:string;
i:integer;
begin
//增加文件
if OD.Execute then
begin
AFileName:=OD.FileName;
//查找是否已经存在该文件
//没有的话写入
FilePackage.AddFileItem(AFileName,AFileName);
//列表
FileList.Items.Clear;
for i:=0 to FilePackage.FileItems.Count-1do
begin
FileList.Items.Add(FilePackage.FileItems.Items.FileName);
end;
end;
end;
procedure TAppPackForm.Button1Click(Sender: TObject);
begin
FilePackage.SavePackage;
end;
procedure TAppPackForm.Button2Click(Sender: TObject);
var
i:integer;
begin
//装载
if OD.Execute then
begin
FilePackage.LoadPackage(OD.FileName);
//列表
FileList.Items.Clear;
for i:=0 to FilePackage.FileItems.Count-1do
begin
FileList.Items.Add(FilePackage.FileItems.Items.FileName);
end;
end;
end;
procedure TAppPackForm.Button3Click(Sender: TObject);
begin
//将选择的压缩文件导出
if FileList.ItemIndex=-1 then
Exit;
SaveFile.FileName:=ExtractFileName(FileList.Items[FileList.ItemIndex]);
if SaveFile.Execute then
begin
FilePackage.FileItemToFile(FileList.ItemIndex,SaveFile.FileName);
end;
end;
procedure TAppPackForm.Button4Click(Sender: TObject);
var
ADir:string;
i:integer;
begin
if SelectDirectory('请选择文件夹','',ADir) then
begin
FilePackage.AddFileFromDir(ADir);
//列表
FileList.Items.Clear;
for i:=0 to FilePackage.FileItems.Count-1do
begin
FileList.Items.Add(FilePackage.FileItems.Items.FileName);
end;
end;
end;
end.
------------------------------
呵呵,搞定了吧.
