Subversion Repositories autosfx

unit ZMWorkFile19;

 

 

 

 

 

 

 

 

  Classes, Windows, SysUtils, ZipMstr19, ZMDelZip19, ZMCore19, ZMDrv19;

 

  TZipFileSigs = (zfsNone, zfsLocal, zfsMulti, zfsDOS);

 

  TZipNumberScheme = (znsNone, znsVolume, znsName, znsExt);

 

  TZipWrites = (zwDefault, zwSingle, zwMultiple);

 

  ProgressActions: array [TZipShowProgress] of TActionCodes =

    (zacTick, zacProgress, zacXProgress);

  MustFitError = -10999;

  MustFitFlag = $20000; // much bigger than any 'fixed' field

  MustFitMask = $1FFFF; // removes flag limits 'fixed' length

 

  TByteBuffer = array of Byte;

 

  TZMWorkFile = class(TObject)

  private

    fAllowedSize: Int64;

    FBoss: TZMCore;

    fBytesRead: Int64;

    fBytesWritten: Int64;

    fDiskNr: Integer;

    fFileName: String;

    fFile_Size: Int64;

    fHandle: Integer;

    fInfo: Cardinal;

    fIsOpen: Boolean;

    fIsTemp: Boolean;

    fLastWrite: TFileTime;

    fOpenMode: Cardinal;

    fRealFileName: String;

    fRealFileSize: Int64;

    FReqFileName: String;

    fShowProgress: TZipShowProgress;

    fSig: TZipFileSigs;

    fStampDate: Cardinal;

    fTotalDisks: Integer;

    fWorkDrive: TZMWorkDrive;

    fWorker: TZMCore;

    FZipDiskAction: TZMDiskAction;

    FZipDiskStatus: TZMZipDiskStatus;

    WBuf: array of Byte;

    function GetConfirmErase: Boolean;

    function GetExists: Boolean;

    function GetKeepFreeOnAllDisks: Cardinal;

    function GetKeepFreeOnDisk1: Cardinal;

    function GetLastWritten: Cardinal;

    function GetMaxVolumeSize: Int64;

    function GetMinFreeVolumeSize: Cardinal;

    function GetPosition_F: Int64;

    function GetSpanOptions: TZMSpanOpts;

    procedure SetBoss(const Value: TZMCore);

    procedure SetFileName(const Value: String);

    procedure SetHandle(const Value: Integer);

    procedure SetKeepFreeOnAllDisks(const Value: Cardinal);

    procedure SetKeepFreeOnDisk1(const Value: Cardinal);

    procedure SetMaxVolumeSize(const Value: Int64);

    procedure SetMinFreeVolumeSize(const Value: Cardinal);

    procedure SetPosition(const Value: Int64);

    procedure SetSpanOptions(const Value: TZMSpanOpts);

    procedure SetWorkDrive(const Value: TZMWorkDrive);

  protected

    fBufferPosition: Integer;

    fConfirmErase: Boolean;

    fDiskBuffer: TByteBuffer;

    FDiskWritten: Cardinal;

    fSavedFileInfo: _BY_HANDLE_FILE_INFORMATION;

    fIsMultiPart: Boolean;

    FNewDisk: Boolean;

    FNumbering: TZipNumberScheme;

    function ChangeNumberedName(const FName: String; NewNbr: Cardinal; Remove:

        boolean): string;

    procedure CheckForDisk(writing, UnformOk: Boolean);

    procedure ClearFloppy(const dir: String);

    function Copy_File(Source: TZMWorkFile): Integer;

    procedure Diag(const msg: String);

    function EOS: Boolean;

    procedure FlushDiskBuffer;

    function GetFileInformation(var FileInfo: _BY_HANDLE_FILE_INFORMATION): Boolean;

    function GetPosition: Int64;

    function HasSpanSig(const FName: String): boolean;

    function IsRightDisk: Boolean;

    procedure NewFlushDisk;

    function NewSegment: Boolean;

    function VolName(Part: Integer): String;

    function OldVolName(Part: Integer): String;

    function WriteSplit(const Buffer; ToWrite: Integer): Integer;

    function ZipFormat(const NewName: String): Integer;

    property AllowedSize: Int64 Read fAllowedSize Write fAllowedSize;

    property LastWrite: TFileTime read fLastWrite write fLastWrite;

    property OpenMode: Cardinal read fOpenMode;

  public

    constructor Create(wrkr: TZMCore); virtual;

    procedure AfterConstruction; override;

    function AskAnotherDisk(const DiskFile: String): Integer;

    function AskOverwriteSegment(const DiskFile: String; DiskSeq: Integer): Integer;

    procedure AssignFrom(Src: TZMWorkFile); virtual;

    procedure BeforeDestruction; override;

    function CheckRead(var Buffer; Len: Integer): Boolean; overload;

    procedure CheckRead(var Buffer; Len, ErrId: Integer); overload;

    function CheckReads(var Buffer; const Lens: array of Integer): Boolean;

      overload;

    procedure CheckReads(var Buffer; const Lens: array of Integer;

      ErrId: Integer); overload;

    function CheckSeek(offset: Int64; from, ErrId: Integer): Int64;

    function CheckWrite(const Buffer; Len: Integer): Boolean; overload;

    procedure CheckWrite(const Buffer; Len, ErrId: Integer); overload;

    function CheckWrites(const Buffer; const Lens: array of Integer): Boolean;

      overload;

    procedure CheckWrites(const Buffer; const Lens: array of Integer;

      ErrId: Integer); overload;

    procedure ClearFileInformation;

    function CopyFrom(Source: TZMWorkFile; Len: Int64): Int64;

    function CreateMVFileNameEx(const FileName: String;

      StripPartNbr, Compat: Boolean): String;

    function DoFileWrite(const Buffer; Len: Integer): Integer;

    function FileDate: Cardinal;

    procedure File_Close;

    procedure File_Close_F;

    function File_Create(const theName: String): Boolean;

    function File_CreateTemp(const Prefix, Where: String): Boolean;

    function File_Open(Mode: Cardinal): Boolean;

    function File_Rename(const NewName: string; const Safe: Boolean = false)

      : Boolean;

    function FinishWrite: Integer;

    procedure GetNewDisk(DiskSeq: Integer; AllowEmpty: Boolean);

    function LastWriteTime(var last_write: TFileTime): Boolean;

    function MapNumbering(Opts: TZMSpanOpts): TZMSpanOpts;

    procedure ProgReport(prog: TActionCodes; xprog: Integer; const Name: String;

        size: Int64);

    function Read(var Buffer; Len: Integer): Integer;

    function ReadFromFile(var Buffer; Len: Integer): Integer;

    function Reads(var Buffer; const Lens: array of Integer): Integer;

    function Reads_F(var Buffer; const Lens: array of Integer): Integer;

    function ReadTo(strm: TStream; Count: Integer): Integer;

    function Read_F(var Buffer; Len: Integer): Integer;

    function SaveFileInformation: Boolean;

    function Seek(offset: Int64; from: Integer): Int64;

    function SeekDisk(Nr: Integer): Integer;

    function SetEndOfFile: Boolean;

    function VerifyFileInformation: Boolean;

    function WBuffer(size: Integer): pByte;

    function Write(const Buffer; Len: Integer): Integer;

    function WriteFrom(strm: TStream; Count: Integer): Int64;

    function Writes(const Buffer; const Lens: array of Integer): Integer;

    function Writes_F(const Buffer; const Lens: array of Integer): Integer;

    function WriteToFile(const Buffer; Len: Integer): Integer;

    function Write_F(const Buffer; Len: Integer): Integer;

    property Boss: TZMCore read FBoss write SetBoss;

    property BytesRead: Int64 read fBytesRead write fBytesRead;

    property BytesWritten: Int64 read fBytesWritten write fBytesWritten;

    property ConfirmErase: Boolean read GetConfirmErase write fConfirmErase;

    property DiskNr: Integer read fDiskNr write fDiskNr;

    property Exists: Boolean read GetExists;

    property FileName: String read fFileName write SetFileName;

    property File_Size: Int64 read fFile_Size write fFile_Size;

    property Handle: Integer read fHandle write SetHandle;

    property info: Cardinal read fInfo write fInfo;

    property IsMultiPart: Boolean read fIsMultiPart write fIsMultiPart;

    property IsOpen: Boolean read fIsOpen;

    property IsTemp: Boolean read fIsTemp write fIsTemp;

    property KeepFreeOnAllDisks: Cardinal read GetKeepFreeOnAllDisks write

      SetKeepFreeOnAllDisks;

    property KeepFreeOnDisk1: Cardinal read GetKeepFreeOnDisk1 write

      SetKeepFreeOnDisk1;

    property LastWritten: Cardinal read GetLastWritten;

    property MaxVolumeSize: Int64 read GetMaxVolumeSize write SetMaxVolumeSize;

    property MinFreeVolumeSize: Cardinal read GetMinFreeVolumeSize write

      SetMinFreeVolumeSize;

    property NewDisk: Boolean Read FNewDisk Write FNewDisk;

    property Numbering: TZipNumberScheme Read FNumbering Write FNumbering;

    property Position: Int64 read GetPosition write SetPosition;

    property RealFileName: String read fRealFileName;

    property RealFileSize: Int64 read fRealFileSize write fRealFileSize;

    property ReqFileName: String Read FReqFileName Write FReqFileName;

    property ShowProgress

      : TZipShowProgress read fShowProgress write fShowProgress;

    property Sig: TZipFileSigs read fSig write fSig;

    property SpanOptions: TZMSpanOpts read GetSpanOptions write SetSpanOptions;

    // if non-zero set fileDate

    property StampDate: Cardinal read fStampDate write fStampDate;

    property TotalDisks: Integer read fTotalDisks write fTotalDisks;

    property WorkDrive: TZMWorkDrive read fWorkDrive write SetWorkDrive;

    property Worker: TZMCore read fWorker write fWorker;

  end;

 

  zfi_Dirty: Cardinal = 4;

  zfi_MakeMask: Cardinal = $07;

  zfi_Error: Cardinal = 8;

  zfi_Loading: cardinal = $40;

  zfi_Cancelled: cardinal = $80;    // loading was cancelled

 

