作者：louisling@etang.com

//将多个文件打包

function PackMultiFile(AFiles: TStrings; ADestFileName: string): Boolean;

//AFiles: 需要打包的文件名 ADestFileName:打包后的包文件名

var

 I, iPos, iSize,  //文件在包中的开始开始位置、文件大小

 iHeadLength: Integer;  //文件描述信息长度

 sHeadContent,  //文件描述信息

 sFileName: string;

 mMemoryStream: TMemoryStream; //打包后的流

 mFileStream: TFileStream;

 FBuffer: array of Byte;

begin

 Result := False;

 if not DirectoryExists(ExtractFileDir(ADestFileName)) then Exit;

 if not Assigned(AFiles) or (AFiles.Count = 0) then Exit;

 mMemoryStream := TMemoryStream.Create;

 try

   try

     //写包头

     iPos := 0; iSize := 0;

     for I := 0 to AFiles.Count - 1 do

     begin

       if I = 0 then iPos := 0

       else iPos := iPos + iSize;

       iSize := GetTheFileSize(AFiles[I]);

       sFileName := ExtractFileName(AFiles[I]);

       sHeadContent := sHeadContent + sFileName + '|' + IntToStr(iPos) + '|' + IntToStr(iSize) + #13#10;

     end;

     iHeadLength := Length(sHeadContent);

     SetLength(FBuffer, iHeadLength + 4);

     Move(iHeadLength, FBuffer[0], 4);  //复制文件信息长度 1

     Move(sHeadContent[1], FBuffer[4], iHeadLength); //复制文件信息内容 2

     mMemoryStream.Write(FBuffer[0], iHeadLength + 4); //写包头信息(1 + 2)

     //写包内容

     for I := 0 to AFiles.Count - 1 do

     begin

       if not FileExists(AFiles[I]) then Exit;

       mFileStream := TFileStream.Create(AFiles[I], fmOpenRead);

       mMemoryStream.CopyFrom(mFileStream, mFileStream.Size);

       mFileStream.Free;

     end;

     mMemoryStream.SaveToFile(ADestFileName);

     Result := True;

   except

     ;

   end;

 finally

   mMemoryStream.Free;

   FBuffer := nil;

 end;

end;

//将包文件解包成原来的文件

function UnPackMultiFile(AFileName, AFilePath: string): Boolean;

//AFileName:需要解包的包文件名 AFilePath:解包后的文件存放路径

var

 mFileStream: TFileStream;  //需要解析的包文件

 mMemoryStream: TMemoryStream; //解析后的单个文件

 mList: TStringList; //包头(每行：文件名、开始位置、大小)

 I,

 iHeadLength, //包头长度

 iDataBegin,  //包内容的开始位置

 iFileBegin,  //文件的开始位置

 iFileSize: Integer; //文件大小

 S,

 sHeadContent, //包头内容

 sFileName: string;

 FBuffer: array of Byte;

begin

 Result := False;

 if not DirectoryExists(AFilePath) then Exit;

 if not FileExists(AFileName) then Exit;

 mList := TStringList.Create;

 mMemoryStream := TMemoryStream.Create;

 mFileStream := TFileStream.Create(AFileName, fmOpenRead);

 try

   try

     //读包头的长度

     SetLength(FBuffer, 4);

     mFileStream.Read(FBuffer[0], 4);

     Move(FBuffer[0], iHeadLength, 4);

     //读包头的内容

     FBuffer := nil; //清空FBuffer

     SetLength(FBuffer, iHeadLength);

     SetLength(sHeadContent, iHeadLength);

     mFileStream.Read(FBuffer[0], iHeadLength);  //读包头

     Move(FBuffer[0], sHeadContent[1], iHeadLength);  //包头内容-->HeadStr

     iDataBegin := mFileStream.Position;

     mList.Text := sHeadContent;

     for I := 0 to mList.Count - 1 do

     begin

       S := mList[I];

       sFileName := GetLeftStr(S);

       iFileBegin := StrToInt(GetLeftStr(S));

       iFileSize := StrToInt(S);

       if AFilePath[Length(AFilePath)] = '\' then sFileName := AFilePath + sFileName

       else sFileName := AFilePath + '\' + sFileName;

       mMemoryStream.Clear;

       mFileStream.Position := iDataBegin + iFileBegin;

       mMemoryStream.CopyFrom(mFileStream, iFileSize);

       mMemoryStream.SaveToFile(sFileName);

     end;

     Result := True;

   except

     ;

   end;

 finally

   mList.Free;

   mMemoryStream.Free;

   mFileStream.Free;

   FBuffer := nil;

 end;

end;

//文件大小

function GetTheFileSize(AFileName: string): DWord;

var

 hFile: Cardinal;

 dSize: DWord;

begin

 Result := 0;

 hFile := CreateFile(PChar(AFileName), 0, FILE_SHARE_READ, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

 if hFile = INVALID_HANDLE_VALUE then Exit;

 dSize := GetFileSize(hFile, nil);

 CloseHandle(hFile);

 Result := dSize;

end;

//取分隔符左边的字符串，并将之连分隔符一起删除

function GetLeftStr(var ASource: string; ASeperate: string): string;

var

 I: Integer;

begin

 Result := '';

 I := Pos(ASeperate, ASource);

 if I < 1 then Exit;

 Result := Copy(ASource, 1, I - 1);

 Delete(Asource, 1, I + Length(ASeperate) - 1);

end;

//取临时文件

function GetMyTempFile(AFileName: string): string; //取临时文件名

var

 C: PChar;

begin

 Result := '';

 GetMem(C, 255);

 GetTempPath(255, C);

 Result := StrPas(C) + '\' + AFileName;

 FreeMem(C, 255);

end;

//测试：

//打包

--------------------------------------------------------------------------------------------------------

包文件格式：

   包头.大小

   文件1.名称 文件1.开始位置 文件1.大小

   文件1.名称 文件1.开始位置 文件1.大小

   ...

   文件1

   文件2

   ...