Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit ZMWAUX19;
  2.  
  3. (*
  4.   ZMWAUX19.pas - SFX and Span support
  5.   Derived from
  6.   * SFX for DelZip v1.7
  7.   * Copyright 2002-2005
  8.   * written by Markus Stephany
  9.     Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  10.       Eric W. Engler and Chris Vleghert.
  11.  
  12.         This file is part of TZipMaster Version 1.9.
  13.  
  14.     TZipMaster is free software: you can redistribute it and/or modify
  15.     it under the terms of the GNU Lesser General Public License as published by
  16.     the Free Software Foundation, either version 3 of the License, or
  17.     (at your option) any later version.
  18.  
  19.     TZipMaster is distributed in the hope that it will be useful,
  20.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  21.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22.     GNU Lesser General Public License for more details.
  23.  
  24.     You should have received a copy of the GNU Lesser General Public License
  25.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  26.  
  27.     contact: problems@delphizip.org (include ZipMaster in the subject).
  28.     updates: http://www.delphizip.org
  29.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  30.  
  31.   modified 2010-06-19
  32.   --------------------------------------------------------------------------- *)
  33. {$I '.\ZipVers19.inc'}
  34.  
  35. interface
  36.  
  37. uses
  38.   Windows, SysUtils, Classes, Graphics, ZipMstr19, ZMSFXInt19,
  39.   ZMStructs19, ZMCompat19, ZMZipFile19, ZMCore19, ZMCendir19;
  40.  
  41. type
  42.   TZMWAux = class(TZMCore)
  43.   private
  44.     Detached: Boolean;
  45.     FAuxChanged: Boolean;
  46.     fCentralDir: TZMCenDir;
  47.     FNoReadAux: Boolean;
  48.     fRegFailPath: String;
  49.     fSFXCaption: String;
  50.     fSFXCommandLine: String;
  51.     fSFXDefaultDir: String;
  52.     fSFXIcon: TIcon;
  53.     fSFXMessage: String;
  54.     fSFXMessageFlags: Word;
  55.     fSFXOptions: TZMSFXOpts;
  56.     fSFXOverwriteMode: TZMOvrOpts;
  57.     fSFXPath: String;
  58.     fSuccessCnt: Integer;
  59.     fUseDelphiBin: Boolean;
  60.     FZipComment: AnsiString;
  61.     fZipFileName: String;
  62.     OutSize: Integer;
  63.     function MapSFXSettings17(pheder: PByte; stub: TMemoryStream): Integer;
  64.     function MapSFXSettings19(pheder: PByte; stub: TMemoryStream): Integer;
  65.     function RecreateSingle(Intermed, theZip: TZMZipFile): Integer;
  66.     procedure SetSFXCommandLine(const Value: String);
  67.   protected
  68.     fSFXBinStream: TMemoryStream;
  69.     function BrowseResDir(ResStart, Dir: PIRD; Depth: Integer): PIRDatE;
  70.     function CreateStubStream: Boolean;
  71.   procedure EncodingChanged(New_Enc: TZMEncodingOpts); override;
  72.   procedure Encoding_CPChanged(New_CP: Cardinal); override;
  73.     function LoadFromBinFile(var stub: TStream; var Specified: Boolean)
  74.       : Integer;
  75.     function LoadFromResource(var stub: TStream; const sfxtyp: String): Integer;
  76.     function LoadSFXStr(ptbl: pByte; ident: Byte): String;
  77.     function MapOptionsFromStub(opts: Word): TZMSFXOpts;
  78.     function MapOptionsFrom17(opts: Word): TZMSFXOpts;
  79.     function MapOptionsToStub(opts: TZMSFXOpts): Word;
  80.     function MapOverwriteModeFromStub(ovr: Word): TZMOvrOpts;
  81.     function MapOverwriteModeToStub(mode: TZMOvrOpts): Word;
  82.     function PrepareStub: Integer;
  83.     function RecreateMVArchive(const TmpZipName: String; Recreate: Boolean):
  84.         Boolean;
  85.     function ReleaseSFXBin: TMemoryStream;
  86.     function SearchResDirEntry(ResStart: PIRD; entry: PIRDirE; Depth: Integer)
  87.       : PIRDatE;
  88.     procedure StartUp; override;
  89.     // 1 return true if it was there
  90.     function TrimDetached(stub: TMemoryStream): Boolean;
  91.     // 1 return true if it was there
  92.     function MapSFXSettings(stub: TMemoryStream): Integer;
  93.     function WriteEOC(Current: TZMZipFile; OutFile: Integer): Integer;
  94.   public
  95.     constructor Create(AMaster: TCustomZipMaster19);
  96.     procedure AfterConstruction; override;
  97.     procedure BeforeDestruction; override;
  98.     procedure Clear; override;
  99.     function ConvertToSFX(const OutName: string; theZip: TZMZipFile): Integer;
  100.     function ConvertToSpanSFX(const OutFileName: String; theZip: TZMZipFile):
  101.         Integer;
  102.     function ConvertToZIP: Integer;
  103.     function CopyBuffer(InFile, OutFile: Integer; ReadLen: Int64): Integer;
  104.     function Copy_File(const InFileName, OutFileName: String): Integer;
  105.     function CurrentZip(MustExist: Boolean; SafePart: Boolean = false)
  106.       : TZMZipFile;
  107.     procedure Deflate(OutStream, InStream: TStream; Length: Int64; var Method:
  108.         TZMDeflates; var crc: Cardinal); virtual; abstract;
  109.     function DetachedSize(zf: TZMZipFile): Integer;
  110.     procedure Done(Good: Boolean = true); override;
  111.     function GetAuxProperties: Boolean;
  112.     function IsDetachSFX(zfile: TZMZipFile): Boolean;
  113.     function IsZipSFX(const SFXExeName: String): Integer;
  114.     procedure LoadZip(const ZipName: String; NoEvent: Boolean);
  115.     function NewSFXFile(const ExeName: String): Integer;
  116.     function NewSFXStub: TMemoryStream;
  117.     function ReadSpan(const InFileName: String; var OutFilePath: String;
  118.       UseXProgress: Boolean): Integer;
  119.     //1 Remake Intermed using parameters of theZip
  120.     function Recreate(Intermed, theZip: TZMZipFile): Integer;
  121.     function RejoinMVArchive(var TmpZipName: String): Integer;
  122.     function RemakeTemp(temp: TZMZipFile; Recreate, detach: Boolean): Integer;
  123.     procedure Set_ZipFileName(const zname: String; Load: TZLoadOpts);
  124.     procedure Undeflate(OutStream, InStream: TStream; Length: Int64; var Method:
  125.         TZMDeflates; var crc: Cardinal); virtual; abstract;
  126.     function WriteDetached(zf: TZMZipFile): Integer;
  127.     function WriteMulti(Src: TZMZipFile; Dest: TZMZipCopy;
  128.       UseXProgress: Boolean): Integer;
  129.     function WriteSpan(const InFileName, OutFileName: String;
  130.       UseXProgress: Boolean): Integer;
  131.     property AuxChanged: Boolean read FAuxChanged write FAuxChanged;
  132.     property CentralDir: TZMCenDir Read fCentralDir;
  133.     property NoReadAux: Boolean read FNoReadAux write FNoReadAux;
  134.     property RegFailPath: String read fRegFailPath write fRegFailPath;
  135.     property SFXCaption: String read fSFXCaption write fSFXCaption;
  136.     property SFXCommandLine
  137.       : String Read fSFXCommandLine Write SetSFXCommandLine;
  138.     property SFXDefaultDir: String read fSFXDefaultDir write fSFXDefaultDir;
  139.     property SFXIcon: TIcon Read fSFXIcon;
  140.     property SFXMessage: String read fSFXMessage write fSFXMessage;
  141.     property SFXOptions: TZMSFXOpts Read fSFXOptions Write fSFXOptions;
  142.     (* This value controls the behaviour of the SFX when a file to be extracted
  143.       would overwrite an existing file on disk:<br><br>
  144.       - <u>somOverwrite</u>:<br> Always overwrite existing files<br><br>
  145.       - <u>somSkip</u>:<br> Never overwrite existing files<br><br>
  146.       - <u>somAsk</u>:<br> Let the user confirm overwriting.<br><br><br><br>
  147.       *)
  148.     property SFXOverwriteMode
  149.       : TZMOvrOpts Read fSFXOverwriteMode Write fSFXOverwriteMode default
  150.       ovrConfirm;
  151.     property SFXPath: String read fSFXPath write fSFXPath;
  152.     property SuccessCnt: Integer Read fSuccessCnt Write fSuccessCnt;
  153.     property ZipComment: AnsiString read FZipComment write FZipComment;
  154.     property ZipFileName: String Read fZipFileName;
  155.   end;
  156.  
  157. implementation
  158.  
  159. uses
  160.   Dialogs, ZMMsg19, ZMDrv19, ZMDelZip19,
  161.   ZMUtils19, ZMXcpt19, ZMMsgStr19, ZMEOC19, ZMWorkFile19,
  162.   ZMIRec19, ZMUTF819, ZMMatch19, ShellAPI;
  163.  
  164. const
  165.   SPKBACK001 = 'PKBACK#001';
  166.   { File Extensions }
  167.   ExtZip = 'zip';
  168.   DotExtZip = '.' + ExtZip;
  169.   ExtExe = 'exe';
  170.   DotExtExe = '.' + ExtExe;
  171.   ExtBin = 'bin';
  172.   ExtZSX = 'zsx';
  173.   { Identifiers }
  174.   DzSfxID = 'DZSFX';
  175.  
  176. const
  177.   MinStubSize = 12000;
  178.   MaxStubSize = 80000;
  179.   BufSize = 10240;
  180.   // 8192;   // Keep under 12K to avoid Winsock problems on Win95.
  181.   // If chunks are too large, the Winsock stack can
  182.   // lose bytes being sent or received.
  183.  
  184. function WriteCommand(Dest: TMemoryStream; const cmd: string; ident: Integer)
  185.   : Integer; Forward;
  186.  
  187. type
  188.   TZMLoader = class(TZMZipFile)
  189.   private
  190.     fForZip: TZMZipFile;
  191.     fname: String;
  192.     fSFXWorker: TZMWAux;
  193.     procedure SetForZip(const Value: TZMZipFile);
  194.   protected
  195.     function AddStripped(const rec: TZMIRec): Integer;
  196.     function BeforeCommit: Integer; override;
  197.     function PrepareDetached: Integer;
  198.     function StripEntries: Integer;
  199.   public
  200.     constructor Create(Wrkr: TZMCore); override;
  201.     procedure AfterConstruction; override;
  202.     property ForZip: TZMZipFile Read fForZip Write SetForZip;
  203.     property SFXWorker: TZMWAux Read fSFXWorker;
  204.   end;
  205.  
  206. type
  207.   TFileNameIs = (fiExe, fiZip, fiOther, fiEmpty);
  208.  
  209. const
  210.   SFXBinDefault: string = 'ZMSFX19.bin';
  211.   SFXBufSize: Word = $2000;
  212.  
  213. const
  214.   SE_CreateError = -1;    // Error in open or creation of OutFile.
  215.   SE_CopyError = -2;      // Write error or no memory during copy.
  216.   SE_OpenReadError = -3;  // Error in open or Seek of InFile.
  217.   SE_SetDateError = -4;   // Error setting date/time of OutFile.
  218.   SE_GeneralError = -9;
  219.  
  220. function WriteIconToStream(Stream: Classes.TStream; Icon: HICON;
  221.   Width, Height, Depth: Integer): Integer; forward;
  222.  
  223. // get the kind of filename
  224. function GetFileNameKind(const sFile: TFileName): TFileNameIs;
  225. var
  226.   sExt: String;
  227. begin
  228.   if sFile = '' then
  229.     Result := fiEmpty
  230.   else
  231.   begin
  232.     sExt := LowerCase(ExtractFileExt(sFile));
  233.     if sExt = DotExtZip then
  234.       Result := fiZip
  235.     else if sExt = DotExtExe then
  236.       Result := fiExe
  237.     else
  238.       Result := fiOther;
  239.   end;
  240. end;
  241.  
  242. function FindFirstIcon(var rec: TImageResourceDataEntry; const iLevel: Integer;
  243.   const PointerToRawData: Cardinal; str: TStream): Boolean;
  244. var
  245.   i: Integer;
  246.   iPos: Integer;
  247.   RecDir: TImageResourceDirectory;
  248.   RecEnt: TImageResourceDirectoryEntry;
  249. begin
  250.   // position must be correct
  251.   Result := false;
  252.   if (str.Read(RecDir, sizeof(RecDir)) <> sizeof(RecDir)) then
  253.     raise EZipMaster.CreateResDisp(CZ_BrowseError, true);
  254.  
  255.   for i := 0 to Pred(RecDir.NumberOfNamedEntries + RecDir.NumberOfIdEntries) do
  256.   begin
  257.     if (str.Read(RecEnt, sizeof(RecEnt)) <> sizeof(RecEnt)) then
  258.       raise EZipMaster.CreateResDisp(CZ_BrowseError, true);
  259.  
  260.     // check if a directory or a resource
  261.     iPos := str.Position;
  262.     try
  263.       if (RecEnt.un2.DataIsDirectory and IMAGE_RESOURCE_DATA_IS_DIRECTORY)
  264.         = IMAGE_RESOURCE_DATA_IS_DIRECTORY then
  265.       begin
  266.         if ((iLevel = 0) and (MakeIntResource(RecEnt.un1.Name) <> RT_ICON)) or
  267.           ((iLevel = 1) and (RecEnt.un1.Id <> 1)) then
  268.           Continue; // not an icon of id 1
  269.  
  270.         str.Seek(RecEnt.un2.OffsetToDirectory and
  271.             (not IMAGE_RESOURCE_DATA_IS_DIRECTORY) + PointerToRawData,
  272.           soFromBeginning);
  273.         Result := FindFirstIcon(rec, iLevel + 1, PointerToRawData, str);
  274.         if Result then
  275.           Break;
  276.       end
  277.       else
  278.       begin
  279.         // is resource bin data
  280.         str.Seek(RecEnt.un2.OffsetToData + PointerToRawData, soFromBeginning);
  281.         if str.Read(rec, sizeof(rec)) <> sizeof(rec) then
  282.           raise EZipMaster.CreateResDisp(CZ_BrowseError, true);
  283.         Result := true;
  284.         Break;
  285.       end;
  286.     finally
  287.       str.Position := iPos;
  288.     end;
  289.   end;
  290. end;
  291.  
  292. procedure LocateFirstIconHeader(str: TStream;
  293.   var hdrSection: TImageSectionHeader; var recIcon: TImageResourceDataEntry);
  294. var
  295.   bFound: Boolean;
  296.   cAddress: Cardinal;
  297.   hdrDos: TImageDosHeader;
  298.   hdrNT: TImageNTHeaders;
  299.   i: Integer;
  300. begin
  301.   bFound := false;
  302.   // check if we have an executable
  303.   str.Seek(0, soFromBeginning);
  304.   if (str.Read(hdrDos, sizeof(hdrDos)) <> sizeof(hdrDos)) or
  305.     (hdrDos.e_magic <> IMAGE_DOS_SIGNATURE) then
  306.     raise EZipMaster.CreateResDisp(CZ_InputNotExe, true);
  307.  
  308.   str.Seek(hdrDos._lfanew, soFromBeginning);
  309.   if (str.Read(hdrNT, sizeof(hdrNT)) <> sizeof(hdrNT)) or
  310.     (hdrNT.Signature <> IMAGE_NT_SIGNATURE) then
  311.     raise EZipMaster.CreateResDisp(CZ_InputNotExe, true);
  312.  
  313.   // check if we have a resource section
  314.   with hdrNT.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE] do
  315.     if (VirtualAddress = 0) or (Size = 0) then
  316.       raise EZipMaster.CreateResDisp(CZ_NoExeResource, true)
  317.     else
  318.       cAddress := VirtualAddress; // store address
  319.  
  320.   // iterate over sections
  321.   for i := 0 to Pred(hdrNT.FileHeader.NumberOfSections) do
  322.   begin
  323.     if (str.Read(hdrSection, sizeof(hdrSection)) <> sizeof(hdrSection)) then
  324.       raise EZipMaster.CreateResDisp(CZ_ExeSections, true);
  325.  
  326.     // with hdrSection do
  327.     if hdrSection.VirtualAddress = cAddress then
  328.     begin
  329.       bFound := true;
  330.       Break;
  331.     end;
  332.   end;
  333.  
  334.   if not bFound then
  335.     raise EZipMaster.CreateResDisp(CZ_NoExeResource, true);
  336.  
  337.   // go to resource data
  338.   str.Seek(hdrSection.PointerToRawData, soFromBeginning);
  339.  
  340.   // recourse through the resource dirs to find an icon
  341.   if not FindFirstIcon(recIcon, 0, hdrSection.PointerToRawData, str) then
  342.     raise EZipMaster.CreateResDisp(CZ_NoExeIcon, true);
  343. end;
  344.  
  345. // replaces an icon in an executable file (stream)
  346. function GetFirstIcon(str: TMemoryStream): TIcon;
  347. var
  348.   bad: Boolean;
  349.   delta: Cardinal;
  350.   handle: HIcon;
  351.   hdrSection: TImageSectionHeader;
  352.   icoData: PByte;
  353.   icoSize: Cardinal;
  354.   recIcon: TImageResourceDataEntry;
  355. begin
  356.   bad := true;
  357.   Result := nil;
  358.   LocateFirstIconHeader(str, hdrSection, recIcon);
  359.   delta := Integer(hdrSection.PointerToRawData) - Integer
  360.     (hdrSection.VirtualAddress) + Integer(recIcon.OffsetToData);
  361.   icoData := PByte(str.Memory);
  362.   Inc(icoData, delta);
  363.   icoSize := hdrSection.SizeOfRawData;
  364.   handle := CreateIconFromResource(icoData, icoSize, true, $30000);
  365.   if handle <> 0 then
  366.   begin
  367.     Result := TIcon.Create;
  368.     Result.handle := handle;
  369.     bad := false;
  370.   end;
  371.   if bad then
  372.     // no icon copied, so none of matching size found
  373.     raise EZipMaster.CreateResDisp(CZ_NoIconFound, true);
  374. end;
  375.  
  376. // returns size or 0 on error or wrong dimensions
  377. function WriteIconToStream(Stream: Classes.TStream; Icon: HIcon;
  378.   Width, Height, Depth: Integer): Integer;
  379. type
  380.   PIconRec = ^TIconRec;
  381.  
  382.   TIconRec = packed record
  383.     IDir: TIconDir;
  384.     IEntry: TIconDirEntry;
  385.   end;
  386. const
  387.   RC3_ICON = 1;
  388. var
  389.   BI: PBITMAPINFO;
  390.   BIsize: Integer;
  391.   CBits: PByte;
  392.   cbm: Bitmap;
  393.   cofs: Integer;
  394.   colors: Integer;
  395.   dc: HDC;
  396.   Ico: TIconRec;
  397.   IconInfo: TIconInfo;
  398.   MBI: BitMapInfo;
  399.   MBits: PByte;
  400.   mofs: Integer;
  401. begin
  402.   Result := 0;
  403.  
  404.   if (Depth <= 4) then
  405.     Depth := 4
  406.   else if (Depth <= 8) then
  407.     Depth := 8
  408.   else if (Depth <= 16) then
  409.     Depth := 16
  410.   else if (Depth <= 24) then
  411.     Depth := 24
  412.   else
  413.     exit;
  414.   colors := 1 shl Depth;
  415.  
  416.   BI := nil;
  417.   dc := 0;
  418.   if GetIconInfo(Icon, IconInfo) then
  419.   begin
  420.     try
  421.       ZeroMemory(@Ico, sizeof(TIconRec));
  422.       if GetObject(IconInfo.hbmColor, sizeof(Bitmap), @cbm) = 0 then
  423.         exit;
  424.       if (Width <> cbm.bmWidth) or (Height <> cbm.bmHeight) then
  425.         exit;
  426.  
  427.       // ok should be acceptable
  428.       BIsize := sizeof(BitmapInfoHeader);
  429.       if (Depth <> 24) then
  430.         Inc(BIsize, colors * sizeof(RGBQUAD)); // pallet
  431.  
  432.       cofs := BIsize; // offset to colorbits
  433.       Inc(BIsize, (Width * Height * Depth) div 8); // bits
  434.       mofs := BIsize; // offset to maskbits
  435.       Inc(BIsize, (Width * Height) div 8);
  436.  
  437.       // allocate memory for it
  438.       GetMem(BI, BIsize);
  439.  
  440.       ZeroMemory(BI, BIsize);
  441.       // set required attributes for colour bitmap
  442.       BI^.bmiHeader.BIsize := sizeof(BitmapInfoHeader);
  443.       BI^.bmiHeader.biWidth := Width;
  444.       BI^.bmiHeader.biHeight := Height;
  445.       BI^.bmiHeader.biPlanes := 1;
  446.       BI^.bmiHeader.biBitCount := Depth;
  447.       BI^.bmiHeader.biCompression := BI_RGB;
  448.  
  449.       CBits := PByte(BI);
  450.       Inc(CBits, cofs);
  451.  
  452.       // prepare for mono mask bits
  453.       ZeroMemory(@MBI, sizeof(BitMapInfo));
  454.       MBI.bmiHeader.BIsize := sizeof(BitmapInfoHeader);
  455.       MBI.bmiHeader.biWidth := Width;
  456.       MBI.bmiHeader.biHeight := Height;
  457.       MBI.bmiHeader.biPlanes := 1;
  458.       MBI.bmiHeader.biBitCount := 1;
  459.  
  460.       MBits := PByte(BI);
  461.       Inc(MBits, mofs);
  462.  
  463.       dc := CreateCompatibleDC(0);
  464.       if dc <> 0 then
  465.       begin
  466.         if GetDIBits(dc, IconInfo.hbmColor, 0, Height, CBits, BI^,
  467.           DIB_RGB_COLORS) > 0 then
  468.         begin
  469.           // ok get mask bits
  470.           if GetDIBits(dc, IconInfo.hbmMask, 0, Height, MBits, MBI,
  471.             DIB_RGB_COLORS) > 0 then
  472.           begin
  473.             // good we have both
  474.             DeleteDC(dc); // release it quick before anything can go wrong
  475.             dc := 0;
  476.             Ico.IDir.ResType := RC3_ICON;
  477.             Ico.IDir.ResCount := 1;
  478.             Ico.IEntry.bWidth := Width;
  479.             Ico.IEntry.bHeight := Height;
  480.             Ico.IEntry.bColorCount := Depth;
  481.             Ico.IEntry.dwBytesInRes := BIsize;
  482.             Ico.IEntry.dwImageOffset := sizeof(TIconRec);
  483.             BI^.bmiHeader.biHeight := Height * 2;
  484.             // color height includes mask bits
  485.             Inc(BI^.bmiHeader.biSizeImage, MBI.bmiHeader.biSizeImage);
  486.             if (Stream <> nil) then
  487.             begin
  488.               Stream.Write(Ico, sizeof(TIconRec));
  489.               Stream.Write(BI^, BIsize);
  490.             end;
  491.             Result := BIsize + sizeof(TIconRec);
  492.           end;
  493.         end;
  494.       end;
  495.     finally
  496.       if dc <> 0 then
  497.         DeleteDC(dc);
  498.       DeleteObject(IconInfo.hbmColor);
  499.       DeleteObject(IconInfo.hbmMask);
  500.       if BI <> nil then
  501.         FreeMem(BI);
  502.     end;
  503.   end
  504.   else
  505.     RaiseLastOSError;
  506. end;
  507.  
  508. // replaces an icon in an executable file (stream)
  509. procedure ReplaceIcon(str: TMemoryStream; oIcon: TIcon);
  510. var
  511.   bad: Boolean;
  512.   hdrSection: TImageSectionHeader;
  513.   i: Integer;
  514.   oriInfo: BitmapInfoHeader;
  515.   pIDE: PIconDirEntry;
  516.   recIcon: TImageResourceDataEntry;
  517.   strIco: TMemoryStream;
  518. begin
  519.   bad := true;
  520.   LocateFirstIconHeader(str, hdrSection, recIcon);
  521.   str.Seek(Integer(hdrSection.PointerToRawData) - Integer
  522.       (hdrSection.VirtualAddress) + Integer(recIcon.OffsetToData),
  523.     soFromBeginning);
  524.   if (str.Read(oriInfo, sizeof(BitmapInfoHeader)) <> sizeof(BitmapInfoHeader)) then
  525.     raise EZipMaster.CreateResDisp(CZ_NoCopyIcon, true);
  526.  
  527.   // now check the icon
  528.   strIco := TMemoryStream.Create;
  529.   try
  530.     if WriteIconToStream(strIco, oIcon.handle, oriInfo.biWidth,
  531.       oriInfo.biHeight div 2, oriInfo.biBitCount) <= 0 then
  532.       raise EZipMaster.CreateResDisp(CZ_NoIcon, true);
  533.  
  534.     // now search for matching icon
  535.     with PIconDir(strIco.Memory)^ do
  536.     begin
  537.       if (ResType <> RES_ICON) or (ResCount < 1) or (Reserved <> 0) then
  538.         raise EZipMaster.CreateResDisp(CZ_NoIcon, true);
  539.  
  540.       for i := 0 to Pred(ResCount) do
  541.       begin
  542.         pIDE := PIconDirEntry(PAnsiChar(strIco.Memory) + sizeof(TIconDir) +
  543.             (i * sizeof(TIconDirEntry)));
  544.         if (pIDE^.dwBytesInRes = recIcon.Size) and (pIDE^.bReserved = 0) then
  545.         begin
  546.           // matching icon found, replace
  547.           strIco.Seek(pIDE^.dwImageOffset, soFromBeginning);
  548.           str.Seek(Integer(hdrSection.PointerToRawData) - Integer
  549.               (hdrSection.VirtualAddress) + Integer(recIcon.OffsetToData),
  550.             soFromBeginning);
  551.           if str.CopyFrom(strIco, recIcon.Size) <> Integer(recIcon.Size) then
  552.             raise EZipMaster.CreateResDisp(CZ_NoCopyIcon, true);
  553.  
  554.           // ok and out
  555.           bad := false;
  556.         end;
  557.       end;
  558.     end;
  559.   finally
  560.     strIco.Free;
  561.   end;
  562.   if bad then
  563.     // no icon copied, so none of matching size found
  564.     raise EZipMaster.CreateResDisp(CZ_NoIconFound, true);
  565. end;
  566.  
  567. { TZMWAux }
  568.  
  569. constructor TZMWAux.Create(AMaster: TCustomZipMaster19);
  570. begin
  571.   inherited Create(AMaster);
  572. end;
  573.  
  574. function TZMWAux.BrowseResDir(ResStart, Dir: PIRD; Depth: Integer): PIRDatE;
  575. var
  576.   i: Integer;
  577.   SingleRes: PIRDirE;
  578.   x: PByte;
  579. begin
  580.   Result := nil;
  581.   x := PByte(Dir);
  582.   Inc(x, sizeof(IMAGE_RESOURCE_DIRECTORY));
  583.   SingleRes := PIRDirE(x);
  584.  
  585.   for i := 1 to Dir.NumberOfNamedEntries + Dir.NumberOfIdEntries do
  586.   begin
  587.     Result := SearchResDirEntry(ResStart, SingleRes, Depth);
  588.     if Result <> nil then
  589.       Break; // Found the one w're looking for.
  590.   end;
  591. end;
  592.  
  593. procedure TZMWAux.Clear;
  594. begin
  595.   fZipFileName := '';
  596.   fSuccessCnt := 0;
  597.   FZipComment := '';
  598.   CentralDir.Clear;
  599.   Detached := false;
  600.   SFXOverwriteMode := ovrConfirm;
  601.   fSFXCaption := 'Self-extracting Archive';
  602.   fSFXDefaultDir := '';
  603.   fSFXCommandLine := '';
  604.   inherited;
  605. end;
  606.  
  607. function TZMWAux.ConvertToSFX(const OutName: string; theZip: TZMZipFile):
  608.     Integer;
  609. var
  610.   nn: String;
  611.   oz: TZMZipCopy;
  612.   useTemp: Boolean;
  613. begin
  614.   Diag('ConvertToSFX');
  615.   if theZip = nil then
  616.     theZip := CurrentZip(True); // use Current
  617.   Detached := false;
  618.   Result := PrepareStub;
  619.   if (Result < 0) or not assigned(fSFXBinStream) then
  620.   begin
  621.     // result:= some error;
  622.     exit;
  623.   end;
  624.   if OutName = '' then
  625.     nn := ChangeFileExt(theZip.FileName, DotExtExe)
  626.   else
  627.     nn := OutName;
  628.   useTemp := FileExists(nn);
  629.   oz := TZMZipCopy.Create(self);
  630.   try
  631.     if useTemp then
  632.       oz.File_CreateTemp(ExtZSX, '')
  633.     else
  634.       oz.File_Create(nn);
  635.     oz.stub := fSFXBinStream;
  636.     fSFXBinStream := nil;
  637.     oz.UseSFX := true;
  638.     Result := oz.WriteFile(theZip, true);
  639.     theZip.File_Close;
  640.     if (Result >= 0) then
  641.     begin
  642.       if useTemp and not oz.File_Rename(nn, HowToDelete <> htdFinal) then
  643.         raise EZipMaster.CreateRes2Str(CF_CopyFailed, oz.FileName, nn);
  644.       Result := 0;
  645.       Set_ZipFileName(nn, zloFull);
  646.     end;
  647.   finally
  648.     oz.Free;
  649.   end;
  650. end;
  651.  
  652. function TZMWAux.ConvertToSpanSFX(const OutFileName: String; theZip:
  653.     TZMZipFile): Integer;
  654. var
  655.   DiskFile: String;
  656.   DiskSerial: Cardinal;
  657.   Dummy1: Cardinal;
  658.   Dummy2: Cardinal;
  659.   FileListSize: Cardinal;
  660.   FreeOnDisk1: Cardinal;
  661.   KeepFree: Cardinal;
  662.   LDiskFree: Cardinal;
  663.   MsgStr: String;
  664.   OrgKeepFree: Cardinal;
  665.   OutDrv: TZMWorkDrive;
  666.   PartFileName: String;
  667.   RightDiskInserted: Boolean;
  668.   SFXName: String;
  669.   SplitZip: TZMZipCopy;
  670.   VolName: array [0 .. MAX_PATH - 1] of Char;
  671. begin
  672.   Detached := true;
  673.   // prepare stub
  674.   Result := PrepareStub;
  675.   if (Result >= 0) and assigned(fSFXBinStream) then
  676.   begin
  677.     SplitZip := nil;
  678.     if theZip = nil then
  679.       theZip := CentralDir.Current; // use Current
  680.     PartFileName := ChangeFileExt(OutFileName, DotExtZip);
  681.     // delete the existing sfx stub
  682.     if FileExists(OutFileName) then
  683.       DeleteFile(OutFileName);
  684.     SFXName := ExtractFileName(ChangeFileExt(OutFileName, DotExtZip));
  685.     FileListSize := DetachedSize(theZip);//Current);
  686.     OrgKeepFree := KeepFreeOnDisk1;
  687.     OutDrv := TZMWorkDrive.Create;
  688.     try
  689.       // get output parameters
  690.       OutDrv.DriveStr := OutFileName;
  691.       OutDrv.HasMedia(true); // set media details
  692.  
  693.       // calulate the size of the sfx stub
  694.       Result := 0; // is good (at least until it goes bad)
  695.  
  696.       if (not OutDrv.DriveIsFixed) and (MaxVolumeSize = 0) then
  697.       begin
  698.         MaxVolumeSize := OutDrv.VolumeSize;
  699.       end;
  700.       // first test if multiple parts are really needed
  701.       if (MaxVolumeSize <= 0) or ((theZip.File_Size + fSFXBinStream.Size)
  702.           < MaxVolumeSize) then
  703.       begin
  704.         Diag('Too small for span sfx');
  705.         Detached := false;
  706.         Result := ConvertToSFX(OutFileName, theZip);
  707.       end
  708.       else
  709.       begin
  710.         FileListSize := FileListSize + sizeof(Integer) + sizeof
  711.           (TZipEndOfCentral);
  712.         if KeepFreeOnDisk1 <= 0 then
  713.           KeepFree := 0
  714.         else
  715.           KeepFree := KeepFreeOnDisk1;
  716.         KeepFree := KeepFree + FileListSize;
  717.         if OutDrv.VolumeSize > MAXINT then
  718.           LDiskFree := MAXINT
  719.         else
  720.           LDiskFree := Cardinal(OutDrv.VolumeSize);
  721.         { only one set of ' span' params }
  722.         if (MaxVolumeSize > 0) and (MaxVolumeSize < LDiskFree) then
  723.           LDiskFree := MaxVolumeSize;
  724.         if (FileListSize > LDiskFree) then
  725.           Result := -SF_DetachedHeaderTooBig;
  726.  
  727.         if Result = 0 then // << moved
  728.         begin
  729.           if (KeepFree mod OutDrv.VolumeSecSize) <> 0 then
  730.             FreeOnDisk1 := ((KeepFree div OutDrv.VolumeSecSize) + 1)
  731.               * OutDrv.VolumeSecSize
  732.           else
  733.             FreeOnDisk1 := KeepFree;
  734.  
  735.           // let the spanslave of the Worker do the spanning <<< bad comment - remove
  736.           KeepFreeOnDisk1 := FreeOnDisk1;
  737.           SplitZip := TZMZipCopy.Create(self);
  738.           SplitZip.FileName := PartFileName;
  739.           Result := WriteMulti(theZip, SplitZip, true);
  740.           // if all went well - rewrite the loader correctly
  741.           if (Result = 0) and not OutDrv.DriveIsFixed then
  742.           begin
  743.             // for removable disk we need to insert the first again
  744.             RightDiskInserted := false;
  745.             while not RightDiskInserted do
  746.             begin // ask to insert the first disk
  747.               MsgStr := ZipFmtLoadStr(DS_InsertAVolume, [1]) + ZipFmtLoadStr
  748.                 (DS_InDrive, [OutDrv.DriveStr]);
  749.  
  750.               MessageDlg(MsgStr, mtInformation, [mbOK], 0);
  751.               // check if right disk is inserted
  752.               if SplitZip.Numbering = znsVolume then
  753.               begin
  754.                 GetVolumeInformation(@OutDrv.DriveStr, VolName, MAX_PATH,
  755.                   @DiskSerial, Dummy1, Dummy2, nil, 0);
  756.                 if (StrComp(VolName, SPKBACK001) = 0) then
  757.                   RightDiskInserted := true;
  758.               end
  759.               else
  760.               begin
  761.                 DiskFile := Copy(PartFileName, 1, Length(PartFileName)
  762.                     - Length(ExtractFileExt(PartFileName))) + '001.zip';
  763.                 if FileExists(DiskFile) then
  764.                   RightDiskInserted := true;
  765.               end;
  766.             end;
  767.           end;
  768.           // write the loader
  769.           if Result = 0 then
  770.             Result := WriteDetached(SplitZip);
  771.         end;
  772.       end;
  773.     finally
  774.       FreeAndNil(SplitZip);
  775.       FreeAndNil(OutDrv);
  776.       // restore original value
  777.       KeepFreeOnDisk1 := OrgKeepFree;
  778.     end;
  779.   end;
  780.   if Result < 0 then
  781.     CleanupFiles(true);
  782. end;
  783.  
  784. function TZMWAux.ConvertToZIP: Integer;
  785. var
  786.   cz: TZMZipFile;
  787.   nn: String;
  788.   oz: TZMZipCopy;
  789.   useTemp: Boolean;
  790. begin
  791.   Diag('ConvertToZip');
  792.   cz := CurrentZip(true);
  793.   nn := ChangeFileExt(cz.FileName, DotExtZip);
  794.   useTemp := FileExists(nn);
  795.   oz := TZMZipCopy.Create(self);
  796.   try
  797.     if useTemp then
  798.       oz.File_CreateTemp(ExtZSX, '')
  799.     else
  800.       oz.File_Create(nn);
  801.     Result := oz.WriteFile(cz, true);
  802.     cz.File_Close;
  803.     if (Result >= 0) then
  804.     begin
  805.       if useTemp and not oz.File_Rename(nn, HowToDelete <> htdFinal) then
  806.         raise EZipMaster.CreateRes2Str(CF_CopyFailed, oz.FileName, nn);
  807.       Result := 0;
  808.       Set_ZipFileName(nn, zloFull);
  809.     end;
  810.   finally
  811.     oz.Free;
  812.   end;
  813. end;
  814.  
  815. function TZMWAux.CopyBuffer(InFile, OutFile: Integer; ReadLen: Int64)
  816.   : Integer;
  817. var
  818.   Buffer: array of Byte;
  819.   SizeR: Integer;
  820.   ToRead: Cardinal;
  821. begin
  822.   // both files are already open
  823.   Result := 0;
  824.   if ReadLen = 0 then
  825.     exit;
  826.   ToRead := BufSize;
  827.   try
  828.     SetLength(Buffer, BufSize);
  829.     repeat
  830.       if ReadLen >= 0 then
  831.       begin
  832.         ToRead := BufSize;
  833.         if ReadLen < ToRead then
  834.           ToRead := ReadLen;
  835.       end;
  836.       SizeR := FileRead(InFile, Buffer[0], ToRead);
  837.       if (SizeR < 0) or (FileWrite(OutFile, Buffer[0], SizeR) <> SizeR) then
  838.       begin
  839.         Result := SE_CopyError;
  840.         Break;
  841.       end;
  842.       if (ReadLen > 0) then
  843.         ReadLen := ReadLen - Cardinal(SizeR);
  844.       case ShowProgress of
  845.         zspFull:
  846.           ReportProgress(zacProgress, 0, '', SizeR);
  847.         zspExtra:
  848.           ReportProgress(zacXProgress, 0, '', SizeR);
  849.       else
  850.         KeepAlive; // Mostly for winsock.
  851.       end;
  852.     until ((ReadLen = 0) or (SizeR <> Integer(ToRead)));
  853.   except
  854.     Result := SE_CopyError;
  855.   end;
  856.   // leave both files open
  857. end;
  858.  
  859. function TZMWAux.Copy_File(const InFileName, OutFileName: String): Integer;
  860. var
  861.   InFile: Integer;
  862.   In_Size: Int64;
  863.   OutFile: Integer;
  864.   Out_Size: Int64;
  865. begin
  866.   In_Size := -1;
  867.   Out_Size := -1;
  868.   Result := SE_OpenReadError;
  869.   ShowProgress := zspNone;
  870.  
  871.   if not FileExists(InFileName) then
  872.     exit;
  873.   InFile := FileOpen(InFileName, fmOpenRead or fmShareDenyWrite);
  874.   if InFile <> -1 then
  875.   begin
  876.     if FileExists(OutFileName) then
  877.     begin
  878.       OutFile := FileOpen(OutFileName, fmOpenWrite or fmShareExclusive);
  879.       if OutFile = -1 then
  880.       begin
  881.         Result := SE_CreateError; // might be read-only or source
  882.         File_Close(InFile);
  883.         exit;
  884.       end;
  885.       File_Close(OutFile);
  886.       EraseFile(OutFileName, HowToDelete = htdFinal);
  887.     end;
  888.     OutFile := FileCreate(OutFileName);
  889.     if OutFile <> -1 then
  890.     begin
  891.       Result := CopyBuffer(InFile, OutFile, -1);
  892.       if (Result = 0) and (FileSetDate(OutFile, FileGetDate(InFile)) <> 0)
  893.         then
  894.         Result := SE_SetDateError;
  895.       Out_Size := FileSeek64(OutFile, Int64(0), soFromEnd);
  896.       File_Close(OutFile);
  897.     end
  898.     else
  899.       Result := SE_CreateError;
  900.     In_Size := FileSeek64(InFile, Int64(0), soFromEnd);
  901.     File_Close(InFile);
  902.   end;
  903.   // An extra check if the filesizes are the same.
  904.   if (Result = 0) and ((In_Size = -1) or (Out_Size = -1) or (In_Size <> Out_Size)
  905.     ) then
  906.     Result := SE_GeneralError;
  907.   // Don't leave a corrupted outfile lying around. (SetDateError is not fatal!)
  908.   if (Result <> 0) and (Result <> SE_SetDateError) then
  909.     SysUtils.DeleteFile(OutFileName);
  910. end;
  911.  
  912. function TZMWAux.CreateStubStream: Boolean;
  913. const
  914.   MinVers = 1900000;
  915. var
  916.   binname: string;
  917.   BinStub: TStream;
  918.   BinVers: Integer;
  919.   err: Boolean;
  920.   ResStub: TStream;
  921.   ResVers: Integer;
  922.   stub: TStream;
  923.   stubname: string;
  924.   UseBin: Boolean;
  925. begin
  926.   // what type of bin will be used
  927.   stub := nil;
  928.   ResStub := nil;
  929.   BinStub := nil;
  930.   BinVers := -1;
  931.   FreeAndNil(fSFXBinStream); // dispose of existing (if any)
  932.   try
  933.     // load it either from resource (if bcsfx##.res has been linked to the executable)
  934.     // or by loading from file in SFXPath and check both versions if available
  935.     // ResVersion := '';
  936.     stubname := DZRES_SFX;
  937.     binname := SFXBinDefault;
  938.     err := false; // resource stub not found
  939.     if (Length(SFXPath) > 1) and (SFXPath[1] = '>') and
  940.       (SFXPath[Length(SFXPath)] = '<') then
  941.     begin
  942.       // must use from resource
  943.       stubname := Copy(SFXPath, 2, Length(SFXPath) - 2);
  944.       if stubname = '' then
  945.         stubname := DZRES_SFX;
  946.       ResVers := LoadFromResource(ResStub, stubname);
  947.       if ResVers < MinVers then
  948.         err := true;
  949.     end
  950.     else
  951.     begin
  952.       // get from resource if it exists
  953.       ResVers := LoadFromResource(ResStub, DZRES_SFX);
  954.       // load if exists from file
  955.       BinVers := LoadFromBinFile(BinStub, UseBin);
  956.       if UseBin then
  957.         ResVers := 0;
  958.     end;
  959.     if not err then
  960.     begin
  961.       // decide which will be used
  962.       if (BinVers >= MinVers) and (BinVers >= ResVers) then
  963.         stub := BinStub
  964.       else
  965.       begin
  966.         if ResVers >= MinVers then
  967.           stub := ResStub
  968.         else
  969.           err := true;
  970.       end;
  971.     end;
  972.     if stub <> nil then
  973.     begin
  974.       fSFXBinStream := TMemoryStream.Create();
  975.       try
  976.         if fSFXBinStream.CopyFrom(stub, stub.Size - sizeof(Integer)) <>
  977.           (stub.Size - sizeof(Integer)) then
  978.           raise EZipMaster.CreateResDisp(DS_CopyError, true);
  979.         fSFXBinStream.Position := 0;
  980.         if assigned(SFXIcon) then
  981.           ReplaceIcon(fSFXBinStream, SFXIcon);
  982.         fSFXBinStream.Position := 0;
  983.       except
  984.         FreeAndNil(fSFXBinStream);
  985.       end;
  986.     end;
  987.   finally
  988.     FreeAndNil(ResStub);
  989.     FreeAndNil(BinStub);
  990.   end;
  991.   if err then
  992.     raise EZipMaster.CreateResStr(SF_NoZipSFXBin, stubname);
  993.   Result := fSFXBinStream <> nil;
  994. end;
  995.  
  996. function TZMWAux.CurrentZip(MustExist: Boolean; SafePart: Boolean = false)
  997.   : TZMZipFile;
  998. begin
  999.   if ZipFileName = '' then
  1000.     raise EZipMaster.CreateResDisp(GE_NoZipSpecified, true);
  1001.   Result := CentralDir.Current;
  1002.   if MustExist and ((zfi_Loaded and Result.info) = 0) then
  1003.     raise EZipMaster.CreateResDisp(DS_NoValidZip, true);
  1004.   if SafePart and ((zfi_Cancelled and Result.info) <> 0) then
  1005.   begin
  1006.     if Result.AskAnotherDisk(ZipFileName) = idCancel then
  1007.       raise EZipMaster.CreateResDisp(GE_Abort, false);
  1008.     Result.info := 0; // clear error
  1009.   end;
  1010.  
  1011.   if Result.FileName = '' then
  1012.   begin
  1013.     // creating new file
  1014.     Result.FileName := ZipFileName;
  1015.     Result.ReqFileName := ZipFileName;
  1016.   end;
  1017. end;
  1018.  
  1019. function TZMWAux.DetachedSize(zf: TZMZipFile): Integer;
  1020. var
  1021.   Data: TZMRawBytes;
  1022.   Has64: Boolean;
  1023.   i: Integer;
  1024.   ix: Integer;
  1025.   rec: TZMIRec;
  1026.   sz: Integer;
  1027. begin
  1028.   Result := -1;
  1029.   ASSERT(assigned(zf), 'no input');
  1030.   // Diag('Write file');
  1031.   if not assigned(zf) then
  1032.     exit;
  1033.   if fSFXBinStream = nil then
  1034.   begin
  1035.     Result := PrepareStub;
  1036.     if Result < 0 then
  1037.       exit;
  1038.   end;
  1039.   Result := fSFXBinStream.Size;
  1040.  
  1041.   Has64 := false;
  1042.   // add approximate central directory size
  1043.   for i := 0 to zf.Count - 1 do
  1044.   begin
  1045.     rec := zf[i];
  1046.     Result := Result + sizeof(TZipCentralHeader) + rec.FileNameLength;
  1047.     if rec.ExtraFieldLength > 4 then
  1048.     begin
  1049.       ix := 0;
  1050.       sz := 0;
  1051.       Data := rec.ExtraField;
  1052.       if XData(Data, Zip64_data_tag, ix, sz) then
  1053.       begin
  1054.         Result := Result + sz;
  1055.         Has64 := true;
  1056.       end;
  1057.       if XData(Data, UPath_Data_Tag, ix, sz) then
  1058.         Result := Result + sz;
  1059.       if XData(Data, NTFS_data_tag, ix, sz) and (sz >= 36) then
  1060.         Result := Result + sz;
  1061.     end;
  1062.   end;
  1063.   Result := Result + sizeof(TZipEndOfCentral);
  1064.   if Has64 then
  1065.   begin
  1066.     // also has EOC64
  1067.     Inc(Result, sizeof(TZip64EOCLocator));
  1068.     Inc(Result, zf.Z64VSize);
  1069.   end;
  1070. end;
  1071.  
  1072. procedure TZMWAux.Done(Good: Boolean = true);
  1073. var
  1074.   czip: TZMZipFile;
  1075. begin
  1076.   if not Good then
  1077.   begin
  1078.     czip := CentralDir.Current;
  1079.     if czip.info <> 0 then
  1080.     begin
  1081.       czip.info := (czip.info and zfi_Cancelled) or zfi_Error;
  1082.     end;
  1083.   end;
  1084.   inherited;
  1085. end;
  1086.  
  1087. procedure TZMWAux.EncodingChanged(New_Enc: TZMEncodingOpts);
  1088. var
  1089.   cz: TZMZipFile;
  1090. begin
  1091.   cz := CentralDir.Current;
  1092.   cz.Encoding := New_Enc;
  1093. end;
  1094.  
  1095. procedure TZMWAux.Encoding_CPChanged(New_CP: Cardinal);
  1096. var
  1097.   cz: TZMZipFile;
  1098. begin
  1099.   cz := CentralDir.Current;
  1100.   cz.Encoding_CP := New_CP;
  1101. end;
  1102.  
  1103. function TZMWAux.GetAuxProperties: Boolean;
  1104. var
  1105.   r: Integer;
  1106.   czip: TZMZipFile;
  1107. begin
  1108.   Result := False; // don't clear
  1109.   czip := CentralDir.Current;
  1110.   if (czip.info and zfi_DidLoad) <> 0 then
  1111.   begin
  1112.     if czip.stub <> nil then
  1113.     begin
  1114.       // read Aux Settings from stub into component
  1115.       r := MapSFXSettings(czip.stub);
  1116.       if r <> 0 then
  1117.         exit;   // not easy to show warning
  1118.     end;
  1119.     if czip.MultiDisk then
  1120.     begin
  1121.       Master.SpanOptions := czip.MapNumbering(Master.SpanOptions);
  1122.       // set multi-disk
  1123.       Master.WriteOptions := Master.WriteOptions + [zwoDiskSpan];
  1124.     end
  1125.     else
  1126.       Master.WriteOptions := Master.WriteOptions - [zwoDiskSpan];
  1127.     Result := True;   // clear AuxChanged
  1128.     czip.info := czip.info and (not zfi_DidLoad);  // don't clear again
  1129.   end;
  1130. end;
  1131.  
  1132. // if is detached sfx - set stub excluding the detached header
  1133. function TZMWAux.IsDetachSFX(zfile: TZMZipFile): Boolean;
  1134. var
  1135.   cstt: Integer;
  1136.   ms: TMemoryStream;
  1137. begin
  1138.   Result := false;
  1139.   try
  1140.     zfile.stub := nil; // remove old
  1141.     ms := nil;
  1142.     if (zfile.IsOpen) and (zfile.DiskNr = 0) and (zfile.Sig = zfsDOS) then
  1143.     begin
  1144.       // check invalid values
  1145.       if (zfile.EOCOffset <= zfile.CentralSize) or
  1146.         (zfile.CentralSize < sizeof(TZipCentralHeader)) then
  1147.         exit;
  1148.       cstt := zfile.EOCOffset - zfile.CentralSize;
  1149.       // must have SFX stub but we only check for biggest practical header
  1150.       if (cstt < MinStubSize) or (cstt > MaxStubSize) then
  1151.         exit;
  1152.       if zfile.Seek(0, 0) <> 0 then
  1153.         exit;
  1154.       ms := TMemoryStream.Create;
  1155.       try
  1156.         if zfile.ReadTo(ms, cstt + 4) = (cstt + 4) then
  1157.         begin
  1158.           Result := TrimDetached(ms);
  1159.         end;
  1160.       finally
  1161.         ms.Free;
  1162.       end;
  1163.     end;
  1164.   except
  1165.     Result := false;
  1166.     FreeAndNil(ms);
  1167.   end;
  1168. end;
  1169.  
  1170. (* ? TZMWAux.IsZipSFX
  1171. Return value:
  1172. 0 = The specified file is not a SFX
  1173. >0 = It is one
  1174. -7  = Open, read or seek error
  1175. -8  = memory error
  1176. -9  = exception error
  1177. -10 = all other exceptions
  1178. *)
  1179. function TZMWAux.IsZipSFX(const SFXExeName: String): Integer;
  1180. const
  1181.   SFXsig = zqbStartEXE or zqbHasCentral or zqbHasEOC;
  1182. var
  1183.   n: string;
  1184.   r: Integer;
  1185.   sz: Integer;
  1186. begin
  1187.   r := QueryZip(SFXExeName);
  1188.   // SFX = 1 + 128 + 64
  1189.   Result := 0;
  1190.   if (r and SFXsig) = SFXsig then
  1191.     Result := CheckSFXType(SFXExeName, n, sz);
  1192. end;
  1193.  
  1194. function TZMWAux.LoadFromBinFile(var stub: TStream; var Specified: Boolean)
  1195.   : Integer;
  1196. var
  1197.   BinExists: Boolean;
  1198.   binpath: String;
  1199.   path: string;
  1200. begin
  1201.   Result := -1;
  1202.   Specified := false;
  1203.   path := SFXPath;
  1204.   // if no name specified use default
  1205.   if ExtractFileName(SFXPath) = '' then
  1206.     path := path + SFXBinDefault;
  1207.   binpath := path;
  1208.   if (Length(SFXPath) > 1) and
  1209.     ((SFXPath[1] = '.') or (ExtractFilePath(SFXPath) <> '')) then
  1210.   begin
  1211.     // use specified
  1212.     Specified := true;
  1213.     if SFXPath[1] = '.' then // relative to program
  1214.       binpath := PathConcat(ExtractFilePath(ParamStr(0)), path);
  1215.     BinExists := FileExists(binpath);
  1216.   end
  1217.   else
  1218.   begin
  1219.     // Try the application directory.
  1220.     binpath := DelimitPath(ExtractFilePath(ParamStr(0)), true) + path;
  1221.     BinExists := FileExists(binpath);
  1222.     if not BinExists then
  1223.     begin
  1224.       // Try the current directory.
  1225.       binpath := path;
  1226.       BinExists := FileExists(binpath);
  1227.     end;
  1228.   end;
  1229.   if BinExists then
  1230.   begin
  1231.     try
  1232.       stub := TFileStream.Create(binpath, fmOpenRead);
  1233.       if (stub.Size > MinStubSize) and (stub.Size < MaxStubSize) then
  1234.       begin
  1235.         stub.ReadBuffer(Result, sizeof(Integer));
  1236.       end;
  1237.       Diag('found stub: ' + SFXPath + ' ' + VersStr(Result));
  1238.     except
  1239.       Result := -5;
  1240.     end;
  1241.   end;
  1242. end;
  1243.  
  1244. function TZMWAux.LoadFromResource(var stub: TStream; const sfxtyp: String)
  1245.   : Integer;
  1246. var
  1247.   rname: String;
  1248. begin
  1249.   Result := -2;
  1250.   rname := sfxtyp;
  1251.   stub := OpenResStream(rname, RT_RCDATA);
  1252.   if (stub <> nil) and (stub.Size > MinStubSize) and
  1253.     (stub.Size < MaxStubSize) then
  1254.   begin
  1255.     stub.ReadBuffer(Result, sizeof(Integer));
  1256.     Diag('resource stub: ' + VersStr(Result));
  1257.   end;
  1258. end;
  1259.  
  1260. procedure TZMWAux.LoadZip(const ZipName: String; NoEvent: Boolean);
  1261. { all work is local - no DLL calls }
  1262. var
  1263.   r: Integer;
  1264.   tmpDirUpdate: TNotifyEvent;
  1265. begin
  1266.   ClearErr;
  1267.   CentralDir.Current := nil; // close and remove any old file
  1268.   if ZipName <> '' then
  1269.   begin
  1270.     CentralDir.Current.FileName := ZipName;
  1271.     r := CentralDir.Current.Open(false, false);
  1272.     if r >= 0 then
  1273.     begin
  1274.       CentralDir.Current.File_Close;
  1275.       FZipComment := CentralDir.ZipComment;
  1276.     end
  1277.     else
  1278.     begin
  1279.       if r = -DS_NoInFile then
  1280.       begin
  1281.         // just report no file - may be intentional
  1282.         ErrCode := DS_NoInFile;
  1283.         ErrMessage := ZipLoadStr(DS_NoInFile);
  1284.       end
  1285.       else
  1286.         ShowZipMsg(-r, true);
  1287.     end;
  1288.   end;
  1289.   if not NoEvent then
  1290.   begin
  1291.     tmpDirUpdate := Master.OnDirUpdate;
  1292.     if assigned(tmpDirUpdate) then
  1293.       tmpDirUpdate(Master);
  1294.   end;
  1295. end;
  1296.  
  1297. function TZMWAux.MapOptionsFromStub(opts: Word): TZMSFXOpts;
  1298. begin
  1299.   Result := [];
  1300.   if (so_AskCmdLine and opts) <> 0 then
  1301.     Result := Result + [soAskCmdLine];
  1302.   if (so_AskFiles and opts) <> 0 then
  1303.     Result := Result + [soAskFiles];
  1304.   if (so_HideOverWriteBox and opts) <> 0 then
  1305.     Result := Result + [soHideOverWriteBox];
  1306.   if (so_AutoRun and opts) <> 0 then
  1307.     Result := Result + [soAutoRun];
  1308.   if (so_NoSuccessMsg and opts) <> 0 then
  1309.     Result := Result + [soNoSuccessMsg];
  1310.   if (so_ExpandVariables and opts) <> 0 then
  1311.     Result := Result + [soExpandVariables];
  1312.   if (so_InitiallyHideFiles and opts) <> 0 then
  1313.     Result := Result + [soInitiallyHideFiles];
  1314.   if (so_ForceHideFiles and opts) <> 0 then
  1315.     Result := Result + [soForceHideFiles];
  1316.   if (so_CheckAutoRunFileName and opts) <> 0 then
  1317.     Result := Result + [soCheckAutoRunFileName];
  1318.   if (so_CanBeCancelled and opts) <> 0 then
  1319.     Result := Result + [soCanBeCancelled];
  1320.   if (so_CreateEmptyDirs and opts) <> 0 then
  1321.     Result := Result + [soCreateEmptyDirs];
  1322.   if (so_SuccessAlways and opts) <> 0 then
  1323.     Result := Result + [soSuccessAlways];
  1324. end;
  1325.  
  1326. function TZMWAux.MapOptionsToStub(opts: TZMSFXOpts): Word;
  1327. begin
  1328.   Result := 0;
  1329.   if soAskCmdLine in opts then
  1330.     Result := Result or so_AskCmdLine;
  1331.   if soAskFiles in opts then
  1332.     Result := Result or so_AskFiles;
  1333.   if soHideOverWriteBox in opts then
  1334.     Result := Result or so_HideOverWriteBox;
  1335.   if soAutoRun in opts then
  1336.     Result := Result or so_AutoRun;
  1337.   if soNoSuccessMsg in opts then
  1338.     Result := Result or so_NoSuccessMsg;
  1339.   if soExpandVariables in opts then
  1340.     Result := Result or so_ExpandVariables;
  1341.   if soInitiallyHideFiles in opts then
  1342.     Result := Result or so_InitiallyHideFiles;
  1343.   if soForceHideFiles in opts then
  1344.     Result := Result or so_ForceHideFiles;
  1345.   if soCheckAutoRunFileName in opts then
  1346.     Result := Result or so_CheckAutoRunFileName;
  1347.   if soCanBeCancelled in opts then
  1348.     Result := Result or so_CanBeCancelled;
  1349.   if soCreateEmptyDirs in opts then
  1350.     Result := Result or so_CreateEmptyDirs;
  1351.   if soSuccessAlways in opts then
  1352.     Result := Result or so_SuccessAlways;
  1353. end;
  1354.  
  1355. function TZMWAux.MapOverwriteModeFromStub(ovr: Word): TZMOvrOpts;
  1356. begin
  1357.   case ovr of
  1358.     som_Overwrite:
  1359.       Result := ovrAlways;
  1360.     som_Skip:
  1361.       Result := ovrNever;
  1362.   else
  1363.     Result := ovrConfirm;
  1364.   end;
  1365. end;
  1366.  
  1367. function TZMWAux.MapOverwriteModeToStub(mode: TZMOvrOpts): Word;
  1368. begin
  1369.   case mode of
  1370.     ovrAlways:
  1371.       Result := som_Overwrite;
  1372.     ovrNever:
  1373.       Result := som_Skip;
  1374.   else
  1375.     Result := som_Ask;
  1376.   end;
  1377. end;
  1378.  
  1379. function TZMWAux.NewSFXFile(const ExeName: String): Integer;
  1380. var
  1381.   eoc: TZipEndOfCentral;
  1382.   fs: TFileStream;
  1383. begin
  1384.   Diag('Write empty SFX');
  1385.   fs := nil;
  1386.   Result := PrepareStub;
  1387.   if Result <> 0 then
  1388.     exit;
  1389.   try
  1390.     Result := -DS_FileError;
  1391.     eoc.HeaderSig := EndCentralDirSig;
  1392.     eoc.ThisDiskNo := 0;
  1393.     eoc.CentralDiskNo := 0;
  1394.     eoc.CentralEntries := 0;
  1395.     eoc.TotalEntries := 0;
  1396.     eoc.CentralSize := 0;
  1397.     eoc.CentralOffset := 0;
  1398.     eoc.ZipCommentLen := 0;
  1399.     fSFXBinStream.WriteBuffer(eoc, sizeof(eoc));
  1400.     Result := 0;
  1401.     fSFXBinStream.Position := 0;
  1402.     fs := TFileStream.Create(ExeName, fmCreate);
  1403.     Result := fs.CopyFrom(fSFXBinStream, fSFXBinStream.Size);
  1404.     if Result <> fSFXBinStream.Size then
  1405.       Result := -DS_WriteError
  1406.     else
  1407.       Result := 0;
  1408.     Diag('finished write empty SFX');
  1409.   finally
  1410.     FreeAndNil(fs);
  1411.     FreeAndNil(fSFXBinStream);
  1412.   end;
  1413. end;
  1414.  
  1415. function TZMWAux.NewSFXStub: TMemoryStream;
  1416. begin
  1417.   Result := nil;
  1418.   if PrepareStub = 0 then
  1419.     Result := ReleaseSFXBin;
  1420. end;
  1421.  
  1422. function TZMWAux.PrepareStub: Integer;
  1423. var
  1424.   cdata: TSFXStringsData;
  1425.   dflt: TZMDeflates;
  1426.   ds: TMemoryStream;
  1427.   i: Integer;
  1428.   l: Integer;
  1429.   ms: TMemoryStream;
  1430.   SFXBlkSize: Integer;
  1431.   SFXHead: TSFXFileHeader;
  1432. begin
  1433.   Result := -GE_Unknown;
  1434.   if not CreateStubStream then
  1435.     exit;
  1436.   try
  1437.     // create header
  1438.     SFXHead.Signature := SFX_HEADER_SIG;
  1439.     SFXHead.Options := MapOptionsToStub(SFXOptions);
  1440.     SFXHead.DefOVW := MapOverwriteModeToStub(SFXOverwriteMode);
  1441.     SFXHead.StartMsgType := fSFXMessageFlags;
  1442.     ds := nil;
  1443.     ms := TMemoryStream.Create;
  1444.     try
  1445.       WriteCommand(ms, SFXCaption, sc_Caption);
  1446.       WriteCommand(ms, SFXCommandLine, sc_CmdLine);
  1447.       WriteCommand(ms, SFXDefaultDir, sc_Path);
  1448.       WriteCommand(ms, SFXMessage, sc_StartMsg);
  1449.       WriteCommand(ms, RegFailPath, sc_RegFailPath);
  1450.       l := 0;
  1451.       ms.WriteBuffer(l, 1);
  1452.       // check string lengths
  1453.       if ms.Size > 4000 then
  1454.         raise EZipMaster.CreateResDisp(SF_StringTooLong, true);
  1455.  
  1456.       if ms.Size > 100 then
  1457.       begin
  1458.         cdata.USize := ms.Size;
  1459.         ms.Position := 0;
  1460.         ds := TMemoryStream.Create;
  1461.         dflt := ZMDeflate;
  1462.         Deflate(ds, ms, ms.Size, dflt, cdata.crc);
  1463.         cdata.CSize := ds.Size;
  1464.         if (dflt = ZMDeflate) and (ms.Size > (cdata.CSize + sizeof(cdata))) then
  1465.         begin
  1466.           // use compressed
  1467.           ms.Size := 0;
  1468.           ds.Position := 0;
  1469.           ms.WriteBuffer(cdata, sizeof(cdata));
  1470.           ms.CopyFrom(ds, ds.Size);
  1471.           SFXHead.Options := SFXHead.Options or so_CompressedCmd;
  1472.         end;
  1473.       end;
  1474.       // DWord Alignment.
  1475.       i := ms.Size and 3;
  1476.       if i <> 0 then
  1477.         ms.WriteBuffer(l, 4 - i); // dword align
  1478.       SFXBlkSize := sizeof(TSFXFileHeader) + ms.Size;
  1479.       // // create header
  1480.       SFXHead.Size := Word(SFXBlkSize);
  1481.  
  1482.       fSFXBinStream.Seek(0, soFromEnd);
  1483.       fSFXBinStream.WriteBuffer(SFXHead, sizeof(SFXHead));
  1484.       l := SFXBlkSize - sizeof(SFXHead);
  1485.       i := ms.Size;
  1486.       if i > 0 then
  1487.       begin
  1488.         ms.Position := 0;
  1489.         fSFXBinStream.CopyFrom(ms, i);
  1490.         Dec(l, i);
  1491.       end;
  1492.       // check DWORD align
  1493.       if l <> 0 then
  1494.         raise EZipMaster.CreateResDisp(AZ_InternalError, true);
  1495.  
  1496.       Result := 0;
  1497.     finally
  1498.       ms.Free;
  1499.       ds.Free;
  1500.     end;
  1501.   except
  1502.     on E: EZipMaster do
  1503.     begin
  1504.       FreeAndNil(fSFXBinStream);
  1505.       ShowExceptionError(E);
  1506.       Result := -E.ResId;
  1507.     end
  1508.     else
  1509.     begin
  1510.       FreeAndNil(fSFXBinStream);
  1511.       Result := -GE_Unknown;
  1512.     end;
  1513.   end;
  1514. end;
  1515.  
  1516. function TZMWAux.ReadSpan(const InFileName: String; var OutFilePath: String;
  1517.   UseXProgress: Boolean): Integer;
  1518. var
  1519.   fd: TZMZipCopy;
  1520.   fs: TZMZipFile;
  1521. begin
  1522.   ClearErr;
  1523.   ShowProgress := zspNone;
  1524.   fd := nil;
  1525.   fs := nil;
  1526.   Result := 0;
  1527.  
  1528.   try
  1529.     try
  1530.       // If we don't have a filename we make one first.
  1531.       if ExtractFileName(OutFilePath) = '' then
  1532.       begin
  1533.         OutFilePath := MakeTempFileName('', '');
  1534.         if OutFilePath = '' then
  1535.           Result := -DS_NoTempFile;
  1536.       end
  1537.       else
  1538.       begin
  1539.         EraseFile(OutFilePath, HowToDelete = htdFinal);
  1540.         OutFilePath := ChangeFileExt(OutFilePath, EXT_ZIP);
  1541.       end;
  1542.  
  1543.       if Result = 0 then
  1544.       begin
  1545.         fs := TZMZipFile.Create(self);
  1546.         // Try to get the last disk from the user if part of Volume numbered set
  1547.         fs.FileName := InFileName;
  1548.         Result := fs.Open(false, false);
  1549.       end;
  1550.       if Result >= 0 then
  1551.       begin
  1552.         // InFileName opened successfully
  1553.         Result := -DS_NoOutFile;
  1554.         fd := TZMZipCopy.Create(self);
  1555.         if fd.File_Create(OutFilePath) then
  1556.         begin
  1557.           if UseXProgress then
  1558.             fd.ShowProgress := zspExtra
  1559.           else
  1560.             fd.ShowProgress := zspFull;
  1561.           if UseXProgress then
  1562.             fd.EncodeAs := zeoUTF8; // preserve file names for internal operations
  1563.           Result := fd.WriteFile(fs, true);
  1564.         end;
  1565.       end;
  1566.       if Result < 0 then
  1567.         ShowZipMessage(-Result, '');
  1568.     except
  1569.       on ers: EZipMaster do
  1570.       begin
  1571.         // All ReadSpan specific errors.
  1572.         ShowExceptionError(ers);
  1573.         Result := -7;
  1574.       end;
  1575.       on E: Exception do
  1576.       begin
  1577.         // The remaining errors, should not occur.
  1578.         ShowZipMessage(DS_ErrorUnknown, E.Message);
  1579.         Result := -9;
  1580.       end;
  1581.     end;
  1582.   finally
  1583.     FreeAndNil(fs);
  1584.     if (fd <> nil) and (fd.IsOpen) then
  1585.     begin
  1586.       fd.File_Close;
  1587.       if Result <> 0 then
  1588.       begin
  1589.         // An error somewhere, OutFile is not reliable.
  1590.         SysUtils.DeleteFile(OutFilePath);
  1591.         OutFilePath := '';
  1592.       end;
  1593.     end;
  1594.     FreeAndNil(fd);
  1595.   end;
  1596. end;
  1597.  
  1598. (* ? TZMWAux.Recreate
  1599. recreate the 'theZip' file from the intermediate result
  1600. to make as SFX
  1601. - theZip.UseSFX is set
  1602. - theZip.Stub must hold the stub to use
  1603. *)
  1604. function TZMWAux.Recreate(Intermed, theZip: TZMZipFile): Integer;
  1605. var
  1606.   czip: TZMZipFile;
  1607.   DestZip: TZMZipCopy;
  1608.   detchSFX: Boolean;
  1609.   detchsz: Integer;
  1610.   existed: Boolean;
  1611.   r: Integer;
  1612.   tmp: String;
  1613.   wantNewDisk: Boolean;
  1614. begin
  1615.   detchsz := 0;
  1616.   detchSFX := false;
  1617.   existed := (zfi_Loaded and theZip.info) <> 0;
  1618.   if theZip.MultiDisk or ((not existed) and (zwoDiskSpan in theZip.WriteOptions)) then
  1619.   begin
  1620.     if Verbosity >= zvVerbose then
  1621.       Diag('Recreate multi-part: ' + theZip.ReqFileName);
  1622.     if theZip.UseSFX then
  1623.       detchSFX := true;
  1624.     Result := -GE_Unknown;
  1625.     Intermed.File_Close;
  1626.     czip := theZip;
  1627.     // theZip must have proper stub
  1628.     if detchSFX and not assigned(czip.stub) then
  1629.     begin
  1630.       Result := -CF_SFXCopyError; // no stub available - cannot convert
  1631.       exit;
  1632.     end;
  1633.     wantNewDisk := true; // assume need to ask for new disk
  1634.     if existed then
  1635.     begin
  1636.       czip.GetNewDisk(0, true); // ask to enter the first disk again
  1637.       czip.File_Close;
  1638.       wantNewDisk := false;
  1639.     end;
  1640.     tmp := theZip.ReqFileName;
  1641.     if detchSFX then
  1642.     begin
  1643.       if Verbosity >= zvVerbose then // Verbose or Trace then
  1644.         Diag('Recreate detached SFX');
  1645.       // allow room detchSFX stub
  1646.       detchsz := DetachedSize(Intermed);
  1647.       tmp := ChangeFileExt(tmp, EXT_ZIP); // name of the zip files
  1648.     end;
  1649.     // now create the spanned archive similar to theZip from Intermed
  1650.     DestZip := TZMZipCopy.Create(self);
  1651.     try
  1652.       DestZip.Boss := theZip.Boss;
  1653.       DestZip.WriteOptions := theZip.WriteOptions;
  1654.       DestZip.FileName := tmp;
  1655.       DestZip.ReqFileName := theZip.ReqFileName;
  1656.       DestZip.KeepFreeOnDisk1 := DestZip.KeepFreeOnDisk1 + Cardinal(detchsz);
  1657.       DestZip.ShowProgress := zspExtra;
  1658.       DestZip.TotalDisks := 0;
  1659.       if detchSFX and (DestZip.Numbering = znsExt) then
  1660.         DestZip.Numbering := znsName//;
  1661.       else
  1662.         DestZip.Numbering := theZip.Numbering;  // number same as source
  1663.       DestZip.PrepareWrite(zwMultiple);
  1664.       DestZip.NewDisk := wantNewDisk;
  1665. //      DestZip.DiskNr := 0;
  1666.       DestZip.File_Size := Intermed.File_Size; // to calc TotalDisks
  1667.       Intermed.File_Open(fmOpenRead);
  1668.       DestZip.StampDate := Intermed.FileDate;
  1669.       AnswerAll := AnswerAll + [zaaYesOvrwrt];
  1670.       r := DestZip.WriteFile(Intermed, true);
  1671.       DestZip.File_Close;
  1672.       if r < 0 then
  1673.         raise EZipMaster.CreateResDisp(-r, true);
  1674.       if detchSFX then
  1675.       begin
  1676.         DestZip.FileName := DestZip.CreateMVFileNameEx(tmp, false, false);
  1677.         DestZip.GetNewDisk(0, false);
  1678.         DestZip.AssignStub(czip);
  1679.         DestZip.FileName := tmp; // restore base name
  1680.         if WriteDetached(DestZip) >= 0 then
  1681.           Result := 0;
  1682.       end
  1683.       else
  1684.         Result := 0;
  1685.     finally
  1686.       Intermed.File_Close;
  1687.       DestZip.Free;
  1688.     end;
  1689.     theZip.Invalidate;  // must reload
  1690.   end
  1691.   else
  1692.     // not split
  1693.     Result := RecreateSingle(Intermed, theZip); // just copy it
  1694. end;
  1695.  
  1696. // recreate main file (ZipFileName) from temporary file (TmpZipName)
  1697. function TZMWAux.RecreateMVArchive(const TmpZipName: String; Recreate:
  1698.     Boolean): Boolean;
  1699. var
  1700.   OutPath: String;
  1701.   r: Integer;
  1702.   tmp: String;
  1703.   tzip: TZMZipFile;
  1704. begin
  1705.   Result := false;
  1706.   try
  1707.     tzip := TZMZipFile.Create(self);
  1708.  
  1709.     tzip.FileName := CentralDir.Current.FileName;
  1710.     tzip.DiskNr := -1;
  1711.     tzip.IsMultiPart := true;
  1712.     if Recreate then
  1713.     begin
  1714.       try
  1715.         tzip.GetNewDisk(0, true); // ask to enter the first disk again
  1716.         tzip.File_Close;
  1717.       except
  1718.         on E: Exception do
  1719.         begin
  1720.           SysUtils.DeleteFile(TmpZipName); // delete the temp file
  1721.           raise ; // throw last exception again
  1722.         end;
  1723.       end;
  1724.     end;
  1725.  
  1726.     if AnsiSameText('.exe', ExtractFileExt(ZipFileName)) then
  1727.     begin // make 'detached' SFX
  1728.       OutPath := ZipFileName; // remember it
  1729.       Set_ZipFileName(TmpZipName, zloFull); // reload
  1730.       // create an header first to now its size
  1731.       tmp := ExtractFileName(OutPath);
  1732.       r := ConvertToSpanSFX(OutPath, CentralDir.Current);
  1733.       if r >= 0 then
  1734.       begin
  1735.         SysUtils.DeleteFile(TmpZipName);
  1736.         Set_ZipFileName(OutPath, zloNoLoad); // restore it
  1737.       end
  1738.       else
  1739.       begin
  1740.         SuccessCnt := 0; // failed
  1741.         ShowZipMessage(DS_NoOutFile, 'Error ' + IntToStr(r));
  1742.       end;
  1743.     end { if SameText(...) }
  1744.     else
  1745.     begin
  1746.       if Recreate then
  1747.         // reproduce orig numbering
  1748.         SpanOptions := CentralDir.Current.MapNumbering(SpanOptions);
  1749.       if WriteSpan(TmpZipName, ZipFileName, true) <> 0 then
  1750.         SuccessCnt := 0;
  1751.       SysUtils.DeleteFile(TmpZipName);
  1752.     end;
  1753.   finally
  1754.     FreeAndNil(tzip);
  1755.   end;
  1756. end;
  1757.  
  1758. (* ? TZMWAux.RecreateSingle
  1759. Recreate the 'current' file from the intermediate result
  1760. to make as SFX
  1761. - Current.UseSFX is set
  1762. - Current.Stub must hold the stub to use
  1763. *)
  1764. function TZMWAux.RecreateSingle(Intermed, theZip: TZMZipFile): Integer;
  1765. var
  1766.   DestZip: TZMZipCopy;
  1767. begin
  1768.   theZip.File_Close;
  1769.   if Verbosity >= zvVerbose then
  1770.     Diag('Replacing: ' + theZip.ReqFileName);
  1771.   Result := EraseFile(theZip.ReqFileName, theZip.Worker.HowToDelete = htdAllowUndo);
  1772.   if Result > 0 then
  1773.     raise EZipMaster.CreateResDisp(DS_WriteError, true);
  1774.   // rename/copy Intermed
  1775.   AnswerAll := AnswerAll + [zaaYesOvrwrt];
  1776.   if assigned(theZip.stub) and theZip.UseSFX and (Intermed.Sig <> zfsDOS)
  1777.     then
  1778.   begin // rebuild with sfx
  1779.     if Verbosity >= zvVerbose then
  1780.       Diag('Rebuild with SFX');
  1781.     Intermed.File_Close;
  1782.     Intermed.File_Open(fmOpenRead);
  1783.     Result := Intermed.Open(false, false);
  1784.     if Result < 0 then
  1785.       exit;
  1786.     DestZip := TZMZipCopy.Create(self);
  1787.     try
  1788.       DestZip.Boss := theZip.Boss;
  1789.       DestZip.WriteOptions := theZip.WriteOptions;
  1790.       DestZip.AssignStub(theZip);
  1791.       DestZip.UseSFX := true;
  1792.       DestZip.StampDate := Intermed.StampDate; // will be 'orig' or now
  1793.       DestZip.DiskNr := 0;
  1794.       DestZip.ZipComment := theZip.ZipComment; // keep orig
  1795.       DestZip.ShowProgress := zspExtra;
  1796.       DestZip.File_Create(theZip.ReqFileName);
  1797.       Result := DestZip.WriteFile(Intermed, true);
  1798.       Intermed.File_Close;
  1799.       DestZip.File_Close;
  1800.       if Result < 0 then
  1801.         raise EZipMaster.CreateResDisp(-Result, true);
  1802.     finally
  1803.       DestZip.Free;
  1804.     end;
  1805.   end
  1806.   else
  1807.   begin
  1808.     theZip.File_Close;
  1809.     Result := -DS_FileError;
  1810.     if Intermed.File_Rename(theZip.ReqFileName) then
  1811.       Result := 0;
  1812.   end;
  1813.   theZip.Invalidate; // changed - must reload
  1814. end;
  1815.  
  1816. function TZMWAux.RejoinMVArchive(var TmpZipName: String): Integer;
  1817. var
  1818.   Attrs: Integer;
  1819.   curz: TZMZipFile;
  1820.   drt: Integer;
  1821.   tempzip: TZMZipCopy;
  1822.   tmpMessage: TZMMessageEvent;
  1823.   zname: String;
  1824. begin
  1825.   zname := ZipFileName;
  1826.   TmpZipName := MakeTempFileName('', '');
  1827.   if Verbosity >= zvVerbose then
  1828.   begin
  1829.     tmpMessage := Master.OnMessage;
  1830.     if assigned(tmpMessage) then
  1831.       tmpMessage(Master, 0, ZipFmtLoadStr(GE_TempZip, [TmpZipName]));
  1832.   end;
  1833.   Result := 0;
  1834.   if CentralDir.Current.TotalEntries > 0 then
  1835.   begin
  1836.     if (AddFreshen in AddOptions) or (AddUpdate in AddOptions) then
  1837.     begin
  1838.       // is it detached SFX
  1839.       if CentralDir.Current.MultiDisk and (CentralDir.Current.Sig = zfsDOS)
  1840.         then
  1841.         // load the actual zip instead of the loader (without events)
  1842.         LoadZip(ChangeFileExt(zname, EXT_ZIPL), true);
  1843.  
  1844.       curz := CentralDir.Current;
  1845.       // test if output can eventually be produced
  1846.       drt := curz.WorkDrive.DriveType;
  1847.       // we can't re-write on a CD-ROM
  1848.  
  1849.       if (drt = DRIVE_CDROM) then
  1850.       begin
  1851.         Attrs := FileGetAttr(zname);
  1852.         if Attrs and faReadOnly <> 0 then
  1853.         begin
  1854.           ShowZipFmtMsg(DS_NotChangeable, [zname], true);
  1855.           Result := -7;
  1856.           exit;
  1857.         end;
  1858.       end;
  1859.       // rebuild a temp archive
  1860.       Result := DS_FileError;
  1861.       tempzip := TZMZipCopy.Create(self);
  1862.       try
  1863.         if tempzip.File_Create(TmpZipName) then
  1864.         begin
  1865.           tempzip.ShowProgress := zspExtra;
  1866.           if curz.File_Open(fmOpenRead) then
  1867.           begin
  1868.             // tempzip.AddOptions := [];
  1869.             tempzip.EncodeAs := zeoUTF8;
  1870.             Result := tempzip.WriteFile(curz, true);
  1871.           end;
  1872.         end;
  1873.       finally
  1874.         tempzip.Free;
  1875.         curz.File_Close;
  1876.       end;
  1877.     end;
  1878.     if Result <> 0 then
  1879.     begin
  1880.       ErrCode := Result;
  1881.       Result := ErrCode;
  1882.       exit;
  1883.     end;
  1884.     AnswerAll := AnswerAll + [zaaYesOvrwrt];
  1885.   end;
  1886.   Result := 0;
  1887. end;
  1888.  
  1889. function TZMWAux.ReleaseSFXBin: TMemoryStream;
  1890. begin
  1891.   Result := fSFXBinStream;
  1892.   fSFXBinStream := nil;
  1893. end;
  1894.  
  1895. function TZMWAux.RemakeTemp(temp: TZMZipFile; Recreate, detach: Boolean)
  1896.   : Integer;
  1897. var
  1898.   czip: TZMZipFile;
  1899.   fd: TZMZipCopy;
  1900.   r: Integer;
  1901.   tmp: String;
  1902.   wantNewDisk: Boolean;
  1903. begin
  1904.   Result := -GE_Unknown;
  1905.   temp.File_Close;
  1906.   try
  1907.     czip := CentralDir.Current;
  1908.     // Current must have proper stub
  1909.     if detach and not assigned(czip.stub) then
  1910.     begin
  1911.       Result := -CF_SFXCopyError; // no stub available - cannot convert
  1912.       exit;
  1913.     end;
  1914.     wantNewDisk := true; // assume need to ask for new disk
  1915.     if (zfi_Loaded and czip.info) = 0 then
  1916.       Recreate := false; // was no file
  1917.     if Recreate then
  1918.     begin
  1919.       czip.GetNewDisk(0, true); // ask to enter the first disk again
  1920.       czip.File_Close;
  1921.       wantNewDisk := false;
  1922.     end;
  1923.     tmp := ZipFileName;
  1924.     // now create the spanned archive
  1925.     fd := TZMZipCopy.Create(self);
  1926.     try
  1927.       if detach then
  1928.       begin
  1929.         // allow room detached stub
  1930.         tmp := ExtractFileName(tmp);
  1931.         fd.KeepFreeOnDisk1 := KeepFreeOnDisk1 + Cardinal(DetachedSize(temp));
  1932.         // write the temp zipfile to the right target:
  1933.         tmp := ChangeFileExt(ZipFileName, EXT_ZIP); // name of the zip files
  1934.       end;
  1935.       fd.FileName := tmp;
  1936.       fd.NewDisk := wantNewDisk;
  1937.       fd.StampDate := temp.StampDate;
  1938.       fd.ShowProgress := zspExtra;
  1939.       fd.TotalDisks := 0;
  1940.       fd.PrepareWrite(zwMultiple);
  1941.       fd.DiskNr := 0;
  1942.       fd.File_Size := temp.File_Size; // to calc TotalDisks
  1943.       temp.File_Open(fmOpenRead);
  1944.       AnswerAll := AnswerAll + [zaaYesOvrwrt];
  1945.       r := fd.WriteFile(temp, true);
  1946.       if r < 0 then
  1947.         raise EZipMaster.CreateResDisp(-r, true);
  1948.       fd.File_Close;
  1949.       if detach then
  1950.       begin
  1951.         fd.GetNewDisk(0, false);
  1952.         if WriteDetached(fd) >= 0 then
  1953.           Result := 0;
  1954.       end
  1955.       else
  1956.         Result := 0;
  1957.     finally
  1958.       fd.Free;
  1959.     end;
  1960.     CentralDir.Current := nil;  // force reload
  1961.   except
  1962.     on z: EZipMaster do
  1963.     begin
  1964.       Result := -z.ResId;
  1965.     end;
  1966.     on E: Exception do
  1967.     begin
  1968.       Result := -GE_Unknown;
  1969.     end;
  1970.   end;
  1971. end;
  1972.  
  1973. function TZMWAux.SearchResDirEntry(ResStart: PIRD; entry: PIRDirE;
  1974.   Depth: Integer): PIRDatE;
  1975. var
  1976.   x: PByte;
  1977. begin
  1978.   Result := nil;
  1979.   if entry.un1.NameIsString <> 0 then
  1980.     exit; // No named resources.
  1981.   if (Depth = 0) and (entry.un1.Id <> 3) then
  1982.     exit; // Only icon resources.
  1983.   if (Depth = 1) and (entry.un1.Id <> 1) then
  1984.     exit; // Only icon with ID 0x1.
  1985.   if entry.un2.DataIsDirectory = 0 then
  1986.   begin
  1987.     x := PByte(ResStart);
  1988.     Inc(x, entry.un2.OffsetToData);
  1989.     Result := PIRDatE(x);
  1990.   end
  1991.   else
  1992.   begin
  1993.     x := PByte(ResStart);
  1994.     Inc(x, entry.un2.OffsetToDirectory);
  1995.     Result := BrowseResDir(ResStart, PIRD(x), Depth + 1);
  1996.   end;
  1997. end;
  1998.  
  1999. procedure TZMWAux.SetSFXCommandLine(const Value: String);
  2000. begin
  2001.   if fSFXCommandLine <> Value then
  2002.     fSFXCommandLine := Value;
  2003. end;
  2004.  
  2005. procedure TZMWAux.Set_ZipFileName(const zname: String; Load: TZLoadOpts);
  2006. begin
  2007.   fZipFileName := zname;
  2008.   if Load <> zloNoLoad then
  2009.     LoadZip(zname, Load = zloSilent); // automatically load the file
  2010. end;
  2011.  
  2012. procedure TZMWAux.StartUp;
  2013. var
  2014.   Want: Integer;
  2015. begin
  2016.   inherited;
  2017.   SFXOverwriteMode := Master.SFXOverwriteMode;
  2018.   RegFailPath := Master.SFXRegFailPath;
  2019.   SFXCaption := Master.SFXCaption;
  2020.   SFXCommandLine := Master.SFXCommandLine;
  2021.   SFXDefaultDir := Master.SFXDefaultDir;
  2022.   if assigned(Master.SFXIcon) then
  2023.   begin
  2024.     fSFXIcon := TIcon.Create;
  2025.     fSFXIcon.Assign(Master.SFXIcon);
  2026.   end;
  2027.   SFXMessage := Master.SFXMessage;
  2028.   fSFXMessageFlags := MB_OK;
  2029.   if (Length(SFXMessage) >= 1) then
  2030.   begin
  2031.     Want := 1; // want the lot
  2032.     if (Length(SFXMessage) > 1) and (SFXMessage[2] = '|') then
  2033.     begin
  2034.       case SFXMessage[1] of
  2035.         '1':
  2036.           fSFXMessageFlags := MB_OKCANCEL or MB_ICONINFORMATION;
  2037.         '2':
  2038.           fSFXMessageFlags := MB_YESNO or MB_ICONQUESTION;
  2039.         '|': Want := 2;
  2040.       end;
  2041.       if fSFXMessageFlags <> MB_OK then
  2042.         Want := 3;
  2043.     end;
  2044.     if Want > 1 then
  2045.       SFXMessage := Copy(SFXMessage, Want, 2048);
  2046.   end;
  2047.   SFXOptions := Master.SFXOptions;
  2048.   SFXPath := Master.SFXPath;
  2049. end;
  2050.  
  2051. function TZMWAux.TrimDetached(stub: TMemoryStream): Boolean;
  2052. type
  2053.   T_header = packed record
  2054.     Sig: DWORD;
  2055.     Size: Word;
  2056.     x: Word;
  2057.   end;
  2058.   P_header = ^T_header;
  2059. var
  2060.   i: Integer;
  2061.   NumSections: Integer;
  2062.   p: PByte;
  2063.   phed: P_header;
  2064.   sz: Cardinal;
  2065. begin
  2066.   Result := false;
  2067.   if (stub <> nil) and (stub.Size > MinStubSize) then
  2068.   begin
  2069.     sz := 0;
  2070.     p := stub.Memory;
  2071.     if (PImageDosHeader(p).e_magic <> IMAGE_DOS_SIGNATURE) then
  2072.       exit;
  2073.     Inc(p, PImageDosHeader(p)._lfanew);
  2074.     if PCardinal(p)^ <> IMAGE_PE_SIGNATURE then
  2075.       exit; // not exe
  2076.     Inc(p, sizeof(Cardinal));
  2077.     NumSections := PImageFileHeader(p).NumberOfSections;
  2078.     Inc(p, sizeof(TImageFileHeader) + sizeof(TImageOptionalHeader));
  2079.     for i := 1 to NumSections do
  2080.     begin
  2081.       with PImageSectionHeader(p)^ do
  2082.         if PointerToRawData + SizeOfRawData > sz then
  2083.           sz := PointerToRawData + SizeOfRawData;
  2084.       Inc(p, sizeof(TImageSectionHeader));
  2085.     end;
  2086.     // sz = end of stub
  2087.     p := stub.Memory;
  2088.     Inc(p, sz);
  2089.     phed := P_header(p);
  2090.     if phed.Sig <> SFX_HEADER_SIG then
  2091.       exit; // bad
  2092.     sz := sz + phed.Size;
  2093.     // posn := sz;
  2094.     Inc(p, phed.Size);
  2095.     phed := P_header(p);
  2096.     if (phed.Sig = CentralFileHeaderSig) then
  2097.     begin
  2098.       stub.Size := sz; // remove file header
  2099.       Result := true;
  2100.     end;
  2101.   end;
  2102. end;
  2103.  
  2104. function TZMWAux.MapSFXSettings(stub: TMemoryStream): Integer;
  2105. type
  2106.   T_header = packed record
  2107.     Sig: DWORD;
  2108.     Size: Word;
  2109.     x: Word;
  2110.   end;
  2111.   P_header = ^T_header;
  2112. var
  2113.   i: Integer;
  2114.   NumSections: Integer;
  2115.   p: PByte;
  2116.   phed: P_header;
  2117.   sz: Cardinal;
  2118. begin
  2119.   Result := 0;
  2120.   if (stub <> nil) and (stub.Size > MinStubSize) then
  2121.   begin
  2122.     sz := 0;
  2123.     p := stub.Memory;
  2124.     if (PImageDosHeader(p).e_magic <> IMAGE_DOS_SIGNATURE) then
  2125.       exit;
  2126.     Result := -DS_SFXBadRead; //  'unknown sfx'
  2127.     Inc(p, PImageDosHeader(p)._lfanew);
  2128.     if PCardinal(p)^ <> IMAGE_PE_SIGNATURE then
  2129.       exit; // not exe
  2130.     Inc(p, sizeof(Cardinal));
  2131.     NumSections := PImageFileHeader(p).NumberOfSections;
  2132.     Inc(p, sizeof(TImageFileHeader) + sizeof(TImageOptionalHeader));
  2133.     for i := 1 to NumSections do
  2134.     begin
  2135.       with PImageSectionHeader(p)^ do
  2136.         if PointerToRawData + SizeOfRawData > sz then
  2137.           sz := PointerToRawData + SizeOfRawData;
  2138.       Inc(p, sizeof(TImageSectionHeader));
  2139.     end;
  2140.     // sz = end of stub
  2141.     p := stub.Memory;
  2142.     Inc(p, sz);
  2143.     phed := P_header(p);
  2144.     if phed.Sig = SFX_HEADER_SIG then
  2145.     begin
  2146.       Result := MapSFXSettings19(p, stub);
  2147.     end
  2148.     else if phed.Sig = SFX_HEADER_SIG_17 then
  2149.     begin
  2150.       Result := MapSFXSettings17(p, stub);
  2151.     end;
  2152.   end;
  2153. end;
  2154.  
  2155. function ReadSFXStr17(var p: PByte; len: Byte): Ansistring;
  2156. var
  2157.   i: Integer;
  2158. begin
  2159.   Result := '';
  2160.   if len > 0 then
  2161.   begin
  2162.     SetLength(Result, len);
  2163.     for I := 1 to len do
  2164.     begin
  2165.       Result[i] := AnsiChar(P^);
  2166.       inc(p);
  2167.     end;
  2168.   end;
  2169. end;
  2170.  
  2171. procedure TZMWAux.AfterConstruction;
  2172. begin
  2173.   inherited;
  2174.   fSuccessCnt := 0;
  2175.   fCentralDir := TZMCenDir.Create(self);
  2176.   FZipComment := '';
  2177.   fZipFileName := '';
  2178.   fSFXIcon := nil;
  2179.   fUseDelphiBin := true;
  2180.   fSFXBinStream := nil;
  2181. end;
  2182.  
  2183. procedure TZMWAux.BeforeDestruction;
  2184. begin
  2185.   FreeAndNil(fCentralDir);
  2186.   FreeAndNil(fSFXIcon);
  2187.   FreeAndNil(fSFXBinStream);
  2188.   inherited;
  2189. end;
  2190.  
  2191. function TZMWAux.MapSFXSettings17(pheder: PByte; stub: TMemoryStream): Integer;
  2192. type
  2193.   T_header = packed record
  2194.     Sig: DWORD;
  2195.     Size: Word;
  2196.     x: Word;
  2197.   end;
  2198.   P_header = ^T_header;
  2199. var
  2200.   ico: TIcon;
  2201.   p: PByte;
  2202.   PSFXHeader: PSFXFileHeader_17;
  2203.   X_Caption, X_Path, X_CmdLine, X_RegFailPath, X_StartMsg: AnsiString;
  2204. begin
  2205.   Result := -DS_SFXBadRead;
  2206.   PSFXHeader := PSFXFileHeader_17(pheder);
  2207.   p := pheder;
  2208.   Inc(p, Sizeof(TSFXFileHeader_17));   // point to strings
  2209.   X_Caption := ReadSFXStr17(p, PSFXHeader^.CaptionSize);
  2210.   X_Path := ReadSFXStr17(p, PSFXHeader^.PathSize);
  2211.   X_CmdLine := ReadSFXStr17(p, PSFXHeader^.CmdLineSize);
  2212.   X_RegFailPath := ReadSFXStr17(p, PSFXHeader^.RegFailPathSize);
  2213.   X_StartMsg := ReadSFXStr17(p, PSFXHeader^.StartMsgSize);
  2214.  
  2215.   // read icon
  2216.   try
  2217.     ico := GetFirstIcon(stub);
  2218.     // should test valid
  2219.     Master.SFXIcon := ico;
  2220.     ico.Free;
  2221.   except
  2222.     On E: EZMException do
  2223.     begin
  2224.       Result := -E.ResId;
  2225.       exit;
  2226.     end
  2227.     else
  2228.       exit;
  2229.   end;
  2230.   Master.SFXOptions := MapOptionsFrom17(PSFXHeader^.Options);
  2231.   Master.SFXOverwriteMode := MapOverwriteModeFromStub(PSFXHeader^.DefOVW);
  2232.   if (PSFXHeader^.StartMsgType and (MB_OKCANCEL or MB_YESNO)) <> 0 then
  2233.   begin
  2234.     if (PSFXHeader^.StartMsgType and MB_OKCANCEL) <> 0 then
  2235.       X_StartMsg := '1|' + X_StartMsg
  2236.     else if (PSFXHeader^.StartMsgType and MB_YESNO) <> 0 then
  2237.       X_StartMsg := '2|' + X_StartMsg;
  2238.   end;
  2239.   Master.SFXMessage := String(X_StartMsg);
  2240.   Master.SFXCaption := String(X_Caption);
  2241.   Master.SFXDefaultDir := String(X_Path);
  2242.   Master.SFXCommandLine := String(X_CmdLine);
  2243.   Master.SFXRegFailPath := String(X_RegFailPath);
  2244.   Result := 0;  // all is well
  2245. end;
  2246.  
  2247. // table format - ident: byte, strng[]: byte, 0: byte; ...;0
  2248. function TZMWAux.LoadSFXStr(ptbl: pByte; ident: Byte): String;
  2249. var
  2250.   id: Byte;
  2251. begin
  2252.   Result := '';
  2253.   if (ptbl = nil) or (ident = 0) then
  2254.     exit;
  2255.   id := ptbl^;
  2256.   while (id <> 0) and (id <> ident) do
  2257.   begin
  2258.     while ptbl^ <> 0 do
  2259.       inc(ptbl);
  2260.     inc(ptbl);
  2261.     id := ptbl^;
  2262.   end;
  2263.   if id = ident then
  2264.   begin
  2265.     inc(ptbl);
  2266. {$ifdef UNICODE}
  2267.     Result := PUTF8ToStr(pAnsiChar(ptbl), -1);
  2268. {$else}
  2269.     if UseUTF8 then
  2270.       Result := UTF8String(pAnsiChar(ptbl))
  2271.     else
  2272.       Result := PUTF8ToStr(pAnsiChar(ptbl), -1);
  2273. {$endif}
  2274.   end;
  2275. end;
  2276.  
  2277. function TZMWAux.MapOptionsFrom17(opts: Word): TZMSFXOpts;
  2278. begin
  2279.   Result := [];
  2280.   if (so_AskCmdLine_17 and opts) <> 0 then
  2281.     Result := Result + [soAskCmdLine];
  2282.   if (so_AskFiles_17 and opts) <> 0 then
  2283.     Result := Result + [soAskFiles];
  2284.   if (so_HideOverWriteBox_17 and opts) <> 0 then
  2285.     Result := Result + [soHideOverWriteBox];
  2286.   if (so_AutoRun_17 and opts) <> 0 then
  2287.     Result := Result + [soAutoRun];
  2288.   if (so_NoSuccessMsg_17 and opts) <> 0 then
  2289.     Result := Result + [soNoSuccessMsg];
  2290.   if (so_ExpandVariables_17 and opts) <> 0 then
  2291.     Result := Result + [soExpandVariables];
  2292.   if (so_InitiallyHideFiles_17 and opts) <> 0 then
  2293.     Result := Result + [soInitiallyHideFiles];
  2294.   if (so_ForceHideFiles_17 and opts) <> 0 then
  2295.     Result := Result + [soForceHideFiles];
  2296.   if (so_CheckAutoRunFileName_17 and opts) <> 0 then
  2297.     Result := Result + [soCheckAutoRunFileName];
  2298.   if (so_CanBeCancelled_17 and opts) <> 0 then
  2299.     Result := Result + [soCanBeCancelled];
  2300.   if (so_CreateEmptyDirs_17 and opts) <> 0 then
  2301.     Result := Result + [soCreateEmptyDirs];
  2302. end;
  2303.  
  2304. function TZMWAux.MapSFXSettings19(pheder: PByte; stub: TMemoryStream): Integer;
  2305. var
  2306.   cmnds: PByte;
  2307.   CRC: Cardinal;
  2308.   cstream: TMemoryStream;
  2309.   ico: TIcon;
  2310.   msg: string;
  2311.   method: TZMDeflates;
  2312.   delta: Integer;
  2313.   p: PByte;
  2314.   phed: PSFXFileHeader;
  2315.   psdat: PSFXStringsData;
  2316. begin
  2317.   Result := -DS_SFXBadRead;
  2318.   phed := PSFXFileHeader(pheder);
  2319.   cstream := nil;
  2320.   cmnds := @phed^.StartMsgType;
  2321.   inc(cmnds, sizeof(WORD));
  2322.   try
  2323.     // get command strings
  2324.     if (so_CompressedCmd and phed^.Options) <> 0 then
  2325.     begin
  2326.       // needs dll!!!!
  2327.       p := cmnds;
  2328.       cmnds := nil;
  2329.       psdat := PSFXStringsData(p);
  2330.       Inc(p, sizeof(TSFXStringsData));  // point to compressed data
  2331.       delta := Cardinal(p) - Cardinal(stub.Memory);
  2332.       if stub.Seek(delta, soFromBeginning) = delta then
  2333.       begin
  2334.         cstream := TMemoryStream.Create;
  2335.         method := ZMDeflate; // deflated
  2336.         Undeflate(cstream, stub, psdat.CSize, method, CRC);
  2337.         if (cstream.Size = psdat.USize) and (CRC = psdat.CRC) then
  2338.           cmnds := cstream.Memory;  // ok
  2339.       end;
  2340.     end;
  2341.     if cmnds <> nil then
  2342.     begin
  2343.       // read icon
  2344.       try
  2345.         ico := GetFirstIcon(stub);
  2346.         // should test valid
  2347.         Master.SFXIcon := ico;
  2348.         ico.Free;
  2349.       except
  2350.         On E: EZMException do
  2351.         begin
  2352.           Result := -E.ResId;
  2353.           exit;
  2354.         end
  2355.         else
  2356.           exit;
  2357.       end;
  2358.       // we have strings
  2359.       Master.SFXCaption := LoadSFXStr(cmnds, sc_Caption);
  2360.       Master.SFXDefaultDir := LoadSFXStr(cmnds, sc_Path);
  2361.       Master.SFXCommandLine := LoadSFXStr(cmnds, sc_CmdLine);
  2362.       Master.SFXRegFailPath := LoadSFXStr(cmnds, sc_RegFailPath);
  2363.       msg := LoadSFXStr(cmnds, sc_StartMsg);
  2364.       Master.SFXOptions := MapOptionsFromStub(phed^.Options);
  2365.       Master.SFXOverwriteMode := MapOverwriteModeFromStub(phed^.DefOVW);
  2366.       if (phed^.StartMsgType and (MB_OKCANCEL or MB_YESNO)) <> 0 then
  2367.       begin
  2368.         if (phed^.StartMsgType and MB_OKCANCEL) <> 0 then
  2369.           msg := '1|' + msg
  2370.         else if (phed^.StartMsgType and MB_YESNO) <> 0 then
  2371.           msg := '2|' + msg;
  2372.       end;
  2373.       Master.SFXMessage := msg;
  2374.       Result := 0;  // all is well
  2375.     end;
  2376.   finally
  2377.     if cstream <> nil then
  2378.       cstream.Free;
  2379.   end;
  2380. end;
  2381.  
  2382. function TZMWAux.WriteDetached(zf: TZMZipFile): Integer;
  2383. var
  2384.   xf: TZMLoader;
  2385. begin
  2386.   Diag('Write detached SFX stub');
  2387.   Result := -DS_FileError;
  2388.   xf := TZMLoader.Create(self);
  2389.   try
  2390.     xf.ForZip := zf;
  2391.     if xf.File_Create(ChangeFileExt(zf.FileName, DotExtExe)) then
  2392.       Result := xf.Commit(false);
  2393.   finally
  2394.     xf.Free;
  2395.   end;
  2396. end;
  2397.  
  2398. function TZMWAux.WriteEOC(Current: TZMZipFile; OutFile: Integer): Integer;
  2399. var
  2400.   r: Integer;
  2401. begin
  2402.   Current.Handle := OutFile;
  2403.   Current.Position := FileSeek(OutFile, 0, soFromCurrent);
  2404.   r := Current.WriteEOC();
  2405.   OutSize := FileSeek(OutFile, 0, soFromEnd);
  2406.   Current.Handle := -1; // closes OutFile
  2407.   Result := r;
  2408. end;
  2409.  
  2410. function TZMWAux.WriteMulti(Src: TZMZipFile; Dest: TZMZipCopy;
  2411.   UseXProgress: Boolean): Integer;
  2412. begin
  2413.   try
  2414.     if ExtractFileName(Src.FileName) = '' then
  2415.       raise EZipMaster.CreateResDisp(DS_NoInFile, true);
  2416.     if ExtractFileName(Dest.FileName) = '' then
  2417.       raise EZipMaster.CreateResDisp(DS_NoOutFile, true);
  2418.     Result := Src.Open(false, false);
  2419.     if Result < 0 then
  2420.       raise EZipMaster.CreateResDisp(-Result, true);
  2421.     Dest.StampDate := Src.StampDate;
  2422.     if UseXProgress then
  2423.       Dest.ShowProgress := zspExtra
  2424.     else
  2425.       Dest.ShowProgress := zspFull;
  2426.     Dest.TotalDisks := 0;
  2427.     Dest.PrepareWrite(zwMultiple);
  2428. //    Dest.DiskNr := 0;
  2429.     Dest.File_Size := Src.File_Size; // to calc TotalDisks
  2430.     Result := Dest.WriteFile(Src, true);
  2431.     Dest.File_Close;
  2432.     Src.File_Close;
  2433.     if Result < 0 then
  2434.       raise EZipMaster.CreateResDisp(-Result, true);
  2435.   except
  2436.     on ews: EZipMaster do // All WriteSpan specific errors.
  2437.     begin
  2438.       ShowExceptionError(ews);
  2439.       Result := -7;
  2440.     end;
  2441.     on EOutOfMemory do // All memory allocation errors.
  2442.     begin
  2443.       ShowZipMessage(GE_NoMem, '');
  2444.       Result := -8;
  2445.     end;
  2446.     on E: Exception do
  2447.     begin
  2448.       // The remaining errors, should not occur.
  2449.       ShowZipMessage(DS_ErrorUnknown, E.Message);
  2450.       Result := -9;
  2451.     end;
  2452.   end;
  2453. end;
  2454.  
  2455. function TZMWAux.WriteSpan(const InFileName, OutFileName: String;
  2456.   UseXProgress: Boolean): Integer;
  2457. var
  2458.   fd: TZMZipCopy;
  2459.   fs: TZMZipFile;
  2460. begin
  2461.   ClearErr;
  2462.   Result := -1;
  2463.   fd := nil;
  2464.   fs := TZMZipFile.Create(self);
  2465.   try
  2466.     fs.FileName := InFileName;
  2467.     fd := TZMZipCopy.Create(self);
  2468.     fd.FileName := OutFileName;
  2469.     if Unattended and not fd.WorkDrive.DriveIsFixed then
  2470.       raise EZipMaster.CreateResDisp(DS_NoUnattSpan, true);
  2471.     Result := WriteMulti(fs, fd, UseXProgress);
  2472.   finally
  2473.     fs.Free;
  2474.     if fd <> nil then
  2475.       fd.Free;
  2476.   end;
  2477. end;
  2478.  
  2479. function WriteCommand(Dest: TMemoryStream; const cmd: string; ident: Integer)
  2480.   : Integer;
  2481. var
  2482.   ucmd: UTF8String;
  2483.   z: Byte;
  2484. begin
  2485.   Result := 0;
  2486.   if Length(cmd) > 0 then
  2487.   begin
  2488.     ucmd := AsUTF8Str(cmd);
  2489.     Dest.Write(ident, 1);
  2490.     Result := Dest.Write(PAnsiChar(ucmd)^, Length(ucmd)) + 2;
  2491.     z := 0;
  2492.     Dest.Write(z, 1);
  2493.   end;
  2494. end;
  2495.  
  2496. constructor TZMLoader.Create(Wrkr: TZMCore);
  2497. begin
  2498.   inherited Create(Wrkr);
  2499.   fSFXWorker := Wrkr as TZMWAux;
  2500. end;
  2501.  
  2502. function TZMLoader.AddStripped(const rec: TZMIRec): Integer;
  2503. var
  2504.   Data: TZMRawBytes;
  2505.   idx: Integer;
  2506.   ixN: Integer;
  2507.   ixU: Integer;
  2508.   ixZ: Integer;
  2509.   ndata: TZMRawBytes;
  2510.   ni: TZMRawBytes;
  2511.   nrec: TZMIRec;
  2512.   siz: Integer;
  2513.   szN: Integer;
  2514.   szU: Integer;
  2515.   szZ: Integer;
  2516. begin
  2517.   ixZ := 0;
  2518.   szZ := 0;
  2519.   ixU := 0;
  2520.   szU := 0;
  2521.   ixN := 0;
  2522.   szN := 0;
  2523.   nrec := TZMIRec.Create(self);
  2524.   nrec.VersionMadeBy := rec.VersionMadeBy;
  2525.   nrec.VersionNeeded := rec.VersionNeeded;
  2526.   nrec.Flag := rec.Flag;
  2527.   nrec.ComprMethod := rec.ComprMethod;
  2528.   nrec.ModifDateTime := rec.ModifDateTime;
  2529.   nrec.CRC32 := rec.CRC32;
  2530.   nrec.CompressedSize := rec.CompressedSize;
  2531.   nrec.UncompressedSize := rec.UncompressedSize;
  2532.   nrec.FileCommentLen := 0;
  2533.   nrec.DiskStart := rec.DiskStart;
  2534.   nrec.IntFileAttrib := rec.IntFileAttrib;
  2535.   nrec.ExtFileAttrib := rec.ExtFileAttrib;
  2536.   nrec.RelOffLocal := rec.RelOffLocal;
  2537.   nrec.StatusBits := rec.StatusBits;
  2538.   ndata := '';
  2539.   siz := 0;
  2540.   ni := rec.HeaderName;
  2541.   if rec.ExtraFieldLength > 4 then
  2542.   begin
  2543.     Data := rec.ExtraField;
  2544.     if XData(Data, Zip64_data_tag, ixZ, szZ) then
  2545.       siz := siz + szZ;
  2546.     if XData(Data, UPath_Data_Tag, ixU, szU) then
  2547.       siz := siz + szU;
  2548.     if XData(Data, NTFS_data_tag, ixN, szN) and (szN >= 36) then
  2549.       siz := siz + szN;
  2550.   end;
  2551.   nrec.HeaderName := ni;
  2552.   nrec.FileNameLength := Length(ni);
  2553.   if siz > 0 then
  2554.   begin
  2555.     // copy required extra data fields
  2556.     SetLength(ndata, siz);
  2557.     idx := 1;
  2558.     if szZ > 0 then
  2559.       move(Data[ixZ], ndata[idx], szZ);
  2560.     Inc(idx, szZ);
  2561.     if szU > 0 then
  2562.       move(Data[ixU], ndata[idx], szU);
  2563.     Inc(idx, szU);
  2564.     if szN >= 36 then
  2565.       move(Data[ixN], ndata[idx], szN);
  2566.     nrec.ExtraField := ndata;
  2567.     ndata := '';
  2568.   end;
  2569.   Result := Add(nrec);
  2570.   if Result < 0 then
  2571.   begin
  2572.     nrec.Free; // could not add it
  2573.     Result := -AZ_InternalError;
  2574.   end;
  2575. end;
  2576.  
  2577. procedure TZMLoader.AfterConstruction;
  2578. begin
  2579.   inherited;
  2580.   ForZip := nil;
  2581.   fname := '';
  2582.   DiskNr := MAX_WORD - 1;
  2583. end;
  2584.  
  2585. function TZMLoader.BeforeCommit: Integer;
  2586. begin
  2587.   Result := inherited BeforeCommit;
  2588.   // Prepare detached header
  2589.   if Result = 0 then
  2590.   begin
  2591.     if Entries.Count < 0 then
  2592.       raise EZipMaster.CreateResDisp(AZ_NothingToDo, true);
  2593.     StampDate := ForZip.StampDate;
  2594.     Result := PrepareDetached;
  2595.   end;
  2596. end;
  2597.  
  2598. function TZMLoader.PrepareDetached: Integer;
  2599. begin
  2600.   if not assigned(stub) then
  2601.   begin
  2602.     Result := SFXWorker.PrepareStub;
  2603.     if Result < 0 then
  2604.       exit; // something went wrong
  2605.     stub := SFXWorker.ReleaseSFXBin; // we now own it
  2606.   end;
  2607.   UseSFX := true;
  2608.   Result := 0;
  2609. end;
  2610.  
  2611. procedure TZMLoader.SetForZip(const Value: TZMZipFile);
  2612. begin
  2613.   if ForZip <> Value then
  2614.   begin
  2615.     fForZip := Value;
  2616.     ClearEntries;
  2617.     StripEntries;
  2618.     DiskNr := ForZip.DiskNr + 1;
  2619.   end;
  2620. end;
  2621.  
  2622. function TZMLoader.StripEntries: Integer;
  2623. var
  2624.   i: Integer;
  2625. begin
  2626.   Result := -AZ_NothingToDo;
  2627.   // fill list from ForFile
  2628.   for i := 0 to ForZip.Count - 1 do
  2629.   begin
  2630.     Result := AddStripped(ForZip[i]);
  2631.     if Result < 0 then
  2632.       Break;
  2633.   end;
  2634. end;
  2635.  
  2636. end.
  2637.