function FileTimeToLocalDOSTime(const ft: TFileTime): Cardinal;

 

 

  Forms, Controls, Dialogs, ZMMsgStr19, ZMCtx19, ZMCompat19, ZMDlg19,

  ZMStructs19, ZMUtils19, ZMMsg19, ZMXcpt19;

 {$WARN SYMBOL_DEPRECATED OFF}

 

  MAX_PARTS = 999;

  MaxDiskBufferSize = (4 * 1024 * 1024); // floppies only

 

  SZipSet = 'ZipSet_';

  SPKBACK = 'PKBACK#';

 

  (* ? FormatFloppy

function FormatFloppy(WND: HWND; const Drive: String): Integer;

  SHFMT_ID_DEFAULT = $FFFF;

  { options }

  SHFMT_OPT_FULL = $0001;

  // SHFMT_OPT_SYSONLY = $0002;

  { return values }

  // SHFMT_ERROR = $FFFFFFFF;

  // -1 Error on last format, drive may be formatable

  // SHFMT_CANCEL = $FFFFFFFE;    // -2 last format cancelled

  // SHFMT_NOFORMAT = $FFFFFFFD;    // -3 drive is not formatable

  TSHFormatDrive = function(WND: HWND; Drive, fmtID, Options: DWORD): DWORD;

    stdcall;

  SHFormatDrive: TSHFormatDrive;

  drv: Integer;

  hLib: THandle;

  OldErrMode: Integer;

  Result := -3; // error

  if not((Length(Drive) > 1) and (Drive[2] = ':') and CharInSet

      (Drive[1], ['A' .. 'Z', 'a' .. 'z'])) then

    exit;

  if GetDriveType(PChar(Drive)) <> DRIVE_REMOVABLE then

    exit;

  drv := Ord(Upcase(Drive[1])) - Ord('A');

  OldErrMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOGPFAULTERRORBOX);

  hLib := LoadLibrary('Shell32');

  if hLib <> 0 then

  begin

    @SHFormatDrive := GetProcAddress(hLib, 'SHFormatDrive');

    if @SHFormatDrive <> nil then

      try

        Result := SHFormatDrive(WND, drv, SHFMT_ID_DEFAULT, SHFMT_OPT_FULL);

      finally

        FreeLibrary(hLib);

      end;

    SetErrorMode(OldErrMode);

  end;

 

