{*------------------------------------------------------------------------------
  Compression, decompression and combination of files using onboard classes

  @Author Patrick Michael Kolla
  @Version 2006/06/28  Changed header format to allow unknown fields
  @Todo Improved error handling
  @Todo Extraction of specified files
  @Todo A method only listing the file contents
-------------------------------------------------------------------------------}
// *****************************************************************************
// Copyright: © 2006 Safer Networking Limited. All rights reserved.
// File:      pkZStreams.pas
// Compiler:  FreePascal 2.1.1
// Purpose:   Compression, decompression and combination of files
// Authors:   Patrick M. Kolla (pk)
// *****************************************************************************
// Used by:
// pkStrings (for a system-dependent definition of PChars and Strings)
// MD5 (part of Lazarus, for storing file checksums in directory)
// *****************************************************************************
// Changelog (new entries first):
// ---------------------------------------
// @Version 2006-06-28  pk  10m  Changed header format to allow unknown fields
// *****************************************************************************

unit pkZStreams;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF FPC}

interface

uses SysUtils, Windows, Classes, ZStream, pkStrings, MD5;

procedure PZSCompress(AArchiveName: StringsString; AFilenames: TStrings);
function PZSExtract(AArchiveName, ADestination: StringsString; TouchDate: TDateTime = 0): boolean;

implementation

const dwHeaderFieldFilename = $00000001; /// Defines a field containing the filename
      dwHeaderFieldFilesize = $00000002; /// Defines a field containing the filesize
      dwHeaderFieldMD5      = $00000003; /// Defines a field containing the MD5 hash of the file contents
      dwHeaderFieldFileage  = $00000004; /// Defines a field containing the filge age

{*------------------------------------------------------------------------------
  Compresses a list of files into an archive compressed using
  TCompressionstream. The suggested extension for this archive is pzs.
  Files will be stored without any directory structure for now.

  @param AArchiveName The name of the destination archive
  @param AFilenames A list of files to be compressed into the archive
  @see   PZSExtract
-------------------------------------------------------------------------------}
procedure PZSCompress(AArchiveName: StringsString; AFilenames: TStrings);
var fsIn, fsOut: TFileStream;
    fsComp: TCompressionStream;
    iFile: integer;
    iSize: Int64;
    dwVer, dwHeaders: DWord;
    sHeader: string[4];
    sFilename: AnsiString;
    md5dig: TMD5Digest;
begin
   fsIn := nil;
   fsOut := nil;
   fsComp := nil;
   fsOut := TFileStream.Create(AArchiveName, fmCreate or fmOpenWrite);
   sHeader := 'PZSi';
   fsOut.Write(sHeader[1], 4);
   dwVer := 2;
   dwHeaders := 3;
   fsOut.WriteDWord(dwVer);
   fsOut.WriteDWord(dwHeaders);
   fsOut.WriteDWord(AFilenames.Count);
   for iFile := 0 to Pred(AFilenames.Count) do begin
      // 1. Filename
      sFilename := ExtractFilename(AFilenames[iFile]);
      fsOut.WriteDWord(dwHeaderFieldFilename);
      fsOut.WriteDWord(Length(sFilename));
      fsOut.Write(sFilename[1],Length(sFilename));
      // 2. Filesize
      fsOut.WriteDWord(dwHeaderFieldFilesize);
      fsOut.WriteDWord(4);
      fsIn := TFileStream.Create(AFilenames[iFile], fmOpenRead or fmShareDenyNone);
      fsOut.WriteDWord(fsIn.Size);
      fsIn.Free;
      // 3. MD5
      fsOut.WriteDWord(dwHeaderFieldMD5);
      fsOut.WriteDWord(16);
      md5dig := MD5File(AFilenames[iFile]);
      fsOut.Write(md5dig[0], 16);
   end;
   fsComp := TCompressionStream.Create(clMax, fsOut);
   for iFile := 0 to Pred(AFilenames.Count) do begin
      fsIn := TFileStream.Create(AFilenames[iFile], fmOpenRead or fmShareDenyNone);
      fsIn.Seek(0,soFromBeginning);
      fsComp.CopyFrom(fsIn, fsIn.Size);
      fsIn.Free;
   end;
   fsComp.Free;
   fsOut.Free;
