unit _CZip_Tools;

interface

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}

uses
  Windows,Dialogs,SysUtils,Classes,ZLib;

type
  TCZipFiles=record
    Filename:string;
    Size:integer;
    CRC:dword;
    EncData,DecData:array of byte;
  end;
  TCZip=record
    Files:array of TCZipFiles;
    FilesCount:integer;
  end;

const CZipDecompressSuccess=0;
const CZipDecompressFileSizeError=1;
const CZipDecompressCRCError=2;
const CZipDecompressAttrError=3;
const CZipDecompressDecompressError=4;
const CZipDecompressWriteError=5;

function CZipGetCRC(var Data:PByteArray;const Offset,Size:integer):dword;overload;
function CZipGetCRC(var Data:array of byte;const Offset,Size:integer):dword;overload;

function CZipCompress(var CZip:TCZip;const Path:string):boolean;
procedure _CZipCompressSetFilename(var CZip:TCZip;const BasePath,Path:string);
procedure _CZipCompressLoadDecFiles(var CZip:TCZip;const BasePath:string);
procedure _CZipCompressing(var CZip:TCZip);
procedure CZipCompressedSave(var CZip:TCZip;const CZipFilename:string);

function CZipOverrideCheck(const CZipFilename,DstPath:string):integer;
function CZipDecompress(const CZipFilename,DstPath:string):integer;
function _CZipDecompressLoadCZip(var CZip:TCZip;const CZipFilename:string):integer;
function _CZipDecompressCheckCRC(var CZip:TCZip):integer;
function _CZipDecompressCheckFileAttr(var CZip:TCZip;const DstPath:string):integer;
function _CZipDecompressing(var CZip:TCZip):integer;
function _CZipDecompressWrite(var CZip:TCZip;const DstPath:string):integer;

implementation

uses _m_Tools;

function CZipGetCRC(var Data:PByteArray;const Offset,Size:integer):dword;
var
  TempData:array of byte;
begin
  SetLength(TempData,Size+1);
  MoveMemory(@TempData[0],@Data[0],Size);
  Result:=CZipGetCRC(TempData,Offset,Size);
end;

function CZipGetCRC(var Data:array of byte;const Offset,Size:integer):dword;
var
  cnt:integer;
begin
  Result:=0;
  for cnt:=0 to Size-1 do begin
    Result:=((Result xor dword(Data[Offset+cnt])) shl 1) and $7fffffff;
  end;
end;

function CZipCompress(var CZip:TCZip;const Path:string):boolean;
begin
  CZip.FilesCount:=0;
  _CZipCompressSetFilename(CZip,Path,'');
  _CZipCompressLoadDecFiles(CZip,Path);
  _CZipCompressing(CZip);

  Result:=True;
end;

procedure _CZipCompressSetFilename(var CZip:TCZip;const BasePath,Path:string);
var
  FileLst:array of string;
  FileLstMax:integer;
  cnt:integer;
  res:integer;
  SearchRec: TSearchRec;