function FileTimeToLocalDOSTime(const ft: TFileTime): Cardinal;

  lf: TFileTime;

  wd: Word;

  wt: Word;

  Result := 0;

  if FileTimeToLocalFileTime(ft, lf) and FileTimeToDosDateTime(lf, wd, wt) then

    Result := (wd shl 16) or wt;

 

 

constructor TZMWorkFile.Create(wrkr: TZMCore);

  inherited Create;

  fWorker := wrkr;

  fBoss := wrkr;

 

procedure TZMWorkFile.AfterConstruction;

  inherited;

  fDiskBuffer := nil;

  fBufferPosition := -1;

  fInfo := 0;

  fHandle := -1;

  fIsMultiPart := false;

  fBytesWritten := 0;

  fBytesRead := 0;

  fOpenMode := 0;

  fNumbering := znsNone;

  fWorkDrive := TZMWorkDrive.Create;

  ClearFileInformation;

 

function TZMWorkFile.AskAnotherDisk(const DiskFile: String): Integer;

  MsgQ: String;

  tmpStatusDisk: TZMStatusDiskEvent;

  MsgQ := Boss.ZipLoadStr(DS_AnotherDisk);

  FZipDiskStatus := FZipDiskStatus + [zdsSameFileName];

  tmpStatusDisk := worker.Master.OnStatusDisk;

  if Assigned(tmpStatusDisk) and not(zaaYesOvrwrt in Worker.AnswerAll) then

  begin

    FZipDiskAction := zdaOk; // The default action

    tmpStatusDisk(Boss.Master, 0, DiskFile, FZipDiskStatus, FZipDiskAction);

    case FZipDiskAction of

      zdaCancel:

        Result := idCancel;

      zdaReject:

        Result := idNo;

      zdaErase:

        Result := idOk;

      zdaYesToAll:

        begin

          Result := idOk;

        end;

      zdaOk:

        Result := idOk;

    else

      Result := idOk;

    end;

  end

  else

    Result := Boss.ZipMessageDlgEx(Boss.ZipLoadStr(FM_Confirm), MsgQ,

      zmtWarning + DHC_SpanOvr, [mbOk, mbCancel]);

 

function TZMWorkFile.AskOverwriteSegment(const DiskFile: String; DiskSeq:

    Integer): Integer;

  MsgQ: String;

  tmpStatusDisk: TZMStatusDiskEvent;

  // Do we want to overwrite an existing file?

  if FileExists(DiskFile) then

    if (File_Age(DiskFile) = StampDate) and (Pred(DiskSeq) < DiskNr)

      then

    begin

      MsgQ := Boss.ZipFmtLoadStr(DS_AskPrevFile, [DiskSeq]);

      FZipDiskStatus := FZipDiskStatus + [zdsPreviousDisk];

    end

    else

    begin

      MsgQ := Boss.ZipFmtLoadStr(DS_AskDeleteFile, [DiskFile]);

      FZipDiskStatus := FZipDiskStatus + [zdsSameFileName];

    end

    else if not WorkDrive.DriveIsFixed then

      if (WorkDrive.VolumeSize <> WorkDrive.VolumeSpace) then

        FZipDiskStatus := FZipDiskStatus + [zdsHasFiles]

        // But not the same name

      else

        FZipDiskStatus := FZipDiskStatus + [zdsEmpty];

  tmpStatusDisk := worker.Master.OnStatusDisk;

  if Assigned(tmpStatusDisk) and not(zaaYesOvrwrt in Worker.AnswerAll) then

  begin

    FZipDiskAction := zdaOk; // The default action

    tmpStatusDisk(Boss.Master, DiskSeq, DiskFile, FZipDiskStatus,

      FZipDiskAction);

    case FZipDiskAction of

      zdaCancel:

        Result := idCancel;

      zdaReject:

        Result := idNo;

      zdaErase:

        Result := idOk;

      zdaYesToAll:

        begin

          Result := idOk;

          Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt];

        end;

      zdaOk:

        Result := idOk;

    else

      Result := idOk;

    end;

  end

  else if ((FZipDiskStatus * [zdsPreviousDisk, zdsSameFileName]) <> []) and not

    ((zaaYesOvrwrt in Worker.AnswerAll) or Worker.Unattended) then

  begin

    Result := Boss.ZipMessageDlgEx(Boss.ZipLoadStr(FM_Confirm), MsgQ,

      zmtWarning + DHC_SpanOvr, [mbYes, mbNo, mbCancel, mbYesToAll]);

    if Result = mrYesToAll then

    begin

      Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt];

      Result := idOk;

    end;

  end

  else

    Result := idOk;

 

