Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit ZMIRec19;
  2.  
  3. (*
  4.   ZMIRec19.pas - Represents the 'Directory entry' of a Zip file
  5.     Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  6.       Eric W. Engler and Chris Vleghert.
  7.  
  8.         This file is part of TZipMaster Version 1.9.
  9.  
  10.     TZipMaster is free software: you can redistribute it and/or modify
  11.     it under the terms of the GNU Lesser General Public License as published by
  12.     the Free Software Foundation, either version 3 of the License, or
  13.     (at your option) any later version.
  14.  
  15.     TZipMaster is distributed in the hope that it will be useful,
  16.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.     GNU Lesser General Public License for more details.
  19.  
  20.     You should have received a copy of the GNU Lesser General Public License
  21.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  22.  
  23.     contact: problems@delphizip.org (include ZipMaster in the subject).
  24.     updates: http://www.delphizip.org
  25.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  26.  
  27.   modified 2010-05-12
  28. ---------------------------------------------------------------------------*)
  29. interface
  30.  
  31. uses
  32.   Classes, Windows, ZipMstr19, ZMWorkFile19, ZMStructs19, ZMCompat19;
  33.  
  34. type
  35.   TZMRecStrings = (zrsName, zrsComment, zrsIName);
  36.   TZipSelects          = (zzsClear, zzsSet, zzsToggle);
  37.   TZMStrEncOpts = (zseDOS, zseXName, zseXComment);
  38.   TZMStrEncodes = set of TZMStrEncOpts;
  39.  
  40. // ZipDirEntry status bit constants
  41. const
  42.   zsbHashed = $100;     // hash calculated
  43.   zsbLocalDone = $200;  // local data prepared
  44.   zsbLocal64 = $400;    // local header required zip64
  45.  
  46.   zsbEncMask = $70000;  // mask for bits holding how entry is encoded
  47.  
  48. type
  49.   TZSExtOpts = (zsxUnkown, zsxName, zsxComment, zsxName8, zsxComment8);
  50.   TZStrExts = set of TZSExtOpts;
  51.  
  52. type
  53.   THowToEnc = (hteOEM, hteAnsi, hteUTF8);
  54.  
  55.  
  56. type
  57.   TZMIRec = class(TZMDirRec)
  58.   private
  59.     fComprMethod:    Word;            //compression method(2)
  60.     fComprSize:      Int64;           //compressed file size  (8)
  61.     fCRC32:          Longword;        //Cyclic redundancy check (4)
  62.     fDiskStart:      Cardinal;        //starts on disk number xx(4)
  63.     fExtFileAtt:     Longword;        //external file attributes(4)
  64.     FExtraField:     TZMRawBytes;//RawByteString;
  65.     fFileName:       TZMString;       // cache for external filename
  66.     fFileComLen:     Word;            //(2)
  67.     fFileNameLen:    Word;            //(2)
  68.     fFlag:           Word;            //generalPurpose bitflag(2)
  69.     FHash:           Cardinal;
  70.     fHeaderComment:  TZMRawBytes;//RawByteString;   // internal comment
  71.     fHeaderName:     TZMRawBytes;//RawByteString;
  72.     fIntFileAtt:     Word;            //internal file attributes(2)
  73.     FLocalData:      TZMRawBytes;//RawByteString;
  74.     fModifDateTime:  Longword;        // dos date/time          (4)
  75.     fOrigHeaderName: TZMRawBytes;//RawByteString;
  76.     fOwner:          TZMWorkFile;
  77.     fRelOffLocal:    Int64;
  78.     FSelectArgs: string;
  79.     fStatusBits:     Cardinal;
  80.     fUnComprSize:    Int64;           //uncompressed file size (8)
  81.     FVersionMadeBy: word;
  82.     fVersionNeeded:    Word;            // version needed to extract(2)
  83.     function GetEncodeAs: TZMEncodingOpts;
  84.     function GetEncoding: TZMEncodingOpts;
  85.     function GetHash: Cardinal;
  86.     function GetHeaderComment: TZMRawBytes;
  87.     function GetIsEncoded: TZMEncodingOpts;
  88.     function GetSelected: Boolean;
  89.     function GetStatusBit(Mask: Cardinal): Cardinal;
  90.     procedure SetIsEncoded(const Value: TZMEncodingOpts);
  91.     procedure SetSelected(const Value: Boolean);
  92.   protected
  93.     procedure Diag(const msg: TZMString);
  94.     function FindDataTag(tag: Word; var idx, siz: Integer): Boolean;
  95. //    function FindDuplicate(const Name: String): TZMIRec;
  96.     function FixStrings(const NewName, NewComment: TZMString): Integer;
  97.     function FixXData64: Integer;
  98.     function GetCompressedSize: Int64; override;
  99.     function GetCompressionMethod: Word; override;
  100.     function GetCRC32: Cardinal; override;
  101.     function GetDataString(Cmnt: Boolean): UTF8String;
  102.     function GetDateTime: Cardinal; override;
  103.     function GetDirty: Boolean;
  104.     function GetEncoded: TZMEncodingOpts; override;
  105.     function GetEncrypted: Boolean; override;
  106.     function GetExtFileAttrib: Longword; override;
  107.     function GetExtraData(Tag: Word): TZMRawBytes; override;
  108.     function GetExtraField: TZMRawBytes; override;
  109.     function GetExtraFieldLength: Word; override;
  110.     function GetFileComment: TZMString; override;
  111.     function GetFileCommentLen: Word; override;
  112.     function GetFileName: TZMString; override;
  113.     function GetFileNameLength: Word; override;
  114.     function GetFlag: Word; override;
  115.     function GetHeaderName: TZMRawBytes; override;
  116.     function GetIntFileAttrib: Word; override;
  117.     function GetRelOffLocalHdr: Int64; override;
  118.     function GetStartOnDisk: Word; override;
  119.     function GetStatusBits: Cardinal; override;
  120.     function GetUncompressedSize: Int64; override;
  121.     function GetVersionMadeBy: Word; override;
  122.     function GetVersionNeeded: Word; override;
  123.     function IsZip64: Boolean;
  124.     procedure MarkDirty;
  125.     //1 Set Minimum VersionMadeBy and VersionNeeded
  126.     procedure FixMinimumVers(z64: boolean);
  127.     //1 convert internal Filename/Comment from utf
  128.     function Int2UTF(Field: TZMRecStrings; NoUD: Boolean = False): TZMString;
  129.     //1 return true if Zip64 fields used
  130.     procedure PrepareLocalData;
  131.     procedure SetDateStamp(Value: TDateTime);
  132.     procedure SetEncrypted(const Value: Boolean);
  133.     procedure SetExtraData(Tag: Word; const data: TZMRawBytes);
  134.     function StrToSafe(const aString: TZMString; ToOem: boolean): AnsiString;
  135.     function StripDrive(const FName: TZMString; NoPath: Boolean): TZMString;
  136.     function StrToHeader(const aString: TZMString; how: THowToEnc): TZMRawBytes;
  137.     function StrToUTF8Header(const aString: TZMString): TZMRawBytes;
  138.     function StrTo_UTF8(const aString: TZMString): UTF8String;
  139.     function ToIntForm(const nname: TZMString; var iname: TZMString): Integer;
  140.     function WriteAsLocal: Integer;
  141.     function WriteAsLocal1(Stamp, crc: Cardinal): Integer;
  142.     function WriteDataDesc(OutZip: TZMWorkFile): Integer;
  143.     property LocalData: TZMRawBytes read FLocalData write FLocalData;
  144.     //1 Header name before rename - needed to verify local header
  145.     property OrigHeaderName: TZMRawBytes read fOrigHeaderName;
  146.   public
  147.     constructor Create(theOwner: TZMWorkFile);
  148.     procedure AfterConstruction; override;
  149.     procedure AssignFrom(const zr: TZMIRec);
  150.     procedure BeforeDestruction; override;
  151.     function CentralSize: Cardinal;
  152.     function ChangeAttrs(nAttr: Cardinal): Integer; override;
  153.     function ChangeComment(const ncomment: TZMString): Integer; override;
  154.     function ChangeData(ndata: TZMRawBytes): Integer; override;
  155.     function ChangeDate(ndosdate: Cardinal): Integer; override;
  156.     function ChangeEncoding: Integer; override;
  157.     function ChangeName(const nname: TZMString): Integer; override;
  158.     procedure ClearCachedName;
  159.     function ClearStatusBit(const values: Cardinal): Cardinal;
  160.     function HasChanges: Boolean;
  161.     function LocalSize: Cardinal;
  162.     function Process: Int64; virtual;
  163.     function ProcessSize: Int64; virtual;
  164.     function Read(wf: TZMWorkFile): Integer;
  165.     function SafeHeaderName(const IntName: TZMString): TZMString;
  166.     function SeekLocalData: Integer;
  167.     function Select(How: TZipSelects): Boolean;
  168.     function SetStatusBit(const Value: Cardinal): Cardinal;
  169.     function TestStatusBit(const mask: Cardinal): Boolean;
  170.     function Write: Integer;
  171.     property CompressedSize: Int64 Read fComprSize Write fComprSize;
  172.     property ComprMethod: Word Read fComprMethod Write fComprMethod;
  173.     property CRC32: Longword Read fCRC32 Write fCRC32;
  174.     property DiskStart: Cardinal Read fDiskStart Write fDiskStart;
  175.     property EncodeAs: TZMEncodingOpts Read GetEncodeAs;
  176.     property Encoded: TZMEncodingOpts Read GetEncoded;
  177.     property Encoding: TZMEncodingOpts Read GetEncoding;
  178.     property Encrypted: Boolean Read GetEncrypted Write SetEncrypted;
  179.     property ExtFileAttrib: Longword Read fExtFileAtt Write fExtFileAtt;
  180.     property ExtraData[Tag: Word]: TZMRawBytes read GetExtraData write
  181.         SetExtraData;
  182.     property ExtraField: TZMRawBytes read FExtraField write FExtraField;
  183.     property ExtraFieldLength: Word read GetExtraFieldLength;
  184.     property FileComLen: Word Read fFileComLen Write fFileComLen;
  185.     property FileComment: TZMString Read GetFileComment;
  186.     property FileCommentLen: Word Read fFileComLen Write fFileComLen;
  187.     property FileName: TZMString Read GetFileName;
  188.     property FileNameLen: Word Read fFileNameLen Write fFileNameLen;
  189.     property FileNameLength: Word Read fFileNameLen Write fFileNameLen;
  190.     property Flag: Word Read fFlag Write fFlag;
  191.     property Hash: Cardinal read GetHash;
  192.     property HeaderComment: TZMRawBytes read GetHeaderComment;
  193.     property HeaderName: TZMRawBytes read GetHeaderName write fHeaderName;
  194.     property IntFileAttrib: Word Read fIntFileAtt Write fIntFileAtt;
  195.     //1 the cached value in the status
  196.     property IsEncoded: TZMEncodingOpts read GetIsEncoded write SetIsEncoded;
  197.     property ModifDateTime: Longword Read fModifDateTime Write fModifDateTime;
  198.     property Owner: TZMWorkFile Read fOwner;
  199.     property RelOffLocal: Int64 Read fRelOffLocal Write fRelOffLocal;
  200.     property SelectArgs: string read FSelectArgs write FSelectArgs;
  201.     property Selected: Boolean Read GetSelected Write SetSelected;
  202.     property StatusBit[Mask: Cardinal]: Cardinal read GetStatusBit;
  203.     property StatusBits: Cardinal Read GetStatusBits Write fStatusBits;
  204.     property UncompressedSize: Int64 read fUnComprSize write fUnComprSize;
  205.     property VersionMadeBy: word read FVersionMadeBy write FVersionMadeBy;
  206.     property VersionNeeded: Word Read fVersionNeeded Write fVersionNeeded;
  207.   end;
  208.  
  209. function XData(const x: TZMRawBytes; Tag: Word; var idx, size: Integer):
  210.     Boolean;
  211. function XDataAppend(var x: TZMRawBytes; const src1; siz1: Integer; const src2;
  212.     siz2: Integer): Integer;
  213. function XDataKeep(const x: TZMRawBytes; const tags: array of Integer):
  214.     TZMRawBytes;
  215. function XDataRemove(const x: TZMRawBytes; const tags: array of Integer):
  216.     TZMRawBytes;
  217.  
  218. function HashFunc(const str: String): Cardinal;
  219. function IsInvalidIntName(const FName: TZMString): Boolean;
  220.  
  221. implementation
  222.  
  223. uses
  224.   SysUtils, ZMZipFile19, ZMMsg19, ZMXcpt19, ZMMsgStr19, ZMUtils19,
  225.   ZMUTF819, ZMMatch19, ZMCore19, ZMDelZip19;
  226.  
  227. {$INCLUDE '.\ZipVers19.inc'}
  228. {$IFDEF VER180}
  229. {$WARN SYMBOL_PLATFORM OFF}
  230. {$ENDIF}
  231.  
  232. const
  233.   MAX_BYTE = 255;
  234.  
  235. type
  236.   Txdat64 = packed record
  237.     tag:  Word;
  238.     siz:  Word;
  239.     vals: array [0..4] of Int64;  // last only cardinal
  240.   end;
  241.  
  242. const
  243.   ZipCenRecFields: array [0..17] of Integer =
  244.     (4, 1, 1, 2, 2, 2, 2, 2, 4, 4, 4, 2, 2, 2, 2, 2, 4, 4);
  245.  
  246.  
  247. // P. J. Weinberger Hash function
  248. function HashFunc(const str : String) : Cardinal;
  249. var
  250.   i : Cardinal;
  251.   x : Cardinal;
  252. begin
  253.   Result := 0;
  254.   for i := 1 to Length(str) do
  255.   begin
  256.     Result := (Result shl 4) + Ord(str[i]);
  257.     x := Result and $F0000000;
  258.     if (x <> 0) then
  259.       Result := (Result xor (x shr 24)) and $0FFFFFFF;
  260.   end;
  261. end;
  262.  
  263. // make safe version of external comment
  264. function SafeComment(const xcomment: String): string;
  265. var
  266.   c: Char;
  267.   i: integer;
  268. Begin
  269.   if StrHasExt(xcomment) then
  270.     Result := StrToOEM(xcomment)
  271.   else
  272.     Result := xcomment;
  273.   for i := 1 to Length(Result) do
  274.   begin
  275.     c := Result[i];
  276.     if (c < ' ') or (c > #126) then
  277.       Result[i] := '_';
  278.   end;
  279. End;
  280.  
  281. { TZMIRec }
  282. constructor TZMIRec.Create(theOwner: TZMWorkFile);
  283. begin
  284.   inherited Create;
  285.   fOwner := theOwner;
  286. end;
  287.  
  288. procedure TZMIRec.AssignFrom(const zr: TZMIRec);
  289. begin
  290.   inherited;
  291.   if (zr <> self) and (zr is TZMIRec) then
  292.   begin
  293.     VersionMadeBy := zr.VersionMadeBy;
  294.     VersionNeeded := zr.VersionNeeded;
  295.     Flag  := zr.Flag;
  296.     ComprMethod := zr.ComprMethod;
  297.     ModifDateTime := zr.ModifDateTime;
  298.     CRC32 := zr.CRC32;
  299.     CompressedSize := zr.CompressedSize;
  300.     UncompressedSize := zr.UncompressedSize;
  301.     FileNameLength := zr.FileNameLength;
  302.     FileCommentLen := zr.FileCommentLen;
  303.     DiskStart := zr.DiskStart;
  304.     IntFileAttrib := zr.IntFileAttrib;
  305.     ExtFileAttrib := zr.ExtFileAttrib;
  306.     RelOffLocal := zr.RelOffLocal;
  307.     fOrigHeaderName := zr.OrigHeaderName;
  308.     fHeaderName := zr.HeaderName;
  309.     fHeaderComment := zr.HeaderComment;
  310.     fExtraField := zr.fExtraField;
  311.     StatusBits := zr.StatusBits;
  312.     fHash := zr.FHash;
  313.   end;
  314. end;
  315.  
  316. function TZMIRec.CentralSize: Cardinal;
  317. begin
  318.   Result := SizeOf(TZipCentralHeader);
  319.   Inc(Result, FileNameLength + ExtraFieldLength + FileCommentLen);
  320. end;
  321.  
  322. function TZMIRec.ChangeAttrs(nAttr: Cardinal): Integer;
  323. begin
  324.   Result := 0; // always allowed
  325.   if nAttr <> GetExtFileAttrib then
  326.   begin
  327.     ExtFileAttrib := nAttr;
  328.     MarkDirty;
  329.   end;
  330. end;
  331.  
  332. function TZMIRec.ChangeComment(const ncomment: TZMString): Integer;
  333. begin
  334.   Result := 0; // always allowed
  335.   if ncomment <> GetFileComment then
  336.     Result := FixStrings(FileName, ncomment);
  337. end;
  338.  
  339. function TZMIRec.ChangeData(ndata: TZMRawBytes): Integer;
  340. var
  341.   NewData: TZMRawBytes;
  342.   OldData: TZMRawBytes;
  343. begin
  344.   Result := 0; // always allowed
  345.   if ndata <> GetExtraField then
  346.   begin
  347.     // preserve required tags
  348.     OldData := XDataKeep(ExtraField, [Zip64_data_tag, UPath_Data_Tag, UCmnt_Data_Tag]);
  349.     // do not allow changing fields
  350.     NewData := XDataRemove(ndata, [Zip64_data_tag, UPath_Data_Tag, UCmnt_Data_Tag]);
  351.     // will it fit?
  352.     if (Length(OldData) + Length(NewData) + Length(GetFileComment) +
  353.           Length(GetFileName)) < MAX_WORD then
  354.     begin
  355.       fExtraField := OldData + NewData;
  356.       MarkDirty;
  357.     end
  358.     else
  359.       Result := -CD_CEHDataSize;
  360.   end;
  361. end;
  362.  
  363. function TZMIRec.ChangeDate(ndosdate: Cardinal): Integer;
  364. begin
  365.   Result := -CD_NoProtected;
  366.   if Encrypted then
  367.     exit;
  368.   try
  369.     // test if valid date/time will throw error if not
  370.     FileDateToDateTime(ndosdate);
  371.   except
  372.     Result := -RN_InvalidDateTime;
  373.     if Owner.Boss.Verbosity >= zvVerbose then
  374.       Diag('Invalid date ' + GetFileName);
  375.     exit;
  376.   end;
  377.   Result := 0;
  378.   if ndosdate <> GetDateTime then
  379.   begin
  380.     ModifDateTime := ndosdate;
  381.     MarkDirty;
  382.   end;
  383. end;
  384.  
  385. function TZMIRec.ChangeEncoding: Integer;
  386. begin
  387.   Result := FixStrings(FileName, FileComment);
  388. end;
  389.  
  390. function TZMIRec.ChangeName(const nname: TZMString): Integer;
  391. var
  392.   iname: TZMString;
  393. begin
  394.   Result := ToIntForm(nname, iname);
  395.   if Result = 0 then
  396.   begin
  397.     Result := -CD_NoChangeDir;
  398.     if IsFolder(iname) <> IsFolder(HeaderName) then
  399.       exit; // dirOnly status must be same
  400.     if iname <> FileName then
  401.       Result := FixStrings(iname, FileComment);
  402.   end;
  403. end;
  404.  
  405. function TZMIRec.ClearStatusBit(const values: Cardinal): Cardinal;
  406. begin
  407.   StatusBits := StatusBits and not values;
  408.   Result := StatusBits;
  409. end;
  410.  
  411.  
  412. procedure TZMIRec.Diag(const msg: TZMString);
  413. begin
  414.   if Owner.Boss.Verbosity >= zvVerbose then
  415.     Owner.Boss.ShowMsg('Trace: ' + msg, 0, False);
  416. end;
  417.  
  418. procedure TZMIRec.ClearCachedName;
  419. begin
  420.   fFileName := '';  // force reconvert - settings have changed
  421.   ClearStatusBit(zsbHashed);
  422.   IsEncoded := zeoAuto; // force re-evaluate
  423. end;
  424.  
  425. function TZMIRec.FindDataTag(tag: Word; var idx, siz: Integer): Boolean;
  426. begin
  427.   Result := False;
  428.   if XData(ExtraField, tag, idx, siz) then
  429.     Result := True;
  430. end;
  431.  
  432. //function TZMIRec.FindDuplicate(const Name: String): TZMIRec;
  433. //var
  434. //  ix: Integer;
  435. //begin
  436. //  ix := -1;  // from start
  437. //  repeat
  438. //    Result := (Owner as TZMZipFile).FindName(Name, ix);
  439. //  until Result <> self;
  440. //end;
  441.  
  442. function IsOnlyDOS(const hstr: TZMRawBytes): Boolean;
  443. var
  444.   i: Integer;
  445. begin
  446.   Result := True;
  447.   for i := 1 to Length(hstr) do
  448.     if (hstr[i] > #126) or (hstr[i] < #32) then
  449.     begin
  450.       Result := False;
  451.       Break;
  452.     end;
  453. end;
  454.  
  455. function TZMIRec.FixStrings(const NewName, NewComment: TZMString): Integer;
  456. var
  457.   dup: TZMIRec;
  458.   enc: TZMEncodingOpts;
  459.   HasXComment: Boolean;
  460.   HasXName: Boolean;
  461.   hcomment: TZMRawBytes;
  462.   IX: Integer;
  463.   need64: Boolean;
  464.   NeedU8Bit: Boolean;
  465.   newdata: Boolean;
  466.   NewHeaderName: TZMRawBytes;
  467.   NewIntName: string;
  468.   NewMadeFS: Word;
  469.   UComment: UTF8String;
  470.   UData: TZMRawBytes;
  471.   uheader: TUString_Data_Header;
  472.   UName: UTF8String;
  473.   xlen: Integer;
  474. begin
  475.   enc := EncodeAs;
  476.   NewMadeFS := (FS_FAT * 256) or OUR_VEM;
  477.   UName  := '';
  478.   UComment := '';
  479.   NeedU8Bit := False;
  480.   Result := -CD_DuplFileName;
  481.   ix := -1;  // from start
  482.   dup := (Owner as TZMZipFile).FindName(NewName, ix, self);
  483.   if dup <> nil then
  484.     exit; // duplicate external name
  485.   NewIntName := SafeHeaderName(NewName);
  486.   // default convert new name and comment to OEM
  487.   NewHeaderName  := StrToHeader(NewIntName, hteOEM);
  488.   hcomment := StrToHeader(NewComment, hteOEM);
  489.   // make entry name
  490.   HasXName := StrHasExt(NewName);
  491.   HasXComment := StrHasExt(NewComment);
  492.   // form required strings
  493.   if HasXName or HasXComment then
  494.   begin
  495.     if enc = zeoAuto then
  496.     begin
  497.       enc := zeoUPATH;  // unless both extended
  498.       if HasXName and HasXComment then
  499.         enc := zeoUTF8;
  500.     end;
  501.     // convert strings
  502.     if enc = zeoUTF8 then
  503.     begin
  504.       NewHeaderName  := StrToHeader(NewIntName, hteUTF8);
  505.       hcomment := StrToHeader(NewComment, hteUTF8);
  506.       NeedU8Bit := True;
  507.     end
  508.     else
  509.     begin
  510.       if enc = zeoUPath then
  511.       begin
  512.         // we want UPATH or/and UCOMMENT
  513.         if HasXName then
  514.           UName  := StrTo_UTF8(NewIntName);
  515.         if HasXComment then
  516.           UComment := StrTo_UTF8(NewComment);
  517.       end
  518.       else
  519.       if enc = zeoNone then
  520.       begin
  521.         // we want Ansi name and comment - NTFS
  522.         NewHeaderName  := StrToHeader(NewIntName, hteAnsi);
  523.         hcomment := StrToHeader(NewComment, hteAnsi);
  524.         if StrHasExt(NewHeaderName) or StrHasExt(hcomment) then
  525.           NewMadeFS := (FS_NTFS * 256) or OUR_VEM; // wasn't made safe FAT
  526.       end;
  527.     end;
  528.   end;
  529.   // we now have the required strings
  530.   // remove old extra strings
  531.   UData := XDataRemove(GetExtraField, [UPath_Data_Tag, UCmnt_Data_Tag]);
  532.   newdata := Length(UData) <> ExtraFieldLength;
  533.   if UName <> '' then
  534.   begin
  535.     uheader.tag := UPath_Data_Tag;
  536.     uheader.totsiz := sizeof(TUString_Data_Header) + Length(UName) - (2 * sizeof(Word));
  537.     uheader.version := 1;
  538.     uheader.origcrc := CalcCRC32(NewHeaderName[1], length(NewHeaderName), 0);
  539.     XDataAppend(UData, uheader, sizeof(uheader), UName[1], length(UName));
  540.     newdata := True;
  541.   end;
  542.  
  543.   if UComment <> '' then
  544.   begin
  545.     // append UComment
  546.     uheader.tag := UCmnt_Data_Tag;
  547.     uheader.totsiz := sizeof(TUString_Data_Header) + Length(UComment) -
  548.       (2 * sizeof(Word));
  549.     uheader.version := 1;
  550.     uheader.origcrc := CalcCRC32(hcomment[1], length(hcomment), 0);
  551.     XDataAppend(UData, uheader, sizeof(uheader), UComment[1], length(UComment));
  552.     newdata := True;
  553.   end;
  554.   // will it fit?
  555.   Result := -CD_CEHDataSize;
  556.   xlen := Length(HeaderComment) + Length(NewHeaderName) + Length(UData);
  557.   if xlen < MAX_WORD then
  558.   begin                    
  559.     // ok - make change
  560.     fHeaderName  := NewHeaderName;
  561.     fFileNameLen := Length(NewHeaderName);
  562.     fHeaderComment := hcomment;
  563.     fFileComLen := Length(hcomment);
  564.  
  565.     if newdata then
  566.       ExtraField := UData;
  567.  
  568.     if NeedU8Bit then
  569.       fFlag := fFlag or FLAG_UTF8_BIT
  570.     else
  571.       fFlag := fFlag and (not FLAG_UTF8_BIT);
  572.     ClearCachedName;
  573.     IsEncoded := zeoAuto;         // unknown
  574.     need64 := (UncompressedSize >= MAX_UNSIGNED) or (CompressedSize >= MAX_UNSIGNED);
  575.     // set versions to minimum required
  576.     FVersionMadeBy := NewMadeFS;
  577.     FixMinimumVers(need64);
  578.     MarkDirty;
  579.     Result := 0;
  580.   end;
  581. end;
  582.  
  583.  // 'fixes' the special Zip64  fields from extra data
  584.  // return <0 error, 0 none, 1 Zip64
  585. function TZMIRec.FixXData64: Integer;
  586. var
  587.   idx: Integer;
  588.   p: PAnsiChar;
  589.   wsz: Integer;
  590. begin
  591.   Result := 0;
  592.   if (VersionNeeded and VerMask) < ZIP64_VER then
  593.     exit;
  594.   if not XData(FExtraField, Zip64_data_tag, idx, wsz) then
  595.     Exit;
  596.   p := @fExtraField[idx];
  597.   Result := -DS_Zip64FieldError;  // new msg
  598.   Inc(p, 4);  // past header
  599.   Dec(wsz, 4);  // discount header
  600.   if UncompressedSize = MAX_UNSIGNED then
  601.   begin
  602.     if wsz < 8 then
  603.       exit;   // error
  604.     UncompressedSize := pInt64(p)^;
  605.     Inc(p, sizeof(Int64));
  606.     Dec(wsz, sizeof(Int64));
  607.   end;
  608.   if CompressedSize = MAX_UNSIGNED then
  609.   begin
  610.     if wsz < 8 then
  611.       exit;    // error
  612.     CompressedSize := pInt64(p)^;
  613.     Inc(p, sizeof(Int64));
  614.     Dec(wsz, sizeof(Int64));
  615.   end;
  616.   if RelOffLocal = MAX_UNSIGNED then
  617.   begin
  618.     if wsz < 8 then
  619.       exit;    // error
  620.     RelOffLocal := pInt64(p)^;
  621.     Inc(p, sizeof(Int64));
  622.     Dec(wsz, sizeof(Int64));
  623.   end;
  624.   if DiskStart = MAX_WORD then
  625.   begin
  626.     if wsz < 4 then
  627.       exit;   // error
  628.     DiskStart := pCardinal(p)^;
  629.   end;
  630.   Result := 1;
  631. end;
  632.  
  633. function TZMIRec.GetCompressedSize: Int64;
  634. begin
  635.   Result := fComprSize;
  636. end;
  637.  
  638. function TZMIRec.GetCompressionMethod: Word;
  639. begin
  640.   Result := fComprMethod;
  641. end;
  642.  
  643. function TZMIRec.GetCRC32: Cardinal;
  644. begin
  645.   Result := fCRC32;
  646. end;
  647.  
  648. // will return empty if not exists or invalid
  649. function TZMIRec.GetDataString(Cmnt: Boolean): UTF8String;
  650. var
  651.   crc: Cardinal;
  652.   field: TZMRawBytes;
  653.   idx: Integer;
  654.   pH: PUString_Data_Header;
  655.   pS: PAnsiChar;
  656.   siz: Integer;
  657.   tag: Word;
  658. begin
  659.   Result := '';
  660.   if Cmnt then
  661.   begin
  662.     tag := UCmnt_Data_Tag;
  663.     Field := HeaderComment;
  664.     if field = '' then
  665.       Exit; // no point checking
  666.   end
  667.   else
  668.   begin
  669.     tag := UPath_Data_Tag;
  670.     field := HeaderName;
  671.   end;
  672.   if FindDataTag(tag, idx, siz) then
  673.   begin
  674.     pS := @ExtraField[idx];
  675.     pH := PUString_Data_Header(pS);
  676.     if pH^.version = 1 then
  677.     begin
  678.       crc := CalcCRC32(field[1], Length(field), 0);
  679.       if pH^.origcrc = crc then
  680.       begin
  681.         siz := siz - sizeof(TUString_Data_Header);
  682.         Inc(pS, sizeof(TUString_Data_Header));
  683.         if (siz > 0) and (ValidUTF8(pS, siz) >= 0) then
  684.         begin
  685.           SetLength(Result, siz);
  686.           move(pS^, Result[1], siz);
  687.         end;
  688.       end;
  689.     end;
  690.   end;
  691. end;
  692.  
  693. function TZMIRec.GetDateTime: Cardinal;
  694. begin
  695.   Result := fModifDateTime;
  696. end;
  697.  
  698. function TZMIRec.GetDirty: Boolean;
  699. begin
  700.   Result := TestStatusBit(zsbDirty);
  701. end;
  702.  
  703. function TZMIRec.GetEncodeAs: TZMEncodingOpts;
  704. begin
  705.   Result := (Owner as TZMZipFile).EncodeAs;
  706. end;
  707.  
  708. {
  709.   Encoded as OEM for
  710.     DOS (default)                       FS_FAT
  711.     OS/2                                FS_HPFS
  712.     Win95/NT with Nico Mak's WinZip     FS_NTFS && host = 5.0
  713.   UTF8 is flag is set
  714.   except (someone always has to be different)
  715.     PKZIP (Win) 2.5, 2.6, 4.0 - mark as FS_FAT but local is Windows ANSI (1252)
  716.     PKZIP (Unix) 2.51 - mark as FS_FAT but are current code page
  717. }
  718. function TZMIRec.GetEncoded: TZMEncodingOpts;
  719. const
  720.   WZIP = $0B32;//(FS_NTFS * 256) + 50;
  721.   OS_HPFS = FS_HPFS * 256;
  722.   OS_FAT = FS_FAT * 256;
  723. begin
  724.   Result := zeoNone;
  725.  
  726.   if (Flag and FLAG_UTF8_BIT) <> 0 then
  727.     Result := zeoUTF8
  728.   else
  729.   if (GetDataString(false) <> '') or (GetDataString(True) <> '') then
  730.     Result := zeoUPath
  731.   else
  732.   if ((VersionMadeBy and OSMask) = OS_FAT) or
  733.       ((VersionMadeBy and OSMask) = OS_HPFS) or
  734.       (VersionMadeBy = WZIP) then
  735.     Result := zeoOEM;
  736. end;
  737.  
  738.  
  739. function TZMIRec.GetEncoding: TZMEncodingOpts;
  740. begin
  741.   Result := (Owner as TZMZipFile).Encoding;
  742. end;
  743.  
  744. function TZMIRec.GetEncrypted: Boolean;
  745. begin
  746.   Result := (fFlag and 1) <> 0;
  747. end;
  748.  
  749. function TZMIRec.GetExtFileAttrib: Longword;
  750. begin
  751.   Result := fExtFileAtt;
  752. end;
  753.  
  754. // returns the 'data' without the tag
  755. function TZMIRec.GetExtraData(Tag: Word): TZMRawBytes;
  756. var
  757.   i: Integer;
  758.   sz: Integer;
  759.   x: TZMRawBytes;
  760. begin
  761.   Result := '';
  762.   x := GetExtraField;
  763.   if XData(x, Tag, i, sz) then
  764.     Result := Copy(x, i + 4, sz - 4);
  765. end;
  766.  
  767. function TZMIRec.GetExtraField: TZMRawBytes;
  768. begin
  769.   Result := fExtraField;
  770. end;
  771.  
  772. function TZMIRec.GetExtraFieldLength: Word;
  773. begin
  774.   Result := Length(fExtraField);
  775. end;
  776.  
  777. function TZMIRec.GetFileComment: TZMString;
  778. begin
  779.   Result := Int2UTF(zrsComment, False);
  780. end;
  781.  
  782. function TZMIRec.GetFileCommentLen: Word;
  783. begin
  784.   Result := Length(HeaderComment);
  785. end;
  786.  
  787.  // returns the external filename interpretting the internal name by Encoding
  788.  // still in internal form
  789. function TZMIRec.GetFileName: TZMString;
  790. begin
  791.   if fFileName = '' then
  792.     fFileName := Int2UTF(zrsName, False);
  793.   Result := fFileName;
  794. end;
  795.  
  796. function TZMIRec.GetFileNameLength: Word;
  797. begin
  798.   Result := Length(HeaderName);
  799. end;
  800.  
  801. function TZMIRec.GetFlag: Word;
  802. begin
  803.   Result := fFlag;
  804. end;
  805.  
  806. function TZMIRec.GetHash: Cardinal;
  807. begin
  808.   if not TestStatusBit(zsbHashed) then
  809.   begin
  810.     fHash := HashFunc(FileName);
  811.     SetStatusBit(zsbHashed);
  812.   end;
  813.   Result := fHash;
  814. end;
  815.  
  816. function TZMIRec.GetHeaderComment: TZMRawBytes;
  817. begin
  818.   Result := fHeaderComment;
  819. end;
  820.  
  821. function TZMIRec.GetHeaderName: TZMRawBytes;
  822. begin
  823.   Result := fHeaderName;
  824. end;
  825.  
  826. function TZMIRec.GetIntFileAttrib: Word;
  827. begin
  828.   Result := fIntFileAtt;
  829. end;
  830.  
  831. function TZMIRec.GetIsEncoded: TZMEncodingOpts;
  832. var
  833.   n: Integer;
  834. begin
  835.   n := StatusBit[zsbEncMask] shr 16;
  836.   if n > ord(zeoUPath) then
  837.     n := 0;
  838.   if n = 0 then
  839.   begin
  840.     // unknown - work it out and cache result
  841.     Result := Encoded;
  842.     SetIsEncoded(Result);
  843.   end
  844.   else
  845.     Result := TZMEncodingOpts(n);
  846. end;
  847.  
  848. function TZMIRec.GetRelOffLocalHdr: Int64;
  849. begin
  850.   Result := fRelOffLocal;
  851. end;
  852.  
  853. function TZMIRec.GetSelected: Boolean;
  854. begin
  855.   Result := TestStatusBit(zsbSelected);
  856. end;
  857.  
  858. function TZMIRec.GetStartOnDisk: Word;
  859. begin
  860.   Result := fDiskStart;
  861. end;
  862.  
  863. function TZMIRec.GetStatusBit(Mask: Cardinal): Cardinal;
  864. begin
  865.   Result := StatusBits and mask;
  866. end;
  867.  
  868. function TZMIRec.GetStatusBits: Cardinal;
  869. begin
  870.   Result := fStatusBits;
  871. end;
  872.  
  873. function TZMIRec.GetUncompressedSize: Int64;
  874. begin
  875.   Result := fUnComprSize;
  876. end;
  877.  
  878. function TZMIRec.GetVersionMadeBy: Word;
  879. begin
  880.   Result := FVersionMadeBy;
  881. end;
  882.  
  883. function TZMIRec.GetVersionNeeded: Word;
  884. begin
  885.   Result := fVersionNeeded;
  886. end;
  887.  
  888. function TZMIRec.HasChanges: Boolean;
  889. begin
  890.   Result := (StatusBits and zsbDirty) <> 0;
  891. end;
  892.  
  893. function TZMIRec.Int2UTF(Field: TZMRecStrings; NoUD: Boolean = False):
  894.     TZMString;
  895. var
  896.   Enc: TZMEncodingOpts;
  897.   fld: TZMRawBytes;
  898. begin
  899.   if Field = zrsComment then
  900.     fld := HeaderComment
  901.   else
  902.     fld := HeaderName;
  903.   Result := '';
  904.   Enc := Encoding;
  905.   if Enc = zeoAuto then
  906.   begin
  907.     Enc := IsEncoded; // cached Encoded; // how entry is encoded
  908.     if NoUD and (Enc = zeoUPath) then
  909.       Enc := zeoOEM;  // use header Field
  910.   end;
  911.   if (Enc = zeoUPath) or StrHasExt(fld) then
  912.   begin
  913. {$IFDEF UNICODE}
  914.     case Enc of
  915.       // use UTF8 extra data string if available
  916.       zeoUPath: Result := UTF8ToWide(GetDataString(Field = zrsComment));
  917.       zeoNone:  // treat as Ansi (from somewhere)
  918.         Result := StrToUTFEx(fld, TZMZipFile(Owner).Encoding_CP, -1);
  919.       zeoUTF8:    // treat Field as being UTF8
  920.         Result := PUTF8ToWideStr(PAnsiChar(fld), Length(fld));
  921.       zeoOEM:    // convert to OEM
  922.         Result := StrToUTFEx(fld, CP_OEMCP, -1);
  923.     end;
  924. {$ELSE}
  925.     if Owner.Worker.UseUtf8 then
  926.     begin
  927.       case Enc of
  928.         // use UTF8 extra data string if available
  929.         zeoUPath: Result := GetDataString(Field = zrsComment);
  930.         zeoNone:  // treat as Ansi (from somewhere)
  931.             Result := StrToUTFEx(fld, TZMZipFile(Owner).Encoding_CP, -1);
  932.         zeoUTF8:    // treat Field as being UTF8
  933.             Result := fld;
  934.         zeoOEM:    // convert to OEM
  935.             Result := StrToUTFEx(fld, CP_OEMCP, -1);
  936.       end;
  937.     end
  938.     else
  939.     begin
  940.       case Enc of
  941.         // use UTF8 extra data string if available
  942.         zeoUPath: Result := UTF8ToSafe(GetDataString(Field = zrsComment), false);
  943.         zeoNone:  // treat as Ansi (from somewhere)
  944.             Result := StrToWideEx(fld, TZMZipFile(Owner).Encoding_CP, -1);  // will be converted
  945.         zeoUTF8:    // treat Field as being UTF8
  946.             Result := UTF8ToSafe(fld, false);
  947.         zeoOEM:    // convert to OEM
  948.             Result := StrToWideEx(fld, CP_OEMCP, -1);  // will be converted
  949.       end;
  950.     end;
  951. {$ENDIF}
  952.   end;
  953.   if length(Result) = 0 then
  954.     Result := String(fld); // better than nothing
  955.   if Field = zrsName then
  956.     Result := SetSlash(Result, psdExternal);
  957. end;
  958.  
  959. // test for invalid characters
  960. function IsInvalidIntName(const FName: TZMString): Boolean;
  961. var
  962.   c: Char;
  963.   clen: Integer;
  964.   i: Integer;
  965.   len: Integer;
  966.   n: Char;
  967.   p: Char;
  968. begin
  969.   Result := True;
  970.   len := Length(FName);
  971.   if (len < 1) or (len >= MAX_PATH) then
  972.     exit;                                   // empty or too long
  973.   c := FName[1];
  974.   if (c = PathDelim) or (c = '.') or (c = ' ') then
  975.     exit;                                   // invalid from root or below
  976.   i := 1;
  977.   clen := 0;
  978.   p := #0;
  979.   while i <= len do
  980.   begin
  981.     Inc(clen);
  982.     if clen > 255 then
  983.       exit; // component too long
  984.     c := FName[i];
  985.     if i < len then
  986.       n := FName[i + 1]
  987.     else
  988.       n := #0;
  989.     case c of
  990.       WILD_MULTI, DriveDelim, WILD_CHAR, '<', '>', '|', #0:
  991.         exit;
  992.       #1..#31:
  993.         exit; // invalid
  994.       PathDelimAlt:
  995.       begin
  996.         if p = ' ' then
  997.           exit;   // bad - component has Trailing space
  998.         if (n = c) or (n = '.') or (n = ' ') then
  999.           exit; // \\ . leading space invalid
  1000.         clen := 0;
  1001.       end;
  1002.       '.':
  1003.       begin
  1004.         n := FName[succ(i)];
  1005.         if (n = PathDelim) or (n < ' ') then
  1006.           exit;
  1007.       end;
  1008.       ' ':
  1009.         if i = len then
  1010.           exit;   // invalid
  1011.     end;
  1012.     p := c;
  1013.     Inc(i);
  1014.   end;
  1015.   Result := False;
  1016. end;
  1017.  
  1018. procedure TZMIRec.AfterConstruction;
  1019. begin
  1020.   inherited;
  1021.   fStatusBits := 0;
  1022. end;
  1023.  
  1024. procedure TZMIRec.BeforeDestruction;
  1025. begin
  1026.   fExtraField := '';
  1027.   fHeaderName := '';
  1028.   fHeaderComment := '';
  1029.   inherited;
  1030. end;
  1031.  
  1032. function TZMIRec.IsZip64: Boolean;
  1033. begin
  1034.   Result := (UncompressedSize >= MAX_UNSIGNED) or
  1035.     (CompressedSize >= MAX_UNSIGNED) or
  1036.     (RelOffLocal >= MAX_UNSIGNED) or (DiskStart >= MAX_WORD);
  1037. end;
  1038.  
  1039. // also calculate required version and create extra data
  1040. function TZMIRec.LocalSize: Cardinal;
  1041. begin
  1042.   Result := SizeOf(TZipLocalHeader);
  1043.   PrepareLocalData;    // form local extra data
  1044.   Inc(Result, FileNameLength + Length(LocalData));
  1045. end;
  1046.  
  1047. procedure TZMIRec.MarkDirty;
  1048. begin
  1049.   SetStatusBit(zsbDirty);
  1050. end;
  1051.  
  1052. procedure TZMIRec.FixMinimumVers(z64: boolean);
  1053. const
  1054.   OS_FAT: Word = (FS_FAT * 256);
  1055.   WZIP = (FS_NTFS * 256) + 50;
  1056. var
  1057.   NewNeed: Word;
  1058. begin
  1059.   if ((VersionMadeBy and VerMask) <= ZIP64_VER) and
  1060.       ((VersionNeeded and VerMask) <= ZIP64_VER) then
  1061.   begin
  1062. //    Enc := IsEncoded;
  1063.     if z64 then
  1064.       VersionMadeBy := (VersionMadeBy and OSMask) or ZIP64_VER
  1065.     else
  1066.     if (VersionMadeBy and VerMask) = ZIP64_VER then
  1067.     begin
  1068.       // zip64 no longer needed
  1069.       VersionMadeBy := (VersionMadeBy and OSMask) or OUR_VEM;
  1070.     end;
  1071.     // correct bad encodings - marked ntfs should be fat
  1072.     if VersionMadeBy = WZIP then
  1073.         VersionMadeBy := OS_FAT or OUR_VEM;
  1074.  
  1075.     case ComprMethod of
  1076.       0: NewNeed := 10;    // stored
  1077.       1..8: NewNeed := 20;
  1078.       9: NewNeed := 21;   // enhanced deflate
  1079.       10: NewNeed := 25;  // DCL
  1080.       12: NewNeed := 46;  // BZip2
  1081.     else
  1082.       NewNeed := ZIP64_VER;
  1083.     end;
  1084.     if ((Flag and 32) <> 0) and (NewNeed < 27) then
  1085.       NewNeed := 27;
  1086.     if z64 and (NewNeed < ZIP64_VER) then
  1087.       NewNeed := ZIP64_VER;
  1088.     // keep needed os
  1089.     VersionNeeded := (VersionNeeded and OSMask) + NewNeed;
  1090.   end;
  1091. end;
  1092.  
  1093. // process the record (base type does nothing)
  1094. // returns bytes written, <0 _ error
  1095. function TZMIRec.Process: Int64;
  1096. begin
  1097.   Result := 0;  // default, nothing done
  1098. end;
  1099.  
  1100. // size of data to process - excludes central directory (virtual)
  1101. function TZMIRec.ProcessSize: Int64;
  1102. begin
  1103.   Result := 0;// default nothing to process
  1104. end;
  1105.  
  1106. (*? TZMIRec.Read
  1107.   Reads directory entry
  1108.   returns
  1109.   >=0 = ok   (1 = Zip64)
  1110.   <0 = -error
  1111. *)
  1112. function TZMIRec.Read(wf: TZMWorkFile): Integer;
  1113. var
  1114.   CH: TZipCentralHeader;
  1115.   ExtraLen: Word;
  1116.   n: TZMRawBytes;
  1117.   r: Integer;
  1118.   v: Integer;
  1119. begin
  1120.   StatusBits := zsbInvalid;
  1121.   //  Diag('read central' );
  1122.   r := wf.Reads(CH, ZipCenRecFields);
  1123.   if r <> SizeOf(TZipCentralHeader) then
  1124.   begin
  1125.     Result := -DS_CEHBadRead;
  1126.     exit;
  1127.   end;
  1128.   if CH.HeaderSig <> CentralFileHeaderSig then
  1129.   begin
  1130.     Result := -DS_CEHWrongSig;
  1131.     exit;
  1132.   end;
  1133.   VersionMadeBy := CH.VersionMadeBy;
  1134.   VersionNeeded := CH.VersionNeeded;
  1135.   Flag := CH.Flag;
  1136.   ComprMethod := CH.ComprMethod;
  1137.   ModifDateTime := CH.ModifDateTime;
  1138.   CRC32 := CH.CRC32;
  1139.   FileNameLength := CH.FileNameLen;
  1140.   ExtraLen := CH.ExtraLen;
  1141.   FileCommentLen := CH.FileComLen;
  1142.   DiskStart := CH.DiskStart;
  1143.   IntFileAttrib := CH.IntFileAtt;
  1144.   ExtFileAttrib := CH.ExtFileAtt;
  1145.   RelOffLocal := CH.RelOffLocal;
  1146.   CompressedSize := CH.ComprSize;
  1147.   UncompressedSize := CH.UncomprSize;
  1148.   // read variable length fields
  1149.   v := FileNameLen + ExtraLen + FileComLen;
  1150.   SetLength(n, v);
  1151.   r := wf.Reads(n[1], [FileNameLen, ExtraLen, FileComLen]);
  1152.   if r <> v then
  1153.   begin
  1154.     Result := -DS_CECommentLen;
  1155.     if r < FileNameLen then
  1156.       Result := -DS_CENameLen
  1157.     else
  1158.     if r < (FileNameLen + ExtraLen) then
  1159.       Result := -LI_ReadZipError;
  1160.     exit;
  1161.   end;
  1162.   if FileComLen > 0 then
  1163.     fHeaderComment := copy(n, FileNameLen + ExtraLen + 1, FileComLen);
  1164.   if ExtraLen > 0 then
  1165.     fExtraField := copy(n, FileNameLen + 1, ExtraLen);
  1166.   SetLength(n, FileNameLen);
  1167.   fHeaderName := n;
  1168.   fOrigHeaderName := n;
  1169.   ClearStatusBit(zsbInvalid);   // record is valid
  1170.   if n[Length(n)] = PathDelimAlt then
  1171.     SetStatusBit(zsbDirOnly);   // dir only entry
  1172.   Result := FixXData64;
  1173. end;
  1174.  
  1175. procedure TZMIRec.PrepareLocalData;
  1176. var
  1177.   xd: Txdat64;
  1178.   Need64: Boolean;
  1179. begin
  1180.   LocalData := '';  // empty
  1181.   ClearStatusBit(zsbLocal64);
  1182.   // check for Zip64
  1183.   Need64 := (UncompressedSize >= MAX_UNSIGNED) or (CompressedSize >= MAX_UNSIGNED);
  1184.   FixMinimumVers(Need64);
  1185.   if Need64 then
  1186.   begin
  1187.     SetStatusBit(zsbLocal64);
  1188.     xd.tag := Zip64_data_tag;
  1189.     xd.siz := 16;
  1190.     xd.vals[0] := UncompressedSize;
  1191.     xd.vals[1] := CompressedSize;
  1192.     SetLength(fLocalData, 20);
  1193.     Move(xd.tag, PAnsiChar(LocalData)^, 20);
  1194.   end;
  1195.   // remove unwanted 'old' tags
  1196.   if ExtraFieldLength > 0 then
  1197.     LocalData := LocalData + XDataRemove(ExtraField,
  1198.       [Zip64_data_tag, Ntfs_data_tag, UCmnt_Data_Tag]);
  1199.   SetStatusBit(zsbLocalDone);
  1200. end;
  1201.  
  1202. function TZMIRec.SafeHeaderName(const IntName: TZMString): TZMString;
  1203. const
  1204.   BadChars : TSysCharSet = [#0..#31, ':', '<', '>', '|', '*', '?', #39, '\'];
  1205. var
  1206.   c: Char;
  1207.   i: integer;
  1208. Begin
  1209.   Result := '';
  1210.   for i := 1 to Length(IntName) do
  1211.   begin
  1212.     c := IntName[i];
  1213.     if (c <= #255) and (AnsiChar(c) in BadChars) then
  1214.     begin
  1215.       if c = '\' then
  1216.         Result := Result + PathDelimAlt
  1217.       else
  1218.         Result := Result + '#$' + IntToHex(Ord(c),2);
  1219.     end
  1220.     else
  1221.       Result := Result + c;
  1222.   end;
  1223. end;
  1224.  
  1225. function TZMIRec.SeekLocalData: Integer;
  1226. const
  1227.   // no signature
  1228.   LOHFlds: array [0..9] of Integer = (2, 2, 2, 2, 2, 4, 4, 4, 2, 2);
  1229. var
  1230.   did: Int64;
  1231.   i: Integer;
  1232.   InWorkFile: TZMWorkFile;
  1233.   LOH: TZipLocalHeader;
  1234.   t: Integer;
  1235.   v: TZMRawBytes;
  1236. begin
  1237.   ASSERT(assigned(Owner), 'no owner');
  1238.   InWorkFile := Owner;
  1239.   //  Diag('Seeking local');
  1240.   Result := -DS_FileOpen;
  1241.   if not InWorkFile.IsOpen then
  1242.     exit;
  1243.   Result := -DS_LOHBadRead;
  1244.   try
  1245.     InWorkFile.SeekDisk(DiskStart);
  1246.     InWorkFile.Position := RelOffLocal;
  1247.     did := InWorkFile.Read(LOH, 4);
  1248.     if (did = 4) and (LOH.HeaderSig = LocalFileHeaderSig) then
  1249.     begin         // was local header
  1250.       did := InWorkFile.Reads(LOH.VersionNeeded, LOHFlds);
  1251.       if did = (sizeof(TZipLocalHeader) - 4) then
  1252.       begin
  1253.         if LOH.FileNameLen = Length(OrigHeaderName) then
  1254.         begin
  1255.           t := LOH.FileNameLen + LOH.ExtraLen;
  1256.           SetLength(v, t);
  1257.           did := InWorkFile.Reads(v[1], [LOH.FileNameLen, LOH.ExtraLen]);
  1258.           if (did = t) then
  1259.           begin
  1260.             Result := 0;
  1261.             for i := 1 to LOH.FileNameLen do
  1262.             begin
  1263.               if v[i] <> OrigHeaderName[i] then
  1264.               begin
  1265.                 Result := -DS_LOHWrongName;
  1266.                 break;
  1267.               end;
  1268.             end;
  1269.           end;
  1270.         end;
  1271.         v := '';
  1272.       end;
  1273.     end;
  1274.     if Result = -DS_LOHBadRead then
  1275.       Diag('could not read local header: ' + FileName);
  1276.   except
  1277.     on E: EZipMaster do
  1278.     begin
  1279.       Result := -E.ResId;
  1280.       exit;
  1281.     end;
  1282.     on E: Exception do
  1283.     begin
  1284.       Result := -DS_UnknownError;
  1285.       exit;
  1286.     end;
  1287.   end;
  1288. end;
  1289.  
  1290. // returns the new value
  1291. function TZMIRec.Select(How: TZipSelects): Boolean;
  1292. begin
  1293.   case How of
  1294.     zzsClear:
  1295.       Result := False;
  1296.     zzsSet:
  1297.       Result := True;
  1298. //    zzsToggle:
  1299.     else
  1300.       Result := not TestStatusBit(zsbSelected);
  1301.   end;
  1302.   SetSelected(Result);
  1303. end;
  1304.  
  1305. procedure TZMIRec.SetDateStamp(Value: TDateTime);
  1306. begin
  1307.   DateTimeToFileDate(Value);
  1308. end;
  1309.  
  1310. procedure TZMIRec.SetEncrypted(const Value: Boolean);
  1311. begin
  1312.   if Value then
  1313.     Flag := Flag or 1
  1314.   else
  1315.     Flag := Flag and $FFFE;
  1316. end;
  1317.  
  1318. // assumes data contains the data with no header
  1319. procedure TZMIRec.SetExtraData(Tag: Word; const data: TZMRawBytes);
  1320. var
  1321.   after: Integer;
  1322.   afterLen: integer;
  1323.   nidx: Integer;
  1324.   ix: Integer;
  1325.   newXData: TZMRawBytes;
  1326.   dataSize: Word;
  1327.   sz: Integer;
  1328.   v: Integer;
  1329.   x: TZMRawBytes;
  1330. begin
  1331.   x := GetExtraField;
  1332.   XData(x, Tag, ix, sz); // find existing Tag
  1333.   v := Length(x) - sz;   // size after old tag removed
  1334.   if Length(data) > 0 then
  1335.     v := v + Length(data) + 4;
  1336.   if v > MAX_WORD then     // new length too big?
  1337.     exit;     // maybe give error
  1338.   dataSize := Length(data);
  1339.   SetLength(newXData, v);
  1340.   nidx := 1;  // next index into newXData
  1341.   if (dataSize > 0) then
  1342.   begin
  1343.     // prefix required tag
  1344.     newXData[1] := AnsiChar(Tag and MAX_BYTE);
  1345.     newXData[2] := AnsiChar(Tag shr 8);
  1346.     newXData[3] := AnsiChar(dataSize and MAX_BYTE);
  1347.     newXData[4] := AnsiChar(dataSize shr 8);
  1348.     // add the data
  1349.     Move(data[1], newXData[5], dataSize);
  1350.     Inc(nidx, dataSize + 4);
  1351.   end;
  1352.   if ix >= 1 then
  1353.   begin
  1354.     // had existing data
  1355.     if ix > 1 then
  1356.     begin
  1357.       // append data from before existing tag
  1358.       Move(x[1], newXData[nidx], ix - 1);
  1359.       Inc(nidx, ix);
  1360.     end;
  1361.     after := ix + sz; // index after replaced tag
  1362.     if after < Length(x) then
  1363.     begin
  1364.       // append data from after existing
  1365.       afterLen := Length(x) + 1 - after;
  1366.       Move(x[after], newXData[nidx], afterLen);
  1367.     end;
  1368.   end
  1369.   else
  1370.   begin
  1371.     // did not exist
  1372.     if Length(x) > 0 then
  1373.       Move(x[1], newXData[nidx], Length(x)); // append old extra data
  1374.   end;
  1375.   ExtraField := newXData;
  1376. end;
  1377.  
  1378. procedure TZMIRec.SetIsEncoded(const Value: TZMEncodingOpts);
  1379. var
  1380.   n: Integer;
  1381. begin
  1382.   n := Ord(Value) shl 16;
  1383.   ClearStatusBit(zsbEncMask); // clear all
  1384.   SetStatusBit(n);            // set new value
  1385. end;
  1386.  
  1387. procedure TZMIRec.SetSelected(const Value: Boolean);
  1388. begin
  1389.   if Selected <> Value then
  1390.   begin
  1391.     if Value then
  1392.       SetStatusBit(zsbSelected)
  1393.     else
  1394.     begin
  1395.       ClearStatusBit(zsbSelected);
  1396.       SelectArgs := '';
  1397.     end;
  1398.   end;
  1399. end;
  1400.  
  1401. function TZMIRec.SetStatusBit(const Value: Cardinal): Cardinal;
  1402. begin
  1403.   StatusBits := StatusBits or Value;
  1404.   Result := StatusBits;
  1405. end;
  1406.  
  1407. function TZMIRec.StrToSafe(const aString: TZMString; ToOem: boolean):
  1408.     AnsiString;
  1409. begin
  1410. {$IFDEF UNICODE}
  1411.   Result := WideToSafe(aString, ToOem);
  1412. {$ELSE}
  1413.   if Owner.Worker.UseUTF8 then
  1414.     Result := UTF8ToSafe(aString, ToOem)
  1415.   else
  1416.     Result := WideToSafe(aString, ToOem);
  1417. {$ENDIF}
  1418. end;
  1419.  
  1420. // converts to internal delimiter
  1421. function TZMIRec.StripDrive(const FName: TZMString; NoPath: Boolean): TZMString;
  1422. var
  1423.   nam: Integer;
  1424.   posn: Integer;
  1425. begin
  1426.   Result := SetSlash(FName, psdExternal);
  1427.   // Remove drive: or //host/share
  1428.   posn := 0;
  1429.   if length(Result) > 1 then
  1430.   begin
  1431.     if Result[1] = ':' then
  1432.     begin
  1433.       posn := 2;
  1434.       if (Length(Result) > 2) and (Result[3] = PathDelim{Alt}) then
  1435.         posn := 3;
  1436.     end
  1437.     else
  1438.     if (Result[1] = PathDelimAlt) and (Result[2] = PathDelim{Alt}) then
  1439.     begin
  1440.       posn := 3;
  1441.       while (posn < Length(Result)) and (Result[posn] <> PathDelim{Alt}) do
  1442.         Inc(posn);
  1443.       Inc(posn);
  1444.       while (posn < Length(Result)) and (Result[posn] <> PathDelimAlt) do
  1445.         Inc(posn);
  1446.       if posn >= Length(Result) then
  1447.       begin
  1448.         // error - invalid host/share
  1449.         Diag('Invalid filespec: ' + Result);
  1450.         Result := '';
  1451.         exit;// { TODO : handle error }
  1452.       end;
  1453.     end;
  1454.   end;
  1455.   Inc(posn);
  1456.   // remove leading ./
  1457.   if ((posn + 1) < Length(Result)) and (Result[posn] = '.') and
  1458.     (Result[posn + 1] = PathDelim) then
  1459.     posn := posn + 2;
  1460.   // remove path if not wanted
  1461.   if NoPath then
  1462.   begin
  1463.     nam := LastPos(Result, PathDelim);
  1464.     if nam > posn then
  1465.       posn := nam + 1;
  1466.   end;
  1467.   Result := Copy(Result, posn, MAX_PATH);
  1468. end;
  1469.  
  1470. function TZMIRec.StrToHeader(const aString: TZMString; how: THowToEnc):
  1471.     TZMRawBytes;
  1472. begin
  1473. {$IFDEF UNICODE}
  1474.   if how = hteUTF8 then
  1475.     Result  := TZMRawBytes(WideToUTF8(aString, -1))
  1476.   else
  1477.     Result  := TZMRawBytes(WideToSafe(aString, how = hteOEM));
  1478. {$ELSE}
  1479.   if Owner.Worker.UseUTF8 then
  1480.   begin
  1481.     if how = hteUTF8 then
  1482.       Result  := TZMRawBytes(aString)
  1483.     else
  1484.       Result  := TZMRawBytes(WideToSafe(UTF8ToWide(aString), how = hteOEM));
  1485.   end
  1486.   else
  1487.   begin
  1488.     case how of
  1489.       hteOEM: Result := TZMRawBytes(StrToOEM(aString));
  1490.       hteAnsi: Result := TZMRawBytes(aString);
  1491.       hteUTF8: Result := TZMRawBytes(StrToUTF8(aString));
  1492.     end;
  1493.   end;
  1494. {$ENDIF}
  1495. end;
  1496.  
  1497. function TZMIRec.StrToUTF8Header(const aString: TZMString): TZMRawBytes;
  1498. begin
  1499. {$IFDEF UNICODE}
  1500.   Result := UTF8String(aString);
  1501. {$ELSE}
  1502.   if Owner.Worker.UseUtf8 then
  1503.     Result := AsUTF8Str(aString) // make sure UTF8
  1504.   else
  1505.     Result  := StrToUTF8(aString);
  1506. {$ENDIF}
  1507. end;
  1508.  
  1509. function TZMIRec.StrTo_UTF8(const aString: TZMString): UTF8String;
  1510. begin
  1511. {$IFDEF UNICODE}
  1512.   Result := UTF8String(aString);
  1513. {$ELSE}
  1514.   if Owner.Worker.UseUtf8 then
  1515.     Result := AsUTF8Str(aString) // make sure UTF8
  1516.   else
  1517.     Result  := StrToUTF8(aString);
  1518. {$ENDIF}
  1519. end;
  1520.  
  1521. function TZMIRec.TestStatusBit(const mask: Cardinal): Boolean;
  1522. begin
  1523.   Result := (StatusBits and mask) <> 0;
  1524. end;
  1525.  
  1526. function TZMIRec.ToIntForm(const nname: TZMString; var iname: TZMString):
  1527.     Integer;
  1528. var
  1529.   temp: TZMString;
  1530. begin
  1531.   Result := 0;
  1532.   iname := StripDrive(nname, not (AddDirNames in Owner.Worker.AddOptions));
  1533.   // truncate if too long
  1534.   if Length(iname) > MAX_PATH then
  1535.   begin
  1536.     temp := iname;
  1537.     SetLength(iname, MAX_PATH);
  1538.     Diag('Truncated ' + temp + ' to ' + iname);
  1539.   end;
  1540.   if IsInvalidIntName(iname) then
  1541.     Result := -AD_BadFileName;
  1542. end;
  1543.  
  1544.  // write the central entry on it's owner
  1545.  // return bytes written (< 0 = -Error)
  1546. function TZMIRec.Write: Integer;
  1547. var
  1548.   CH: PZipCentralHeader;
  1549.   l: Integer;
  1550.   Need64: Boolean;
  1551.   ni: TZMRawBytes;
  1552.   p: pByte;
  1553.   pb: pByte;
  1554.   r: Integer;
  1555.   siz: Word;
  1556.   vals: array [0..4] of Int64;
  1557.   wf: TZMWorkFile;
  1558.   x: TZMRawBytes;
  1559. begin
  1560.   wf := Owner;
  1561.   ASSERT(assigned(wf), 'no WorkFile');
  1562.   //  Diag('Write central');
  1563.   Result := -1;
  1564.   if not wf.IsOpen then
  1565.     exit;
  1566.   fOrigHeaderName := HeaderName;  // might have changed
  1567.   pb := wf.WBuffer(sizeof(TZipCentralHeader));
  1568.   CH := PZipCentralHeader(pb);
  1569.   ni := HeaderName;
  1570.   CH^.HeaderSig := CentralFileHeaderSig;
  1571.   CH^.VersionMadeBy := VersionMadeBy;
  1572.   CH^.VersionNeeded := VersionNeeded;  // assumes local was written - may be updated
  1573.   CH^.Flag := Flag;
  1574.   CH^.ComprMethod := ComprMethod;
  1575.   CH^.ModifDateTime := ModifDateTime;
  1576.   CH^.CRC32 := CRC32;
  1577.   CH^.FileNameLen := length(ni);
  1578.   CH^.FileComLen := Length(HeaderComment);
  1579.   CH^.IntFileAtt := IntFileAttrib;
  1580.   CH^.ExtFileAtt := ExtFileAttrib;
  1581.  
  1582.   siz := 0;
  1583.   if (UncompressedSize >= MAX_UNSIGNED) then
  1584.   begin
  1585.     vals[0] := UncompressedSize;
  1586.     siz := 8;
  1587.     CH^.UncomprSize := MAX_UNSIGNED;
  1588.   end
  1589.   else
  1590.     CH^.UncomprSize := Cardinal(UncompressedSize);
  1591.  
  1592.   if (CompressedSize >= MAX_UNSIGNED) then
  1593.   begin
  1594.     vals[siz div 8] := CompressedSize;
  1595.     Inc(siz, 8);
  1596.     CH^.ComprSize := MAX_UNSIGNED;
  1597.   end
  1598.   else
  1599.     CH^.ComprSize := Cardinal(CompressedSize);
  1600.  
  1601.   if (RelOffLocal >= MAX_UNSIGNED) then
  1602.   begin
  1603.     vals[siz div 8] := RelOffLocal;
  1604.     Inc(siz, 8);
  1605.     CH^.RelOffLocal := MAX_UNSIGNED;
  1606.   end
  1607.   else
  1608.     CH^.RelOffLocal := Cardinal(RelOffLocal);
  1609.  
  1610.   if (DiskStart >= MAX_WORD) then
  1611.   begin
  1612.     vals[siz div 8] := DiskStart;
  1613.     Inc(siz, 4);
  1614.     CH^.DiskStart := MAX_WORD;
  1615.   end
  1616.   else
  1617.     CH^.DiskStart := Word(DiskStart);
  1618.   Need64 := False;
  1619.   if siz > 0 then
  1620.   begin
  1621.     SetLength(x, siz);
  1622.     move(vals[0], x[1], siz);
  1623.     Need64 := True;
  1624.     if (VersionNeeded and MAX_BYTE) < ZIP64_VER then
  1625.     begin
  1626.       FixMinimumVers(True);
  1627.       CH^.VersionNeeded := VersionNeeded;
  1628.       CH^.VersionMadeBy := VersionMadeBy;
  1629.     end;
  1630.     ExtraData[Zip64_data_tag] := x;
  1631.   end
  1632.   else
  1633.     ExtraData[Zip64_data_tag] := ''; // remove old 64 data
  1634.   if (StatusBit[zsbLocalDone] = 0) or (Need64) then
  1635.     FixMinimumVers(Need64);
  1636.   CH^.VersionMadeBy := VersionMadeBy;
  1637.   CH^.VersionNeeded := VersionNeeded;
  1638.   x := '';
  1639.   CH^.ExtraLen := ExtraFieldLength;
  1640.   Result := -DS_CEHBadWrite;
  1641.   l  := sizeof(TZipCentralHeader) + CH^.FileNameLen + CH^.ExtraLen +
  1642.     CH^.FileComLen;
  1643.   pb := wf.WBuffer(l);
  1644.   p  := pb;
  1645.   Inc(p, sizeof(TZipCentralHeader));
  1646.   move(ni[1], p^, CH^.FileNameLen);
  1647.   Inc(p, CH^.FileNameLen);
  1648.   if CH^.ExtraLen > 0 then
  1649.   begin
  1650.     move(ExtraField[1], p^, CH^.ExtraLen);
  1651.     Inc(p, CH^.ExtraLen);
  1652.   end;
  1653.   if CH^.FileComLen > 0 then
  1654.     move(HeaderComment[1], p^, CH^.FileComLen);
  1655.   r := wf.Write(pb^, -l);
  1656.   if r = l then
  1657.   begin
  1658.     //    Diag('  Write central ok');
  1659.     Result := r;
  1660.     ClearStatusBit(zsbDirty);
  1661.   end//;
  1662.   else
  1663.   if r < 0 then
  1664.     Result := r;
  1665. end;
  1666.  
  1667. function TZMIRec.WriteAsLocal: Integer;
  1668. begin
  1669.   Result := WriteAsLocal1(ModifDateTime, CRC32);
  1670. end;
  1671.  
  1672. // write local header using specified stamp and crc
  1673. // return bytes written (< 0 = -Error)
  1674. function TZMIRec.WriteAsLocal1(Stamp, crc: Cardinal): Integer;
  1675. var
  1676.   cd: TZMRawBytes;
  1677.   fnlen: Integer;
  1678.   i: Integer;
  1679.   LOH: PZipLocalHeader;
  1680.   need64: Boolean;
  1681.   ni: TZMRawBytes;
  1682.   p: pByte;
  1683.   pb: pByte;
  1684.   t: Integer;
  1685.   wf: TZMWorkFile;
  1686. begin
  1687.   wf := Owner;
  1688.   ASSERT(assigned(wf), 'no WorkFile');
  1689.   if StatusBit[zsbLocalDone] = 0 then
  1690.     PrepareLocalData;
  1691.   LOH := PZipLocalHeader(wf.WBuffer(sizeof(TZipLocalHeader)));
  1692.   if ((Flag and 9) = 8) then
  1693.     Flag := Flag and $FFF7; // remove extended local data if not encrypted
  1694.   ni := HeaderName;
  1695.   fnlen := length(ni);
  1696.   LOH^.HeaderSig := LocalFileHeaderSig;
  1697.   LOH^.VersionNeeded := VersionNeeded;   // may be updated
  1698.   LOH^.Flag := Flag;
  1699.   LOH^.ComprMethod := ComprMethod;
  1700.   LOH^.ModifDateTime := Stamp;
  1701.   LOH^.CRC32 := crc;
  1702.   LOH^.FileNameLen := fnlen;
  1703.   cd := LocalData;
  1704.   LOH^.ExtraLen := Length(cd); // created by LocalSize
  1705.   need64 := (LOH^.ExtraLen > 0) and (StatusBit[zsbLocal64] <> 0);
  1706.   if need64 then
  1707.   begin
  1708.     LOH^.UnComprSize := MAX_UNSIGNED;
  1709.     LOH^.ComprSize := MAX_UNSIGNED;
  1710.   end
  1711.   else
  1712.   begin
  1713.     if (Flag and 8) <> 0 then
  1714.     begin
  1715.       LOH^.UnComprSize := 0;
  1716.       LOH^.ComprSize := 0;
  1717.       if (VersionNeeded and MAX_BYTE) < ZIP64_VER then
  1718.       begin
  1719.         FixMinimumVers(True);
  1720.         LOH^.VersionNeeded := VersionNeeded;
  1721.       end;
  1722.     end
  1723.     else
  1724.     begin
  1725.       LOH^.UnComprSize := Cardinal(UncompressedSize);
  1726.       LOH^.ComprSize := Cardinal(CompressedSize);
  1727.     end;
  1728.   end;
  1729.   t := fnlen + Length(cd);
  1730.   pb := wf.WBuffer(sizeof(TZipLocalHeader) + t);
  1731.   p  := pb;
  1732.   Inc(p, sizeof(TZipLocalHeader));
  1733.   i := Sizeof(TZipLocalHeader);  // i = destination index
  1734.   Move(ni[1], p^, fnlen);
  1735.   i := i + fnlen;
  1736.   Inc(p, fnlen);
  1737.   // copy any extra data
  1738.   if Length(cd) > 0 then
  1739.   begin
  1740.     Move(cd[1], p^, Length(cd));
  1741.     Inc(i, Length(cd));
  1742.   end;
  1743.   Result := wf.Write(pb^, -i);  // must fit
  1744.   if Result = i then
  1745.     ClearStatusBit(zsbDirty)
  1746.   else
  1747.     Result := -DS_LOHBadWrite;
  1748. end;
  1749.  
  1750. // return bytes written (< 0 = -Error)
  1751. function TZMIRec.WriteDataDesc(OutZip: TZMWorkFile): Integer;
  1752. var
  1753.   d: TZipDataDescriptor;
  1754.   d64: TZipDataDescriptor64;
  1755.   r: Integer;
  1756. begin
  1757.   ASSERT(assigned(OutZip), 'no WorkFile');
  1758.   if (Flag and 8) <> 0 then
  1759.   begin
  1760.     Result := 0;
  1761.     exit;
  1762.   end;
  1763.   Result := -DS_DataDesc;
  1764.   if (VersionNeeded and MAX_BYTE) < ZIP64_VER then
  1765.   begin
  1766.     d.DataDescSig := ExtLocalSig;
  1767.     d.CRC32 := CRC32;
  1768.     d.ComprSize := Cardinal(CompressedSize);
  1769.     d.UnComprSize := Cardinal(UncompressedSize);
  1770.     r := OutZip.Write(d, -sizeof(TZipDataDescriptor));
  1771.     if r = sizeof(TZipDataDescriptor) then
  1772.       Result := r;
  1773.   end
  1774.   else
  1775.   begin
  1776.     d64.DataDescSig := ExtLocalSig;
  1777.     d64.CRC32 := CRC32;
  1778.     d64.ComprSize := CompressedSize;
  1779.     d64.UnComprSize := UncompressedSize;
  1780.     r := OutZip.Write(d64, -sizeof(TZipDataDescriptor64));
  1781.     if r = sizeof(TZipDataDescriptor64) then
  1782.       Result := r;
  1783.   end;
  1784. end;
  1785.  
  1786. // Return true if found
  1787. // if found return idx --> tag, size = tag + data
  1788. function XData(const x: TZMRawBytes; Tag: Word; var idx, size: Integer):
  1789.     Boolean;
  1790. var
  1791.   i: Integer;
  1792.   l: Integer;
  1793.   wsz: Word;
  1794.   wtg: Word;
  1795. begin
  1796.   Result := False;
  1797.   idx := 0;
  1798.   size := 0;
  1799.   i := 1;
  1800.   l := Length(x);
  1801.   while i < l - 4 do
  1802.   begin
  1803.     wtg := pWord(@x[i])^;
  1804.     wsz := pWord(@x[i + 2])^;
  1805.     if wtg = Tag then
  1806.     begin
  1807.       Result := (i + wsz + 4) <= l + 1;
  1808.       if Result then
  1809.       begin
  1810.         idx  := i;
  1811.         size := wsz + 4;
  1812.       end;
  1813.       break;
  1814.     end;
  1815.     i := i + wsz + 4;
  1816.   end;
  1817. end;
  1818.  
  1819. function XData_HasTag(tag: Integer; const tags: array of Integer): Boolean;
  1820. var
  1821.   ii: Integer;
  1822. begin
  1823.   Result := False;
  1824.   for ii := 0 to HIGH(tags) do
  1825.     if tags[ii] = tag then
  1826.     begin
  1827.       Result := True;
  1828.       break;
  1829.     end;
  1830. end;
  1831.  
  1832. function XDataAppend(var x: TZMRawBytes; const src1; siz1: Integer; const src2;
  1833.     siz2: Integer): Integer;
  1834. var
  1835.   newlen: Integer;
  1836. begin
  1837.   Result := Length(x);
  1838.   if (siz1 < 0) or (siz2 < 0) then
  1839.     exit;
  1840.   newlen := Result + siz1 + siz2;
  1841.   SetLength(x, newlen);
  1842.   Move(src1, x[Result + 1], siz1);
  1843.   Result := Result + siz1;
  1844.   if siz2 > 0 then
  1845.   begin
  1846.     Move(src2, x[Result + 1], siz2);
  1847.     Result := Result + siz2;
  1848.   end;
  1849. end;
  1850.  
  1851. function XDataKeep(const x: TZMRawBytes; const tags: array of Integer):
  1852.     TZMRawBytes;
  1853. var
  1854.   di: Integer;
  1855.   i: Integer;
  1856.   l: Integer;
  1857.   siz: Integer;
  1858.   wsz: Word;
  1859.   wtg: Word;
  1860. begin
  1861.   Result := '';
  1862.   siz := 0;
  1863.   l := Length(x);
  1864.   if l < 4 then
  1865.     exit;  // invalid
  1866.   i := 1;
  1867.   while i <= l - 4 do
  1868.   begin
  1869.     wtg := pWord(@x[i])^;
  1870.     wsz := pWord(@x[i + 2])^;
  1871.     if (XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
  1872.     begin
  1873.       Inc(siz, wsz + 4);
  1874.     end;
  1875.     i := i + wsz + 4;
  1876.   end;
  1877.   SetLength(Result, siz);
  1878.   di := 1;
  1879.   i  := 1;
  1880.   while i <= l - 4 do
  1881.   begin
  1882.     wtg := pWord(@x[i])^;
  1883.     wsz := pWord(@x[i + 2])^;
  1884.     if (XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
  1885.     begin
  1886.       wsz := wsz + 4;
  1887.       while wsz > 0 do
  1888.       begin
  1889.         Result[di] := x[i];
  1890.         Inc(di);
  1891.         Inc(i);
  1892.         Dec(wsz);
  1893.       end;
  1894.     end
  1895.     else
  1896.       i := i + wsz + 4;
  1897.   end;
  1898. end;
  1899.  
  1900.  
  1901. function XDataRemove(const x: TZMRawBytes; const tags: array of Integer):
  1902.     TZMRawBytes;
  1903. var
  1904.   di: Integer;
  1905.   i: Integer;
  1906.   l: Integer;
  1907.   siz: Integer;
  1908.   wsz: Word;
  1909.   wtg: Word;
  1910. begin
  1911.   Result := '';
  1912.   siz := 0;
  1913.   l := Length(x);
  1914.   if l < 4 then
  1915.     exit;  // invalid
  1916.   i := 1;
  1917.   while i <= l - 4 do
  1918.   begin
  1919.     wtg := pWord(@x[i])^;
  1920.     wsz := pWord(@x[i + 2])^;
  1921.     if (not XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
  1922.     begin
  1923.       Inc(siz, wsz + 4);
  1924.     end;
  1925.     i := i + wsz + 4;
  1926.   end;
  1927.   SetLength(Result, siz);
  1928.   di := 1;
  1929.   i  := 1;
  1930.   while i <= l - 4 do
  1931.   begin
  1932.     wtg := pWord(@x[i])^;
  1933.     wsz := pWord(@x[i + 2])^;
  1934.     if (not XData_HasTag(wtg, tags)) and ((i + wsz + 4) <= l + 1) then
  1935.     begin
  1936.       wsz := wsz + 4;
  1937.       while wsz > 0 do
  1938.       begin
  1939.         Result[di] := x[i];
  1940.         Inc(di);
  1941.         Inc(i);
  1942.         Dec(wsz);
  1943.       end;
  1944.     end
  1945.     else
  1946.       i := i + wsz + 4;
  1947.   end;
  1948. end;
  1949.  
  1950. end.
  1951.