end;

{*------------------------------------------------------------------------------
  Compresses a list of files into an archive compressed using
  TCompressionstream. The suggested extension for this archive is pzs.
  Files will be stored without any directory structure for now.

  @param AArchiveName The name of the source archive
  @param ADestination The folder into which files should be extracted
  @param TouchDate if set, a date each file should get as its file age
  @see   PZSExtract
-------------------------------------------------------------------------------}
function PZSExtract(AArchiveName, ADestination: StringsString; TouchDate: TDateTime): boolean;
var fsIn, fsOut: TFileStream;
    fsDecomp: TDecompressionStream;
procedure PZSExtractError(AMessage: StringsString);
begin
   {$IFDEF WinCE}
   MessageBox(0,PStringsChar(AMessage),'PZSExtract', MB_OK);
   {$ELSE WinCE}
   WriteLn(AMessage);
   {$ENDIF WinCE}
   if Assigned(fsDecomp)
    then fsDecomp.Free;
   if Assigned(fsOut)
    then fsOut.Free;
   if Assigned(fsIn)
    then fsIn.Free;
end;
type
   TExtractFileRec = record
      Filename: AnsiString;
      Filesize: Int64;
      MD5: TMD5Digest;
   end;
var iSize: Int64;
    dwVer, dwHeaders, dwFieldID, dwFieldSize, iFile, iHeader, iFileCount: DWord;
    sID: string[4];
    sMD5: AnsiString;
    aFiles: array of TExtractFileRec;
begin
   Result := false;
   if not FileExists(AArchiveName) then begin
      PZSExtractError('Archive missing!');
      Exit;
   end;
   fsIn := nil;
   fsOut := nil;
   fsDecomp := nil;
   fsIn := TFileStream.Create(AArchiveName, fmOpenRead);
   fsIn.Seek(0, soFromBeginning);
   if fsIn.Size<12 then begin
      PZSExtractError('No valid archive!');
      Exit;
   end;
   SetLength(sID,4);
   fsIn.Read(sID[1], 4);
   if SID<>'PZSi' then begin
      PZSExtractError('File is not a valid PZS archive!');
      Exit;
   end;
   dwVer := fsIn.ReadDWord;
   if dwVer>2 then begin
      PZSExtractError('Version '+IntToStr(dwVer)+' not known!');
      Exit;
   end;
   dwHeaders := fsIn.ReadDWord;
   if dwHeaders<3 then begin
      PZSExtractError('Unknown directory format!');
      Exit;
   end;
   iFileCount := fsIn.ReadDWord;
   SetLength(aFiles, iFileCount);
   for iFile := 0 to Pred(iFileCount) do begin
      for iHeader := 0 to Pred(dwHeaders) do begin
         dwFieldID := fsIn.ReadDWord;
         dwFieldSize := fsIn.ReadDWord;
         case dwFieldID of
            dwHeaderFieldFilename: begin
               SetLength(aFiles[iFile].Filename, dwFieldSize);
               fsIn.Read(aFiles[iFile].Filename[1],dwFieldSize);
            end;
            dwHeaderFieldFilesize: aFiles[iFile].Filesize := fsIn.ReadDWord;
            dwHeaderFieldMD5: fsIn.Read(aFiles[iFile].MD5[0],16);
            else begin
               fsIn.Seek(dwFieldSize, soFromCurrent);
            end;
         end;
      
      end;
   end;
   fsDecomp := TDecompressionStream.Create(fsIn);
   for iFile := 0 to Pred(iFileCount) do begin
      fsOut := TFileStream.Create(ADestination + aFiles[iFile].Filename, fmCreate or fmOpenWrite);
      fsOut.CopyFrom(fsDecomp, aFiles[iFile].Filesize);
      if TouchDate>0
       then FileSetDate(fsOut.Handle,DateTimeToFileDate(TouchDate));
      fsOut.Free;
   end;
   fsDecomp.Free;
   fsIn.Free;
   Result := true;
end;

end.