procedure TZMWorkFile.AssignFrom(Src: TZMWorkFile);

  if (Src <> Self) and (Src <> nil) then

  begin

    fDiskBuffer := nil;

    fBufferPosition := -1;

    Move(Src.fSavedFileInfo, fSavedFileInfo, SizeOf(fSavedFileInfo));

    fAllowedSize := Src.fAllowedSize;

    fBytesRead := Src.fBytesRead;

    fBytesWritten := Src.fBytesWritten;

    fDiskNr := Src.fDiskNr;

    fFile_Size := Src.fFile_Size;

    fFileName := Src.fFileName;

    fHandle := -1;  // don't acquire handle

    fInfo := Src.fInfo;

    fIsOpen := False;

    fIsTemp := Src.fIsTemp;

    fLastWrite := Src.fLastWrite;

    fNumbering := Src.fNumbering;

    fOpenMode := Src.fOpenMode;

    fRealFileName := Src.fRealFileName;

    fReqFileName := Src.FReqFileName;

    fShowProgress := Src.fShowProgress;

    fSig := Src.fSig;

    fStampDate := Src.fStampDate;

    fTotalDisks := Src.fTotalDisks;

    fWorkDrive.AssignFrom(Src.WorkDrive);

    FZipDiskAction := Src.FZipDiskAction;

    FZipDiskStatus := Src.FZipDiskStatus;

  end;

 

procedure TZMWorkFile.BeforeDestruction;

  File_Close;

  if IsTemp and FileExists(fRealFileName) then

  begin

    if Boss.Verbosity >= zvTrace then

      Diag('Trace: Deleting ' + fRealFileName);

    SysUtils.DeleteFile(fFileName);

  end;

  FreeAndNil(fWorkDrive);

  fDiskBuffer := nil; // ++ discard contents

  WBuf := nil;

  inherited;

 

function TZMWorkFile.ChangeNumberedName(const FName: String; NewNbr: Cardinal;

    Remove: boolean): string;

  ext: string;

  StripLen: Integer;

  if DiskNr > 999 then

    raise EZipMaster.CreateResDisp(DS_TooManyParts, True);

  ext := ExtractFileExt(FName);

  StripLen := 0;

  if Remove then

    StripLen := 3;

  Result := Copy(FName, 1, Length(FName) - Length(ext) - StripLen)

    + Copy(IntToStr(1000 + NewNbr), 2, 3) + ext;

 

procedure TZMWorkFile.CheckForDisk(writing, UnformOk: Boolean);

  OnGetNextDisktmp: TZMGetNextDiskEvent;

  AbortAction: Boolean;

  MsgFlag: Integer;

  MsgStr: String;

  Res: Integer;

  SizeOfDisk: Int64;

  totDisks: Integer;

  if TotalDisks <> 1 then // check

    IsMultiPart := True;

  if WorkDrive.DriveIsFixed then

  begin

    // If it is a fixed disk we don't want a new one.

    NewDisk := false;

    Boss.CheckCancel;

    exit;

  end;

  Boss.KeepAlive;       // just ProcessMessages

  // First check if we want a new one or if there is a disk (still) present.

  while (NewDisk or (not WorkDrive.HasMedia(UnformOk))) do

  begin

    if Boss.Unattended then

      raise EZipMaster.CreateResDisp(DS_NoUnattSpan, True);

 

    MsgFlag := zmtWarning + DHC_SpanNxtW; // or error?

    if DiskNr < 0 then // want last disk

    begin

      MsgStr := Boss.ZipLoadStr(DS_InsertDisk);

      MsgFlag := zmtError + DHC_SpanNxtR;

    end

    else if writing then

    begin

      // This is an estimate, we can't know if every future disk has the same space available and

      // if there is no disk present we can't determine the size unless it's set by MaxVolumeSize.

      SizeOfDisk := WorkDrive.VolumeSize - KeepFreeOnAllDisks;

      if (MaxVolumeSize <> 0) and (MaxVolumeSize < WorkDrive.VolumeSize) then

        SizeOfDisk := MaxVolumeSize;

 

      TotalDisks := DiskNr + 1;

      if TotalDisks > MAX_PARTS then

        raise EZipMaster.CreateResDisp(DS_TooManyParts, True);

      if SizeOfDisk > 0 then

      begin

        totDisks := Trunc((File_Size + 4 + KeepFreeOnDisk1) / SizeOfDisk);

        if TotalDisks < totDisks then

          TotalDisks := totDisks;

        MsgStr := Boss.ZipFmtLoadStr

          (DS_InsertVolume, [DiskNr + 1, TotalDisks]);

      end

      else

        MsgStr := Boss.ZipFmtLoadStr(DS_InsertAVolume, [DiskNr + 1]);

    end

    else

    begin // reading - want specific disk

      if TotalDisks = 0 then

        MsgStr := Boss.ZipFmtLoadStr(DS_InsertAVolume, [DiskNr + 1])

      else

        MsgStr := Boss.ZipFmtLoadStr(DS_InsertVolume, [DiskNr + 1, TotalDisks]);

    end;

 

    MsgStr := MsgStr + Boss.ZipFmtLoadStr(DS_InDrive, [WorkDrive.DriveStr]);

    OnGetNextDisktmp := Worker.Master.OnGetNextDisk;

    if Assigned(OnGetNextDisktmp) then

    begin

      AbortAction := false;

      OnGetNextDisktmp(Boss.Master, DiskNr + 1, TotalDisks, Copy

          (WorkDrive.DriveStr, 1, 1), AbortAction);

      if AbortAction then

        Res := idAbort

      else

        Res := idOk;

    end

    else

      Res := Boss.ZipMessageDlgEx('', MsgStr, MsgFlag, mbOkCancel);

 

    // Check if user pressed Cancel or memory is running out.

    if Res = 0 then

      raise EZipMaster.CreateResDisp(DS_NoMem, True);

    if Res <> idOk then

    begin

      Boss.Cancel := GE_Abort;

      info := info or zfi_Cancelled;

      raise EZipMaster.CreateResDisp(DS_Canceled, false);

    end;

    NewDisk := false;

    Boss.KeepAlive;

  end;

 