begin
  res:=FindFirst(BasePath+Path+'*.*', (faReadOnly or faHidden or faSysFile or faArchive), SearchRec);
  if res=0 then begin
    FileLstMax:=0;
    repeat
      SetLength(FileLst,FileLstMax+1);
      FileLst[FileLstMax]:=SearchRec.Name;
      inc(FileLstMax);
      res:=FindNext(SearchRec);
    until (res<>0);

    for cnt:=0 to FileLstMax-1 do begin
      SetLength(CZip.Files,CZip.FilesCount+1);
      with CZip.Files[CZip.FilesCount] do begin
        Filename:=Path+FileLst[cnt];
        Size:=-1;
        CRC:=$00000000;
        SetLength(EncData,0);
        SetLength(DecData,0);
      end;
      inc(CZip.FilesCount);
    end;
  end;
  FindClose(SearchRec);

  res:=FindFirst(BasePath+Path+'*.*', (faDirectory or faReadOnly or faHidden or faSysFile or faArchive), SearchRec);
  if res=0 then begin
    FileLstMax:=0;
    repeat
      SetLength(FileLst,FileLstMax+1);
      if (SearchRec.Attr and faDirectory)<>0 then begin
        if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then begin
          FileLst[FileLstMax]:=SearchRec.Name;
          inc(FileLstMax);
        end;
      end;
      res:=FindNext(SearchRec);
    until (res<>0);

    for cnt:=0 to FileLstMax-1 do begin
      _CZipCompressSetFilename(CZip,BasePath,Path+FileLst[cnt]+'\');
    end;
  end;
  FindClose(SearchRec);
end;

procedure _CZipCompressLoadDecFiles(var CZip:TCZip;const BasePath:string);
var
  cnt:integer;
  Decfs:TFileStream;
  DecFilename:string;
  DecDataSize:integer;
begin
  for cnt:=0 to CZip.FilesCount-1 do begin
    DecFilename:=BasePath+CZip.Files[cnt].Filename;
    if FileExists(DecFilename)=False then begin
      ShowMessage(DecFilename+'が見つかりません。');
      exit;
    end;

    Decfs:=TFileStream.Create(DecFilename,fmOpenRead or fmShareExclusive);
    with CZip.Files[cnt] do begin
      DecDataSize:=Decfs.Size;
      SetLength(DecData,DecDataSize);
      if DecDataSize<>0 then Decfs.ReadBuffer(DecData[0],DecDataSize);
    end;
    Decfs.Free;
  end;
end;

procedure _CZipCompressing(var CZip:TCZip);
var
  cnt:integer;
  DecDataPB,EncDataPB:PByteArray;
begin
  for cnt:=0 to CZip.FilesCount-1 do begin
    with CZip.Files[cnt] do begin
      GetMem(DecDataPB,length(DecData));
      MoveMemory(@DecDataPB[0],@DecData[0],length(DecData));
      ZLib.CompressBuf(pointer(DecDataPB),length(DecData),pointer(EncDataPB),Size);
      FreeMem(DecDataPB);

      if (EncDataPB=nil) or (Size=0) then begin
        ShowMessage('圧縮失敗');
        exit;
      end;

      SetLength(EncData,Size);
      MoveMemory(@EncData[0],@EncDataPB[0],Size);
      FreeMem(EncDataPB);

      CRC:=CZipGetCRC(EncData,0,Size);
    end;
  end;
end;

procedure CZipCompressedSave(var CZip:TCZip;const CZipFilename:string);
var
  cnt:integer;
  Dstfs:TFileStream;
begin
  Dstfs:=TFileStream.Create(CZipFilename,fmCreate or fmShareExclusive);

  for cnt:=0 to CZip.FilesCount-1 do begin
    with CZip.Files[cnt] do begin
      SetStreamMString(Dstfs,Filename);
      SetStreamDWord(Dstfs,Size);
      SetStreamDWord(Dstfs,CRC);
      Dstfs.Write(EncData[0],Size);
    end;
  end;

  SetStreamMString(Dstfs,'');
  SetStreamDWord(Dstfs,0);
  SetStreamDWord(Dstfs,$00000000);

  Dstfs.Free;
end;

function CZipOverrideCheck(const CZipFilename,DstPath:string):integer;
var
  CZip:TCZip;
begin
  Result:=_CZipDecompressLoadCZip(CZip,CZipFilename);
  if Result<>CZipDecompressSuccess then exit;

  Result:=_CZipDecompressCheckCRC(CZip);
  if Result<>CZipDecompressSuccess then exit;

  Result:=_CZipDecompressCheckFileAttr(CZip,DstPath);
  if Result<>CZipDecompressSuccess then exit;
end;

function CZipDecompress(const CZipFilename,DstPath:string):integer;
var
  CZip:TCZip;
begin
  Result:=_CZipDecompressLoadCZip(CZip,CZipFilename);
  if Result<>CZipDecompressSuccess then exit;

  Result:=_CZipDecompressCheckCRC(CZip);
  if Result<>CZipDecompressSuccess then exit;

  Result:=_CZipDecompressCheckFileAttr(CZip,DstPath);
  if Result<>CZipDecompressSuccess then exit;

  Result:=_CZipDecompressing(CZip);
  if Result<>CZipDecompressSuccess then exit;

  Result:=_CZipDecompressWrite(CZip,DstPath);
  if Result<>CZipDecompressSuccess then exit;
end;

function _CZipDecompressLoadCZip(var CZip:TCZip;const CZipFilename:string):integer;
var
  Encfs:TFileStream;
  EndFlag:boolean;
begin
  Encfs:=TFileStream.Create(CZipFilename,fmOpenRead or fmShareExclusive);
  EndFlag:=False;
  CZip.FilesCount:=0;

  while (EndFlag=False) do begin
    SetLength(CZip.Files,CZip.FilesCount+1);
    with CZip.Files[CZip.FilesCount] do begin
      Filename:=GetStreamMString(Encfs);
      Size:=GetStreamDWord(Encfs);
      CRC:=GetStreamDWord(Encfs);
      if Filename='' then begin
        EndFlag:=True;
        end else begin
        if (Encfs.Position+Size)>Encfs.Size then begin
          Result:=CZipDecompressFileSizeError;
          Encfs.Free;
          exit;
        end;
        SetLength(EncData,Size+1);
        Encfs.ReadBuffer(EncData[0],Size);
      end;
    end;
    if EndFlag=False then inc(CZip.FilesCount);
  end;

  Encfs.Free;

  Result:=CZipDecompressSuccess;
end;

function _CZipDecompressCheckCRC(var CZip:TCZip):integer;
var
  cnt:integer;
begin
  for cnt:=0 to CZip.FilesCount-1 do begin
    with CZip.Files[cnt] do begin
      if CRC<>CZipGetCRC(EncData,0,Size) then begin
        Result:=CZipDecompressCRCError;
        exit;
      end;
    end;
  end;

  Result:=CZipDecompressSuccess;
end;

function _CZipDecompressCheckFileAttr(var CZip:TCZip;const DstPath:string):integer;
var
  cnt:integer;
  fs:TFileStream;
  TargetFilename:string;
begin
  for cnt:=0 to CZip.FilesCount-1 do begin
    TargetFilename:=DstPath+CZip.Files[cnt].Filename;
    if FileExists(TargetFilename)=True then begin
      try
        fs:=TFileStream.Create(TargetFilename,fmOpenWrite or fmShareExclusive);
        fs.Free;
      except
        on EFOpenError do begin
          ShowMessage(CZip.Files[cnt].Filename+' は、書き込み用に開けませんでした。');
          Result:=CZipDecompressAttrError;
          exit;
        end;
      end;
    end;
  end;

  Result:=CZipDecompressSuccess;
end;

function _CZipDecompressing(var CZip:TCZip):integer;
var
  cnt:integer;
  DecDataPB,EncDataPB:PByteArray;
  DecSize:integer;
begin
  for cnt:=0 to CZip.FilesCount-1 do begin
    with CZip.Files[cnt] do begin
      GetMem(EncDataPB,Size);
      MoveMemory(@EncDataPB[0],@EncData[0],Size);
      ZLib.DecompressBuf(pointer(EncDataPB),Size,0,pointer(DecDataPB),DecSize);
      FreeMem(EncDataPB);

      if (DecDataPB=nil) or (DecSize=0) then begin
        Result:=CZipDecompressDecompressError;
        exit;
      end;

      SetLength(DecData,DecSize);
      MoveMemory(@DecData[0],@DecDataPB[0],DecSize);
      FreeMem(DecDataPB);
    end;
  end;

  Result:=CZipDecompressSuccess;
end;

function _CZipDecompressWrite(var CZip:TCZip;const DstPath:string):integer;
var
  cnt:integer;
  fs:TFileStream;
  TargetFilename:string;
begin
  for cnt:=0 to CZip.FilesCount-1 do begin
    TargetFilename:=DstPath+CZip.Files[cnt].Filename;
    ForceDirectories(ExtractFilePath(TargetFilename));
    try
      fs:=TFileStream.Create(TargetFilename,fmCreate or fmShareExclusive);
      fs.Write(CZip.Files[cnt].DecData[0],length(CZip.Files[cnt].DecData));
      fs.Free;
    except
      on EFOpenError do begin
        Result:=CZipDecompressWriteError;
        exit;
      end;
    end;
  end;

  Result:=CZipDecompressSuccess;
end;

end.