function TZMWorkFile.CheckRead(var Buffer; Len: Integer): Boolean;

  if Len < 0 then

    Len := -Len;

  Result := Read(Buffer, Len) = Len;

 

procedure TZMWorkFile.CheckRead(var Buffer; Len, ErrId: Integer);

  if Len < 0 then

    Len := -Len;

  if not CheckRead(Buffer, Len) then

  begin

    if ErrId = 0 then

      ErrId := DS_ReadError;

    raise EZipMaster.CreateResDisp(ErrId, True);

  end;

 

function TZMWorkFile.CheckReads(var Buffer; const Lens: array of Integer)

  : Boolean;

  c: Integer;

  i: Integer;

  c := 0;

  for i := Low(Lens) to High(Lens) do

    c := c + Lens[i];

  Result := Reads(Buffer, Lens) = c;

 

procedure TZMWorkFile.CheckReads(var Buffer; const Lens: array of Integer;

  ErrId: Integer);

  if not CheckReads(Buffer, Lens) then

  begin

    if ErrId = 0 then

      ErrId := DS_ReadError;

    raise EZipMaster.CreateResDisp(ErrId, True);

  end;

 

function TZMWorkFile.CheckSeek(offset: Int64; from, ErrId: Integer): Int64;

  Result := Seek(offset, from);

  if Result < 0 then

  begin

    if ErrId = 0 then

      raise EZipMaster.CreateResDisp(DS_SeekError, True);

    if ErrId = -1 then

      ErrId := DS_FailedSeek;

    raise EZipMaster.CreateResDisp(ErrId, True);

  end;

 

function TZMWorkFile.CheckWrite(const Buffer; Len: Integer): Boolean;

  if Len < 0 then

    Len := -Len;

  Result := Write(Buffer, Len) = Len;

 

procedure TZMWorkFile.CheckWrite(const Buffer; Len, ErrId: Integer);

  if not CheckWrite(Buffer, Len) then

  begin

    if ErrId = 0 then

      ErrId := DS_WriteError;

    raise EZipMaster.CreateResDisp(ErrId, True);

  end;

 

function TZMWorkFile.CheckWrites(const Buffer; const Lens: array of Integer)

  : Boolean;

  c: Integer;

  i: Integer;

  c := 0;

  for i := Low(Lens) to High(Lens) do

    c := c + Lens[i];

  Result := Writes(Buffer, Lens) = c;

 

procedure TZMWorkFile.CheckWrites(const Buffer; const Lens: array of Integer;

  ErrId: Integer);

  if not CheckWrites(Buffer, Lens) then

  begin

    if ErrId = 0 then

      ErrId := DS_WriteError;

    raise EZipMaster.CreateResDisp(ErrId, True);

  end;

 

procedure TZMWorkFile.ClearFileInformation;

  ZeroMemory(@fSavedFileInfo, sizeof(_BY_HANDLE_FILE_INFORMATION));

 

procedure TZMWorkFile.ClearFloppy(const dir: String);

  Fname: String;

  SRec: TSearchRec;

  if FindFirst(dir + WILD_ALL, faAnyFile, SRec) = 0 then

    repeat

      Fname := dir + SRec.Name;

      if ((SRec.Attr and faDirectory) <> 0) and (SRec.Name <> DIR_THIS) and

        (SRec.Name <> DIR_PARENT) then

      begin

        Fname := Fname + PathDelim;

        ClearFloppy(Fname);

        if Boss.Verbosity >= zvTrace then

          Boss.ReportMsg(TM_Erasing, [Fname])

        else

          Boss.KeepAlive;

        // allow time for OS to delete last file

        RemoveDir(Fname);

      end

      else

      begin

        if Boss.Verbosity >= zvTrace then

          Boss.ReportMsg(TM_Deleting, [Fname])

        else

          Boss.KeepAlive;

        SysUtils.DeleteFile(Fname);

      end;

    until FindNext(SRec) <> 0;

    SysUtils.FindClose(SRec);

 

function TZMWorkFile.CopyFrom(Source: TZMWorkFile; Len: Int64): Int64;

  BufSize: Cardinal;

  SizeR: Integer;

  ToRead: Integer;

  wb: pByte;

  BufSize := 10 * 1024; // constant is somewhere

  wb := WBuffer(BufSize);

  Result := 0;

 

  while Len > 0 do

  begin

    ToRead := BufSize;

    if Len < BufSize then

      ToRead := Len;

    SizeR := Source.Read(wb^, ToRead);

    if SizeR <> ToRead then

    begin

      if SizeR < 0 then

        Result := SizeR

      else

        Result := -DS_ReadError;

      exit;

    end;

    if SizeR > 0 then

    begin

      ToRead := Write(wb^, SizeR);

      if SizeR <> ToRead then

      begin

        if ToRead < 0 then

          Result := ToRead

        else

          Result := -DS_WriteError;

        exit;

      end;

      Len := Len - SizeR;

      Result := Result + SizeR;

      ProgReport(zacProgress, PR_Copying, Source.FileName, SizeR);

    end;

  end;

 

function TZMWorkFile.Copy_File(Source: TZMWorkFile): Integer;

  fsize: Int64;

  r: Int64;

  try

    if not Source.IsOpen then

      Source.File_Open(fmOpenRead);

    Result := 0;

    fsize := Source.Seek(0, 2);

    Source.Seek(0, 0);

    ProgReport(zacXItem, PR_Copying, Source.FileName, fsize);

    r := self.CopyFrom(Source, fsize);

    if r < 0 then

      Result := Integer(r);

  except

    Result := -9; // general error

  end;

 

function TZMWorkFile.CreateMVFileNameEx(const FileName: String;

  StripPartNbr, Compat: Boolean): String;

  ext: String;

begin // changes FileName into multi volume FileName

  if Compat then

  begin

    if DiskNr <> (TotalDisks - 1) then

    begin

      if DiskNr < 9 then

        ext := '.z0'

      else

        ext := '.z';

      ext := ext + IntToStr(succ(DiskNr));

    end

    else

      ext := EXT_ZIP;

    Result := ChangeFileExt(FileName, ext);

  end

  else

    Result := ChangeNumberedName(FileName, DiskNr + 1, StripPartNbr);

 

procedure TZMWorkFile.Diag(const msg: String);

  if Boss.Verbosity >= zvTrace then

    Boss.ReportMessage(0, msg);

 

function TZMWorkFile.DoFileWrite(const Buffer; Len: Integer): Integer;

  Result := FileWrite(fHandle, Buffer, Len);

 

function TZMWorkFile.EOS: Boolean;

  Result := FileSeek64(Handle, 0, soFromCurrent) = FileSeek64

    (Handle, 0, soFromEnd);

 

function TZMWorkFile.FileDate: Cardinal;

  Result := FileGetDate(fHandle);

 

procedure TZMWorkFile.File_Close;

  if fDiskBuffer <> nil then

    FlushDiskBuffer;

  File_Close_F;

 

procedure TZMWorkFile.File_Close_F;

  th: Integer;

  if fHandle <> -1 then

  begin

    th := fHandle;

    fHandle := -1;

    // if open for writing set date

    if (StampDate <> 0) and

       ((OpenMode and (SysUtils.fmOpenReadWrite or SysUtils.fmOpenWrite)) <> 0) then

    begin

      FileSetDate(th, StampDate);

      if Boss.Verbosity >= zvTrace then

        Diag('Trace: Set file Date ' + fRealFileName + ' to ' + DateTimeToStr

            (FileDateToLocalDateTime(StampDate)));

    end;

    FileClose(th);

    if Boss.Verbosity >= zvTrace then

      Diag('Trace: Closed ' + fRealFileName);

  end;

  fIsOpen := false;

 

function TZMWorkFile.File_Create(const theName: String): Boolean;

  n: String;

  File_Close;

  Result := false;

  if theName <> '' then

  begin

    if FileName = '' then

      FileName := theName;

    n := theName;

  end

  else

    n := FileName;

  if n = '' then

    exit;

  if Boss.Verbosity >= zvTrace then

    Diag('Trace: Creating ' + n);

  fRealFileName := n;

  fHandle := FileCreate(n);

  if fHandle <> -1 then

    TZMCore(Worker).AddCleanupFile(n);

  fBytesWritten := 0;

  fBytesRead := 0;

  Result := fHandle <> -1;

  fIsOpen := Result;

  fOpenMode := SysUtils.fmOpenWrite;

 

function TZMWorkFile.File_CreateTemp(const Prefix, Where: String): Boolean;

  Buf: String;

  Len: DWORD;

  tmpDir: String;

  Result := false;

  if Length(Boss.TempDir) = 0 then

  begin

    if Length(Where) <> 0 then

    begin

      tmpDir := ExtractFilePath(Where);

      tmpDir := ExpandFileName(tmpDir);

    end;

    if Length(tmpDir) = 0 then // Get the system temp dir

    begin

      // 1. The path specified by the TMP environment variable.

      // 2. The path specified by the TEMP environment variable, if TMP is not defined.

      // 3. The current directory, if both TMP and TEMP are not defined.

      Len := GetTempPath(0, PChar(tmpDir));

      SetLength(tmpDir, Len);

      GetTempPath(Len, PChar(tmpDir));

    end;

  end

  else // Use Temp dir provided by ZipMaster

  begin

    tmpDir := Boss.TempDir;

  end;

  tmpDir := DelimitPath(tmpDir, True);

  SetLength(Buf, MAX_PATH + 12);

  if GetTempFileName(PChar(tmpDir), PChar(Prefix), 0, PChar(Buf)) <> 0 then

  begin

    FileName := PChar(Buf);

    IsTemp := True; // delete when finished

    if Boss.Verbosity >= zvTrace then

      Diag('Trace: Created temporary ' + FileName);

    fRealFileName := FileName;

    fBytesWritten := 0;

    fBytesRead := 0;

    fOpenMode := SysUtils.fmOpenWrite;

    Result := File_Open(fmOpenWrite);

  end;

 

function TZMWorkFile.File_Open(Mode: Cardinal): Boolean;

  File_Close;

  if Boss.Verbosity >= zvTrace then

    Diag('Trace: Opening ' + fFileName);

  fRealFileName := fFileName;

  fHandle := FileOpen(fFileName, Mode);

  Result := fHandle <> -1;

  fIsOpen := Result;

  fOpenMode := Mode;

 

function TZMWorkFile.File_Rename(const NewName: string;

  const Safe: Boolean = false): Boolean;

  if Boss.Verbosity >= zvTrace then

    Diag('Trace: Rename ' + RealFileName + ' to ' + NewName);

  IsTemp := false;

  if IsOpen then

    File_Close;

  if FileExists(FileName) then

  begin

    if FileExists(NewName) then

    begin

      if Boss.Verbosity >= zvTrace then

        Diag('Trace: Erasing ' + NewName);

      if (EraseFile(NewName, not Safe) <> 0) and (Boss.Verbosity >= zvTrace)

        then

        Diag('Trace: Erase failed ' + NewName);

    end;

  end;

  Result := RenameFile(FileName, NewName);

  if Result then

  begin

    fFileName := NewName;  // success

    fRealFileName := NewName;

  end;

 

function TZMWorkFile.FinishWrite: Integer;

  fn: String;

  LastName: String;

  MsgStr: String;

  Res: Integer;

  OnStatusDisk: TZMStatusDiskEvent;

  // change extn of last file

  LastName := RealFileName;

  File_Close;

  Result := 0;

 

  if IsMultiPart then

  begin

    if ((Numbering = znsExt) and not AnsiSameText(ExtractFileExt(LastName), EXT_ZIP)) or

      ((Numbering = znsName) and (DiskNr = 0)) then

    begin

      Result := -1;

      fn := FileName;

      if (FileExists(fn)) then

      begin

        MsgStr := Boss.ZipFmtLoadStr(DS_AskDeleteFile, [fn]);

        FZipDiskStatus := FZipDiskStatus + [zdsSameFileName];

        Res := idYes;

        if not(zaaYesOvrwrt in Worker.AnswerAll) then

        begin

          OnStatusDisk := Worker.Master.OnStatusDisk;

          if Assigned(OnStatusDisk) then // 1.77

          begin

            FZipDiskAction := zdaOk; // The default action

            OnStatusDisk(Boss.Master, DiskNr, fn, FZipDiskStatus,

              FZipDiskAction);

            if FZipDiskAction = zdaYesToAll then

            begin

              Worker.AnswerAll := Worker.AnswerAll + [zaaYesOvrwrt];

              FZipDiskAction := zdaOk;

            end;

            if FZipDiskAction = zdaOk then

              Res := idYes

            else

              Res := idNo;

          end

          else

            Res := Boss.ZipMessageDlgEx(MsgStr, Boss.ZipLoadStr(FM_Confirm)

                , zmtWarning + DHC_WrtSpnDel, [mbYes, mbNo]);

        end;

        if (Res = 0) then

          Boss.ShowZipMessage(DS_NoMem, '');

        if (Res = idNo) then

          Boss.ReportMsg(DS_NoRenamePart, [LastName]);

        if (Res = idYes) then

          SysUtils.DeleteFile(fn); // if it exists delete old one

      end;

      if FileExists(LastName) then // should be there but ...

      begin

        RenameFile(LastName, fn);

        Result := 0;

        if Boss.Verbosity >= zvVerbose then

          Boss.Diag(Format('renamed %s to %s', [LastName, fn]));

      end;

    end;

  end;

 

procedure TZMWorkFile.FlushDiskBuffer;

  did: Integer;

  Len: Integer;

  Len := fBufferPosition;

  fBufferPosition := -1; // stop retrying on error

  if fDiskBuffer <> nil then

  begin

    Boss.KeepAlive;

    Boss.CheckCancel;

    if Len > 0 then

    begin

      repeat

        did := DoFileWrite(fDiskBuffer[0], Len);

        if did <> Len then

        begin

          NewFlushDisk; // abort or try again on new disk

        end;

      until (did = Len);

    end;

    fDiskBuffer := nil;

  end;

 

function TZMWorkFile.GetConfirmErase: Boolean;

  Result := Worker.ConfirmErase;

 

function TZMWorkFile.GetExists: Boolean;

  Result := false;

  if FileExists(FileName) then

    Result := True;

 

function TZMWorkFile.GetFileInformation(var FileInfo:

    _BY_HANDLE_FILE_INFORMATION): Boolean;

  Result := IsOpen;

  if Result then

    Result := GetFileInformationByHandle(Handle, FileInfo);

  if not Result then

    ZeroMemory(@FileInfo, sizeof(_BY_HANDLE_FILE_INFORMATION));

 

function TZMWorkFile.GetKeepFreeOnAllDisks: Cardinal;

  Result := Worker.KeepFreeOnAllDisks;

 

function TZMWorkFile.GetKeepFreeOnDisk1: Cardinal;

  Result := Worker.KeepFreeOnDisk1;

 

function TZMWorkFile.GetLastWritten: Cardinal;

  ft: TFileTime;

  Result := 0;

  if IsOpen and LastWriteTime(ft) then

    Result := FileTimeToLocalDOSTime(ft);

 

function TZMWorkFile.GetMaxVolumeSize: Int64;

  Result := Worker.MaxVolumeSize;

 

function TZMWorkFile.GetMinFreeVolumeSize: Cardinal;

  Result := Worker.MinFreeVolumeSize;

 

procedure TZMWorkFile.GetNewDisk(DiskSeq: Integer; AllowEmpty: Boolean);

  File_Close;

  // Close the file on the old disk first.

  if (TotalDisks <> 1) or (DiskSeq <> 0) then

    IsMultiPart := True;

  DiskNr := DiskSeq;

  while True do

  begin

    repeat

      NewDisk := True;

      File_Close;

      CheckForDisk(false, spTryFormat in SpanOptions);

      if AllowEmpty and WorkDrive.HasMedia(spTryFormat in SpanOptions) then

      begin

        if WorkDrive.VolumeSpace = -1 then

          exit; // unformatted

        if WorkDrive.VolumeSpace = WorkDrive.VolumeSize then

          exit; // empty

      end;

    until IsRightDisk;

 

    if Boss.Verbosity >= zvVerbose then

      Boss.Diag(Boss.ZipFmtLoadStr(TM_GetNewDisk, [FileName]));

    if File_Open(fmShareDenyWrite or fmOpenRead) then

      break; // found

    if WorkDrive.DriveIsFixed then

      raise EZipMaster.CreateResDisp(DS_NoInFile, True)

    else

      Boss.ShowZipMessage(DS_NoInFile, '');

  end;

 

function TZMWorkFile.GetPosition: Int64;

  if fDiskBuffer <> nil then

    Result := fBufferPosition

  else

    Result := GetPosition_F;

 

function TZMWorkFile.GetPosition_F: Int64;

  Result := FileSeek64(fHandle, 0, soFromCurrent); // from current

 

function TZMWorkFile.GetSpanOptions: TZMSpanOpts;

  Result := Worker.SpanOptions;

 

function TZMWorkFile.HasSpanSig(const FName: String): boolean;

  fs: TFileStream;

  Sg: Cardinal;

  Result := False;

  if FileExists(FName) then

  begin

    fs := TFileStream.Create(FName, fmOpenRead);

    try

      if (fs.Size > (sizeof(TZipLocalHeader) + sizeof(Sg))) and

        (fs.Read(Sg, sizeof(Sg)) = sizeof(Sg)) then

        Result :=  (Sg = ExtLocalSig) and (fs.Read(Sg, sizeof(Sg)) = sizeof(Sg)) and

          (Sg = LocalFileHeaderSig);

    finally

      fs.Free;

    end;

  end;

 

function TZMWorkFile.IsRightDisk: Boolean;

  fn: String;

  VName: string;

  Result := True;

  if (Numbering < znsName) and (not WorkDrive.DriveIsFixed) then

  begin

    VName := WorkDrive.DiskName;

    Boss.Diag('Checking disk ' + VName + ' need ' + VolName(DiskNr));

    if (AnsiSameText(VName, VolName(DiskNr)) or AnsiSameText(VName, OldVolName(DiskNr))) and

        FileExists(FileName) then

    begin

      Numbering := znsVolume;

      Boss.Diag('found volume ' + VName);

      exit;

    end;

  end;

  fn := FileName;

  if Numbering = znsNone then // not known yet

  begin

    FileName := CreateMVFileNameEx(FileName, True, True);

    // make compat name

    if FileExists(FileName) then

    begin

      Numbering := znsExt;

      exit;

    end;

    FileName := fn;

    FileName := CreateMVFileNameEx(FileName, True, false);

    // make numbered name

    if FileExists(FileName) then

    begin

      Numbering := znsName;

      exit;

    end;

    if WorkDrive.DriveIsFixed then

      exit; // always true - only needed name

    FileName := fn; // restore

    Result := false;

    exit;

  end;

  // numbering scheme already known

  if Numbering = znsVolume then

  begin

    Result := false;

    exit;

  end;

  FileName := CreateMVFileNameEx(FileName, True, Numbering = znsExt);

  // fixed drive always true only needed new filename

  if (not WorkDrive.DriveIsFixed) and (not FileExists(FileName)) then

  begin

    FileName := fn; // restore

    Result := false;

  end;

 

function TZMWorkFile.LastWriteTime(var last_write: TFileTime): Boolean;

  BHFInfo: TByHandleFileInformation;

  Result := false;

  last_write.dwLowDateTime := 0;

  last_write.dwHighDateTime := 0;

  if IsOpen then

  begin

    Result := GetFileInformationByHandle(fHandle, BHFInfo);

    if Result then

      last_write := BHFInfo.ftLastWriteTime;

  end;

 

function TZMWorkFile.MapNumbering(Opts: TZMSpanOpts): TZMSpanOpts;

  spans: TZMSpanOpts;

  Result := Opts;

  if Numbering <> znsNone then

  begin

    // map numbering type only if known

    spans := Opts - [spCompatName] + [spNoVolumeName];

    case Numbering of

      znsVolume:

        spans := spans - [spNoVolumeName];

      znsExt:

        spans := spans + [spCompatName];

    end;

    Result := spans;

  end;

 

procedure TZMWorkFile.NewFlushDisk;

  // need to allow another disk, check size, open file, name disk etc

  raise EZipMaster.CreateResDisp(DS_WriteError, True);

 

function TZMWorkFile.NewSegment: Boolean; // true to 'continue'

  DiskFile: String;

  DiskSeq: Integer;

  MsgQ: String;

  Res: Integer;

  SegName: String;

  OnGetNextDisk: TZMGetNextDiskEvent;

  OnStatusDisk: TZMStatusDiskEvent;

  Result := false;

  // If we write on a fixed disk the filename must change.

  // We will get something like: FileNamexxx.zip where xxx is 001,002 etc.

  // if CompatNames are used we get FileName.zxx where xx is 01, 02 etc.. last .zip

  if Numbering = znsNone then

  begin

    if spCompatName in SpanOptions then

      Numbering := znsExt

    else if WorkDrive.DriveIsFixed or (spNoVolumeName in SpanOptions) then

      Numbering := znsName

    else

      Numbering := znsVolume;

  end;

  DiskFile := FileName;

  if Numbering <> znsVolume then

    DiskFile := CreateMVFileNameEx(DiskFile, false, Numbering = znsExt);

  CheckForDisk(True, spWipeFiles in SpanOptions);

 

  OnGetNextDisk := Worker.Master.OnGetNextDisk;

  // Allow clearing of removeable media even if no volume names

  if (not WorkDrive.DriveIsFixed) and (spWipeFiles in SpanOptions) and

    ((FZipDiskAction = zdaErase) or not Assigned(OnGetNextDisk)) then

  begin

    // Do we want a format first?

    if Numbering = znsVolume then

      SegName := VolName(DiskNr)

      // default name

    else

      SegName := SZipSet + IntToStr(succ(DiskNr));

    // Ok=6 NoFormat=-3, Cancel=-2, Error=-1

    case ZipFormat(SegName) of

      // Start formating and wait until BeforeClose...

      - 1:

        raise EZipMaster.CreateResDisp(DS_Canceled, True);

      -2:

        raise EZipMaster.CreateResDisp(DS_Canceled, false);

    end;

  end;

  if WorkDrive.DriveIsFixed or (Numbering <> znsVolume) then

    DiskSeq := DiskNr + 1