Abbrevia is a compression toolkit for Embarcadero Delphi, C++ Builder, and Kylix, and FreePascal. It supports PKZip, Microsoft CAB, tar, gzip, bzip2 and zlib compression formats, and the creation of self-extracting executables. It includes several visual components that simplify displaying zip files.
\n\n
Abbrevia 5.0 adds a number of new features and support for more platforms:
\n\n
\n
RAD Studio XE2 support, including both 64-bit Windows and OS X
\n
FreePascal support on Windows, OS X, and Linux
\n
TAbTreeView and TAbListView VCL controls that provide an Explorer/WinZip-like interface
\n
ZIP64 support, for archives larger than 2GB
\n
Improved split/spanned zip support
\n
Expanded LZMA support
\n
Unicode filenames in tar and gzip archives
\n
\n\n
This is a source-only release. It includes design-time and run-time packages for Delphi 6 through Delphi XE2, C++Builder 2009 through XE2, and Kylix 3. FreePascal is supported, but runtime/design time packages are not included. The LZMA, PPMd, and WavPack algorithms are only supported on Delphi/C++Builder for Windows (32 and 64-bit).
Unzip the release files into a directory (e.g., d:\\abbrevia).
\n
Start Delphi or C++Builder.
\n
Add the source subdirectory (e.g. d:\\abbrevia\\source) to the Delphi Library path. When using XE2 or later, add it to all platforms.
\n
If using C++Builder, add the source subdirectory to C++Builder's Include and Library paths.
\n
Open the project group in the packages directory that corresponds to the IDE being used (e.g. \"Delphi XE2.groupproj\").
\n
Start at the top of the project group and compile each package in turn. If using C++Builder, install each one after compiling.
\n
Select the \"AbbreviaVCLDesign\" package and install it. The IDE should notify you that the components have been installed. If you are using Delphi 7 you can install \"AbbreviaCLXDesign\" as well to get CLX designtime support.
\n
Make sure the PATH environmental variable contains the directory in which the compiled packages (i.e. BPL or DPL files) were placed.
Support forums are available on the SourceForge project site.
\n\n
Bug reports can be entered in the bug tracker. If possible please include a small test case that reproduces the issue. Sample files can be attached to the bug report, and confidential data can be emailed to the project administrator.
\n\n
If you have something you would like to see in the product feel free to add a feature request.
The current source code is available in the Subversion repository. The code here may not be as stable or tested as the official releases, but may include bug fixes or new features not yet included in the downloadable releases.
\n\n
The repository also includes DUnit tests, the source code to the third-party libraries, and the Help source code.
If you want to help make Abbrevia better, there are several ways to get involved. We welcome help with features and bug fixes. Just look in the issue tracker to see what's needed. We're also looking for help for:
Abbrevia is licensed under the Mozilla Public License, version 1.1. It can be used in commercial and closed-source applications provided any changes to Abbrevia units are made available electronically.
\n\n
The WavPack library used for zipx decompression has its own license, included as \"WavPack License.txt\". Redistribution requires a copyright notice in your documentation or elsewhere in your distribution. WavPack support can be removed by disabling the UnzipZipxSupport or UnzipWavPackSupport conditional define in AbDefine.inc.
These are the most significant features, fixes and changes made since v4.0. Information on earlier versions is available in the full changelog.
\n\n
Features
\n\n
\n
Added support for Delphi/C++Builder XE2, including the 64-bit Windows and OS X platforms.
\n
Added support for FreePascal 2.4/2.6 on Windows, OS X, and Linux.
\n
Added TAbTreeView and TAbListView VCL controls that provide an Explorer/WinZip-like interface, and ComCtrlsDemo Delphi example to demonstrate their usage.
\n
Added ZIP64 support (reading/writing zip archives larger than 2GB, containing files larger than 2GB, or containing more than 65K files).
\n
Significantly improved split/spanned zip support.
\n
Added LZMA buffer-to-buffer compression/decompression (LzmaEncodeBuffer and LzmaDecodeBuffer) and compression/decompression stream descendants (TAbLZMACompressionStream and TAbLZMADecompressionStream). Thanks to Pierre le Riche.
\n
Added support for tar and gzip archives containing filenames encoded in the system ANSI and OEM codepage and UTF-8. New archives are written using UTF-8.
\n
Added icon/text to RAD Studio's splash screen and about box. Thanks to Lance Rasmussen.
\n
Added VCL TAbProgressBar control that can replace TAbMeter.
\n
Added 64-bit COM dll and support for per-user registration.
\n
\n\n
API Changes
\n\n
\n
Renamed LzEncode/LzDecode to LzmaEncodeStream/LzmaDecodeStream.
\n
Renamed LzmaDecode to LzmaDecodeStream.
\n
Various changes due to split/spanned zip changes (see below).
\n
\n\n
Bug Fixes
\n\n
\n
Fixed support for opening paths with a \"\\\\?\\\" prefix.
\n
Fixed buffer overflow in AbUtils.pas.
\n
Fixed freshening/replacing items using absolute paths.
\n
Fixed CAB files created with Delphi 2009 and later incorrectly including the \"has next volume\" flag.
\n
Fixed Delphi 6 support. Thanks to Peter Luijer.
\n
Fixed AbFindFiles so it finds system and hidden folders if the SearchAttr parameter includes them [3372355].
\n
Fixed hang when trying to extract files that cross CAB boundaries when the next cab is not available [3370538].
\n
Fixed extracting CAB archives so OnProcessItemFailure isn't called after a successful extraction.
\n
Fixed LZMA support for streams larger than 2GB.
\n
Fixed AbGetDriveFreeSpace buffer overflow and fixed support for free space larger than 2GB.
\n
Fixed support for modifying SFX zips with non-native stubs (Linux on Windows and vice versa).
\n
Fixed TAbBitBucketStream so it doesn't fault on writes larger than the buffer size, and supports sizes over 2GB.
\n
Zip local file headers are now preserved when copying unmodified files to a new archive.
\n
Local file headers are no longer copies of the central directory headers, since many of the defined extra data fields have different values in the two locations.
\n
Fixed IZipKit (COM) support for enumerations (for each).
\n
\n\n
Split/Spanned Zip Changes
\n\n
\n
\n
Bug Fixes
\n
\n
Added support for reading/writing unequally sized spans.
\n
Split/spanned zips are now written to the final location as they're compressed, rather than writing everything to a virtual memory stream first.
\n
Fixed writing headers that can't be spanned so they trigger a new span if necessary.
\n
\n
\n
\n
API Changes
\n
\n
Converting from an unspanned archive to a spanned one is no longer supported.
\n
OnRequestImage's span numbers are now 1-based instead of 0-based to match OnRequestNthDisk.
\n
OnArchiveSaveProgress is now called at the same time as OnArchiveProgress, since there isn't a lengthy copy after a spanned archive is written.
\n
TAbSpanStream has been replaced by TAbSpanReadStream and TAbSpanWriteStream.
\n
\n
\n
\n\n\n"
},
{
"path": "lib/abbrevia/WavPack License.txt",
"content": " Copyright (c) 1998 - 2009 Conifer Software\n All rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n\n * Redistributions of source code must retain the above copyright notice,\n this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above copyright notice,\n this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n * Neither the name of Conifer Software nor the names of its contributors\n may be used to endorse or promote products derived from this software\n without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS \"AS IS\"\nAND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\nIMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\nARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR\nANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Abbrexam.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ABBREXAM.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram Abbrexam;\n\n{$R *.res}\n\nuses\n Forms,\n udemodlg in 'udemodlg.pas' {DemoDlg},\n uexample in 'Uexample.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.CreateForm(TForm1, Form1);\n Application.CreateForm(TDemoDlg, DemoDlg);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/BaseDlgu.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit Basedlgu;\n\ninterface\n\nuses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,\n StdCtrls, FileCtrl, ExtCtrls;\n\ntype\n TBaseDlg = class(TForm)\n Bevel1: TBevel;\n DirectoryListBox1: TDirectoryListBox;\n CancelBtn: TButton;\n OkBtn: TButton;\n procedure DirectoryListBox1Change(Sender: TObject);\n procedure FormShow(Sender: TObject);\n private\n { Private declarations }\n public\n BaseDirectory : string;\n end;\n\nvar\n BaseDlg: TBaseDlg;\n\nimplementation\n\n{$R *.DFM}\n\n\nprocedure TBaseDlg.DirectoryListBox1Change(Sender: TObject);\nbegin\n BaseDirectory := DirectoryListBox1.Directory;\nend;\n\nprocedure TBaseDlg.FormShow(Sender: TObject);\nbegin\n DirectoryListBox1.Directory := BaseDirectory;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CabExt.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UNZIP.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram CabExt;\n\nuses\n Forms,\n CabExt1 in 'CabExt1.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CabExt1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: EXTCAB.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit CabExt1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,\n\n AbArcTyp, AbCBrows, ComCtrls, AbCabExt, AbCabTyp, AbBase, AbBrowse, AbMeter, AbUtils;\n\ntype\n TForm1 = class(TForm)\n Button1: TButton;\n OpenDialog1: TOpenDialog;\n Memo1: TMemo;\n Label1: TLabel;\n Button2: TButton;\n AbMeter1: TAbMeter;\n AbCabExtractor1: TAbCabExtractor;\n procedure Button1Click(Sender: TObject);\n procedure AbCabExtractor1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\n procedure Button2Click(Sender: TObject);\n procedure FormClose(Sender: TObject; var Action: TCloseAction);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n MainCaption = 'Cabinet Extractor';\n\nvar\n AbortFlag : Boolean;\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n if OpenDialog1.Execute then begin\n with AbCabExtractor1 do begin\n FileName := OpenDialog1.FileName;\n BaseDirectory := ExtractFilePath(FileName);\n Cursor := crHourglass;\n try\n ExtractFiles('*.*');\n except {swallow exception if aborted}\n end;\n Cursor := crDefault;\n end;\n end;\n Caption := MainCaption;\n AbortFlag := False;\nend;\n\nprocedure TForm1.AbCabExtractor1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType; var Confirm: Boolean);\nbegin\n Caption := 'Extracting ' + Item.Filename;\n Confirm := not AbortFlag;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nbegin\n AbortFlag := True;\nend;\n\nprocedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);\nbegin\n AbCabExtractor1.FileName := '';\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CabFind.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: FINDER.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram CabFind;\n\nuses\n Forms,\n CabFind1 in 'CabFind1.pas' {Form1};\n\nbegin\n\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CabFind1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: CABFIND1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit CabFind1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, FileCtrl, Buttons, ExtCtrls,\n\n AbArcTyp, AbBrowse, AbCBrows, AbBase;\n\ntype\n TForm1 = class(TForm)\n Edit1: TEdit;\n Label1: TLabel;\n Memo1: TMemo;\n DriveComboBox1: TDriveComboBox;\n DirectoryListBox1: TDirectoryListBox;\n FileListBox1: TFileListBox;\n Memo2: TMemo;\n Label2: TLabel;\n AbCabBrowser1: TAbCabBrowser;\n Button1: TButton;\n Button2: TButton;\n procedure FormClose(Sender: TObject; var Action: TCloseAction);\n procedure Edit1Change(Sender: TObject);\n procedure Button1Click(Sender: TObject);\n procedure Button2Click(Sender: TObject);\n private\n { Private declarations }\n Aborted: Boolean;\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);\nbegin\n Aborted := True;\nend;\n\nprocedure TForm1.Edit1Change(Sender: TObject);\nbegin\n Button1.Enabled := Length( Edit1.Text ) > 0;\nend;\n\nprocedure TForm1.Button1Click(Sender: TObject);\nvar\n i : Integer;\n CurFile : string;\nbegin\n Button1.Enabled := False;\n Memo1.Clear;\n try\n Button2.Enabled := True;\n Aborted := False;\n {look in the file list box for the file}\n for i := 0 to pred( FileListBox1.Items.Count ) do begin\n Application.ProcessMessages;\n if Aborted then\n break;\n if CompareText( Edit1.Text, FileListBox1.Items[i] ) = 0 then begin\n Memo1.Lines.Add( 'Found in ' + FileListBox1.Directory );\n break;\n end;\n {now add search of zip and self extracting files}\n CurFile := UpperCase( FileListBox1.Items[i] );\n if ( Pos( '.CAB', CurFile ) > 0 ) then begin\n try\n AbCabBrowser1.FileName := FileListBox1.Items[i];\n if AbCabBrowser1.FindFile(Edit1.Text) >= 0 then\n Memo1.Lines.Add( 'Found in ' + FileListBox1.Items[i] );\n except\n end;\n end;\n end;\n finally\n Memo1.Lines.Add( 'Done!' );\n Edit1.Enabled := True;\n Button1.Enabled := True;\n Button2.Enabled := False;\n end;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nbegin\n Aborted := True;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CabView.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nprogram CabView;\n\nuses\n Forms,\n CabView1 in 'CabView1.PAS' {Form1};\n\nbegin\n Application.Initialize;\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CabView1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: CABVIEW1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit CabView1;\n\ninterface\n\nuses\n SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,\n Forms, Dialogs, Grids, StdCtrls, ExtCtrls, Menus, FileCtrl,\n\n AbArcTyp, AbCabTyp, AbMeter, AbDlgDir, AbView, AbCView, AbCBrows,\n AbBrowse, AbCabMak, AbCabKit, AbBase, AbUtils;\n\ntype\n TForm1 = class(TForm)\n OpenDialog1: TOpenDialog;\n Panel1: TPanel;\n FontDialog1: TFontDialog;\n MainMenu1: TMainMenu;\n File1: TMenuItem;\n Open1: TMenuItem;\n Close1: TMenuItem;\n N1: TMenuItem;\n Print1: TMenuItem;\n Exit1: TMenuItem;\n ColorDialog1: TColorDialog;\n CabView1: TMenuItem;\n Attributes1: TMenuItem;\n Itemname1: TMenuItem;\n Packed1: TMenuItem;\n Method1: TMenuItem;\n Ratio1: TMenuItem;\n CRC1: TMenuItem;\n Fileattributes1: TMenuItem;\n Filetype1: TMenuItem;\n Encryption1: TMenuItem;\n Timestamp1: TMenuItem;\n Filesize1: TMenuItem;\n Versionmade1: TMenuItem;\n Versionneeded1: TMenuItem;\n Path1: TMenuItem;\n Display1: TMenuItem;\n Columnlines1: TMenuItem;\n Columnmoving1: TMenuItem;\n Columnresizing1: TMenuItem;\n MultiSelect1: TMenuItem;\n Rowlines1: TMenuItem;\n Thumbtracking1: TMenuItem;\n Trackactiverow1: TMenuItem;\n Sort1: TMenuItem;\n Itemname2: TMenuItem;\n Packed2: TMenuItem;\n Ratio2: TMenuItem;\n Timestamp2: TMenuItem;\n Filesize2: TMenuItem;\n Select1: TMenuItem;\n SelectAll1: TMenuItem;\n ClearSelections1: TMenuItem;\n Rows1: TMenuItem;\n Rowheight1: TMenuItem;\n Headerheight1: TMenuItem;\n Font1: TMenuItem;\n Alternatecolors1: TMenuItem;\n Action1: TMenuItem;\n Extract1: TMenuItem;\n ShowIcons1: TMenuItem;\n Colors1: TMenuItem;\n Selectedcolor: TMenuItem;\n Selectedtextcolor: TMenuItem;\n Alternatecolor1: TMenuItem;\n Alternatetextcolor1: TMenuItem;\n Panel2: TPanel;\n AbMeter1: TAbMeter;\n Label1: TLabel;\n Label2: TLabel;\n PopupMenu1: TPopupMenu;\n Extract2: TMenuItem;\n AbMeter2: TAbMeter;\n AbCabView1: TAbCabView;\n Extractoptions1: TMenuItem;\n CreateDirs1: TMenuItem;\n RestorePath1: TMenuItem;\n AbCabKit1: TAbCabKit;\n Additems1: TMenuItem;\n procedure AbCabView1Click(Sender: TObject);\n procedure AttributeClick(Sender: TObject);\n procedure DisplayOptionClick(Sender: TObject);\n procedure SortAttributeClick(Sender: TObject);\n procedure SetAttribute(Attr : TAbViewAttribute; Value : Boolean);\n procedure SetDisplayOption(Option : TAbDisplayOption; Value : Boolean);\n procedure SetExtractOption(Option : TAbExtractOption; Value : Boolean);\n procedure SetSortAttribute(Option : TAbSortAttribute; Value : Boolean);\n procedure Open1Click(Sender: TObject);\n procedure Close1Click(Sender: TObject);\n procedure SelectAll1Click(Sender: TObject);\n procedure ClearSelections1Click(Sender: TObject);\n procedure Font1Click(Sender: TObject);\n procedure Exit1Click(Sender: TObject);\n procedure ExtractOptionClick(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n procedure Selected1Click(Sender: TObject);\n procedure Selectedtext1Click(Sender: TObject);\n procedure Rowheight1Click(Sender: TObject);\n procedure Headerheight1Click(Sender: TObject);\n procedure Extract1Click(Sender: TObject);\n procedure AbCabKit1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\n procedure AbCabView1Change(Sender: TObject);\n procedure Alternatecolor1Click(Sender: TObject);\n procedure Alternatetextcolor1Click(Sender: TObject);\n procedure AbCabKit1Save(Sender: TObject);\n procedure Additems1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n MainCaption = ' TAbCabView example';\n\n\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SetAttribute(Attr : TAbViewAttribute; Value : Boolean);\n procedure SetMenu(Item : TMenuItem);\n begin\n Item.Checked := Value;\n if Item.Checked then\n AbCabView1.Attributes := AbCabView1.Attributes + [Attr]\n else\n AbCabView1.Attributes := AbCabView1.Attributes - [Attr];\n end;\nbegin\n case Attr of\n vaItemName : SetMenu(ItemName1);\n vaPacked : SetMenu(Packed1);\n vaMethod : SetMenu(Method1);\n vaRatio : SetMenu(Ratio1);\n vaCRC : SetMenu(CRC1);\n vaFileAttributes : SetMenu(FileAttributes1);\n vaFileType : SetMenu(FileType1);\n vaEncryption : SetMenu(Encryption1);\n vaTimeStamp : SetMenu(TimeStamp1);\n vaFileSize : SetMenu(FileSize1);\n vaVersionMade : SetMenu(VersionMade1);\n vaVersionNeeded : SetMenu(VersionNeeded1);\n vaPath : SetMenu(Path1);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SetDisplayOption(Option : TAbDisplayOption; Value : Boolean);\n procedure SetMenu(Item : TMenuItem);\n begin\n Item.Checked := Value;\n if Item.Checked then\n AbCabView1.DisplayOptions := AbCabView1.DisplayOptions + [Option]\n else\n AbCabView1.DisplayOptions := AbCabView1.DisplayOptions - [Option]\n end;\nbegin\n case Option of\n doAlternateColors : SetMenu(AlternateColors1);\n doColLines : SetMenu(ColumnLines1);\n doColMove : SetMenu(ColumnMoving1);\n doColSizing : SetMenu(ColumnResizing1);\n doMultiSelect : SetMenu(MultiSelect1);\n doRowLines : SetMenu(RowLines1);\n doShowIcons : SetMenu(ShowIcons1);\n doThumbTrack : SetMenu(ThumbTracking1);\n doTrackActiveRow : SetMenu(TrackActiveRow1);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SetExtractOption(Option : TAbExtractOption; Value : Boolean);\n procedure SetMenu(Item : TMenuItem);\n begin\n Item.Checked := Value;\n if Item.Checked then\n AbCabKit1.ExtractOptions := AbCabKit1.ExtractOptions + [Option]\n else\n AbCabKit1.ExtractOptions := AbCabKit1.ExtractOptions - [Option]\n end;\nbegin\n case Option of\n eoCreateDirs : SetMenu(CreateDirs1);\n eoRestorePath : SetMenu(RestorePath1);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SetSortAttribute(Option : TAbSortAttribute; Value : Boolean);\n procedure SetMenu(Item : TMenuItem);\n begin\n Item.Checked := Value;\n if Item.Checked then\n AbCabView1.SortAttributes := AbCabView1.SortAttributes + [Option]\n else\n AbCabView1.SortAttributes := AbCabView1.SortAttributes - [Option];\n end;\nbegin\n case Option of\n saItemName : SetMenu(ItemName2);\n saPacked : SetMenu(Packed2);\n saRatio : SetMenu(Ratio2);\n saTimeStamp : SetMenu(TimeStamp2);\n saFileSize : SetMenu(FileSize2);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbCabView1Click(Sender: TObject);\nbegin\n Panel1.Caption := AbCabView1.Items[AbCabView1.ActiveRow].Filename;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Open1Click(Sender: TObject);\nbegin\n OpenDialog1.Filename := '*.cab';\n if OpenDialog1.Execute then begin\n AbCabKit1.Filename := OpenDialog1.Filename;\n{ AbCabKit1.BaseDirectory := ExtractFilePath(AbCabKit1.Filename);}\n Caption := AbCabKit1.Filename +\n ' ' + IntToStr(AbCabView1.Count) + ' items';\n Action1.Enabled := True;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Close1Click(Sender: TObject);\nbegin\n AbCabKit1.Filename := '';\n Caption := MainCaption;\n Panel1.Caption := '';\n Action1.Enabled := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AttributeClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do\n SetAttribute(TAbViewAttribute(Tag), not Checked);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.DisplayOptionClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do\n SetDisplayOption(TAbDisplayOption(Tag), not Checked);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SortAttributeClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do\n SetSortAttribute(TAbSortAttribute(Tag), not Checked);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SelectAll1Click(Sender: TObject);\nbegin\n AbCabView1.SelectAll;\n AbCabView1Click(nil);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.ClearSelections1Click(Sender: TObject);\nbegin\n AbCabView1.ClearSelections;\n AbCabView1Click(nil);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.ExtractOptionClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do\n SetExtractOption(TAbExtractOption(Tag), not Checked);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Font1Click(Sender: TObject);\nbegin\n FontDialog1.Font := AbCabView1.Font;\n if FontDialog1.Execute then\n AbCabView1.Font := FontDialog1.Font;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Exit1Click(Sender: TObject);\nbegin\n Close;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.FormCreate(Sender: TObject);\nvar\n i : TAbViewAttribute;\n j : TAbDisplayOption;\n k : TAbSortAttribute;\n m : TAbExtractOption;\nbegin\n for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do\n SetAttribute(i, i in AbCabView1.Attributes);\n for j := Low(TAbDisplayOption) to High(TAbDisplayOption) do\n SetDisplayOption(j, j in AbCabView1.DisplayOptions);\n for k := Low(TAbSortAttribute) to High(TAbSortAttribute) do\n SetSortAttribute(k, k in AbCabView1.SortAttributes);\n for m := Low(TAbExtractOption) to High(TAbExtractOption) do\n SetExtractOption(m, m in AbCabKit1.ExtractOptions);\n Caption := MainCaption;\n Action1.Enabled := AbCabKit1.FileName <> '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Selected1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbCabView1.Colors.Selected := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Selectedtext1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbCabView1.Colors.SelectedText := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Rowheight1Click(Sender: TObject);\nvar\n s : string;\nbegin\n s := IntToStr(AbCabView1.DefaultRowHeight);\n if InputQuery(MainCaption, 'Row Height', s) then\n AbCabView1.DefaultRowHeight := StrToIntDef(s, 18);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Headerheight1Click(Sender: TObject);\nvar\n s : string;\nbegin\n s := IntToStr(AbCabView1.HeaderRowHeight);\n if InputQuery(MainCaption, 'Header Height', s) then\n AbCabView1.HeaderRowHeight := StrToIntDef(s, 18);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Extract1Click(Sender: TObject);\nvar\n i : Longint;\n Continue : Boolean;\nbegin\n with TAbDirDlg.Create(Self) do begin\n Caption := 'Directory';\n AdditionalText := 'Select folder to extract into';\n Continue := Execute;\n if Continue then\n AbCabKit1.BaseDirectory := SelectedFolder;\n Free;\n end;\n if not Continue then\n Exit;\n Panel1.Caption := '';\n with AbCabView1 do\n for i := 0 to Pred(Count) do\n Items[i].Tagged := Selected[i];\n AbCabKit1.ExtractTaggedItems;\n AbCabView1.ClearSelections;\n Panel1.Caption := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbCabKit1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType; var Confirm: Boolean);\nvar\n s : string;\nbegin\n if (ProcessType = ptExtract) then\n s := 'Extracting '\n else\n s := '??? ';\n Panel1.Caption := s + Item.Filename;\n Confirm := True;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbCabView1Change(Sender: TObject);\nbegin\n Caption := AbCabKit1.Filename +\n ' ' + IntToStr(AbCabView1.Count) + ' items';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Alternatecolor1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbCabView1.Colors.Alternate := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Alternatetextcolor1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbCabView1.Colors.AlternateText := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbCabKit1Save(Sender: TObject);\nbegin\n Panel1.Caption := 'Saving ' + AbCabKit1.Filename;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Additems1Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n with OpenDialog1 do begin\n FileName := '*.*';\n Title := 'Select files to add';\n if Execute then\n if (Files.Count > 0) then\n for i := 0 to Pred(Files.Count) do\n AbCabKit1.AddFiles(Files[i], 0);\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ComCtrlsDemo.dpr",
"content": "program ComCtrlsDemo;\n\nuses\n Forms,\n ComCtrlsMain in 'ComCtrlsMain.pas' {frmComCtrls};\n\n{$R *.res}\n\nbegin\n Application.Initialize;\n Application.MainFormOnTaskbar := True;\n Application.CreateForm(TfrmComCtrls, frmComCtrls);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ComCtrlsMain.dfm",
"content": "object frmComCtrls: TfrmComCtrls\n Left = 0\n Top = 0\n Caption = 'AbComCtrls Example'\n ClientHeight = 524\n ClientWidth = 699\n Color = clBtnFace\n Font.Charset = DEFAULT_CHARSET\n Font.Color = clWindowText\n Font.Height = -11\n Font.Name = 'Tahoma'\n Font.Style = []\n Menu = MainMenu\n OldCreateOrder = False\n PixelsPerInch = 96\n TextHeight = 13\n object Splitter1: TSplitter\n Left = 153\n Top = 0\n Height = 524\n ExplicitLeft = 360\n ExplicitTop = 240\n ExplicitHeight = 100\n end\n object AbTreeView: TAbTreeView\n Left = 0\n Top = 0\n Width = 153\n Height = 524\n Align = alLeft\n Indent = 19\n TabOrder = 0\n Items.NodeData = {\n 0301000000200000000000000000000000FFFFFFFFFFFFFFFF00000000000000\n 000000000001015C00}\n Archive = AbUnZipper\n ListView = AbListView\n end\n object Panel1: TPanel\n Left = 156\n Top = 0\n Width = 543\n Height = 524\n Align = alClient\n Caption = 'Panel1'\n TabOrder = 1\n ExplicitLeft = 264\n ExplicitTop = 272\n ExplicitWidth = 185\n ExplicitHeight = 41\n object Splitter2: TSplitter\n Left = 1\n Top = 335\n Width = 541\n Height = 3\n Cursor = crVSplit\n Align = alBottom\n ExplicitLeft = 539\n ExplicitTop = 1\n ExplicitWidth = 337\n end\n object Memo1: TMemo\n Left = 1\n Top = 338\n Width = 541\n Height = 185\n Align = alBottom\n Lines.Strings = (\n 'Memo1')\n TabOrder = 0\n ExplicitLeft = 354\n ExplicitTop = 1\n ExplicitWidth = 522\n end\n object AbListView: TAbListView\n Left = 1\n Top = 1\n Width = 541\n Height = 334\n Align = alClient\n Archive = AbUnZipper\n TabOrder = 1\n TreeView = AbTreeView\n OnSelectItem = ListViewSelectItem\n ExplicitLeft = 328\n ExplicitTop = 112\n ExplicitWidth = 250\n ExplicitHeight = 150\n end\n end\n object AbUnZipper: TAbUnZipper\n Left = 96\n Top = 24\n end\n object MainMenu: TMainMenu\n Left = 16\n Top = 24\n object mnuFile: TMenuItem\n Caption = 'File'\n object mnuOpenArchive: TMenuItem\n Caption = 'Open...'\n OnClick = OpenArchiveClick\n end\n end\n object mnuView: TMenuItem\n Caption = 'View'\n object mnuAllFiles: TMenuItem\n AutoCheck = True\n Caption = 'All Files (WinZip Style)'\n GroupIndex = 1\n RadioItem = True\n OnClick = FolderStyleClick\n end\n object mnuFilesByFolder: TMenuItem\n AutoCheck = True\n Caption = 'Files By Folder (Explorer Style)'\n Checked = True\n GroupIndex = 1\n RadioItem = True\n OnClick = FolderStyleClick\n end\n object N1: TMenuItem\n Caption = '-'\n GroupIndex = 1\n end\n object mnuIcons: TMenuItem\n AutoCheck = True\n Caption = 'Icons'\n Checked = True\n GroupIndex = 2\n RadioItem = True\n OnClick = ViewStyleClick\n end\n object mnuList: TMenuItem\n AutoCheck = True\n Caption = 'List'\n GroupIndex = 2\n RadioItem = True\n OnClick = ViewStyleClick\n end\n object mnuDetails: TMenuItem\n AutoCheck = True\n Caption = 'Details'\n GroupIndex = 2\n RadioItem = True\n OnClick = ViewStyleClick\n end\n end\n end\n object OpenDialog: TOpenDialog\n Filter = 'Archive Files|*.zip;*.tar;*.gz;*.tgz;*.bz2;*.tbz'\n Options = [ofEnableSizing]\n Left = 56\n Top = 24\n end\nend\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ComCtrlsMain.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * Craig Peterson \n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* This demonstrates the TAbTreeView and TAbListView *}\n{* components. By setting references to each other and *}\n{* a shared TAbBaseBrowser descendant (e.g., TAbZipKit *}\n{* you can have a WinZip/Explorer-like interface without *}\n{* any code. *}\n{*********************************************************}\n\nunit ComCtrlsMain;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\n Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls, AbComCtrls, AbBase, AbBrowse,\n AbZBrows, AbUnzper;\n\ntype\n TfrmComCtrls = class(TForm)\n AbUnZipper: TAbUnZipper;\n AbTreeView: TAbTreeView;\n AbListView: TAbListView;\n MainMenu: TMainMenu;\n mnuFile: TMenuItem;\n mnuOpenArchive: TMenuItem;\n Splitter1: TSplitter;\n Splitter2: TSplitter;\n Memo1: TMemo;\n OpenDialog: TOpenDialog;\n mnuView: TMenuItem;\n mnuAllFiles: TMenuItem;\n mnuFilesByFolder: TMenuItem;\n N1: TMenuItem;\n mnuIcons: TMenuItem;\n mnuList: TMenuItem;\n mnuDetails: TMenuItem;\n Panel1: TPanel;\n\tprocedure FolderStyleClick(Sender: TObject);\n\tprocedure ListViewSelectItem(Sender: TObject; Item: TListItem;\n\t Selected: Boolean);\n\tprocedure OpenArchiveClick(Sender: TObject);\n\tprocedure ViewStyleClick(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n frmComCtrls: TfrmComCtrls;\n\nimplementation\n\n{$R *.dfm}\n\nprocedure TfrmComCtrls.FolderStyleClick(Sender: TObject);\nbegin\n AbTreeView.Visible := mnuFilesByFolder.Checked;\n Splitter1.Visible := mnuFilesByFolder.Checked;\n AbListView.FlatList := mnuAllFiles.Checked;\nend;\n\nprocedure TfrmComCtrls.ListViewSelectItem(Sender: TObject; Item: TListItem;\n Selected: Boolean);\nvar\n Stream: TMemoryStream;\nbegin\n if TAbListItem(Item).IsDirectory then\n\tMemo1.Clear\n else begin\n\tStream := TMemoryStream.Create;\n\ttry\n\t AbUnZipper.ExtractToStream(TAbListItem(Item).ArchiveItem.FileName, Stream);\n\t Stream.Position := 0;\n\t Memo1.Lines.LoadFromStream(Stream);\n\tfinally\n\t Stream.Free;\n\tend;\n end;\nend;\n\nprocedure TfrmComCtrls.OpenArchiveClick(Sender: TObject);\nbegin\n if OpenDialog.Execute then\n\tAbUnZipper.FileName := OpenDialog.FileName;\nend;\n\nprocedure TfrmComCtrls.ViewStyleClick(Sender: TObject);\nbegin\n if mnuIcons.Checked then\n\tAbListView.ViewStyle := vsIcon\n else if mnuList.Checked then\n\tAbListView.ViewStyle := vsList\n else\n\tAbListView.ViewStyle := vsReport;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/CompPad.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: COMPPAD.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram CompPad;\n\nuses\n Forms,\n ucomppad in 'UCOMPPAD.PAS' {Form1};\n\nbegin\n Application.Initialize;\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Contents.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: CONTENTS.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram Contents;\n\nuses\n Forms,\n UContent in 'UCONTENT.PAS' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExCBrows.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: CONTENTS.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram ExCBrows;\n\nuses\n Forms,\n ExCBrowu in 'ExCBrowu.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExCBrowu.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UCONTENT.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ExCBrowu;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, ExtCtrls,\n\n AbArcTyp, AbCBrows, AbMeter, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n OpenDialog1: TOpenDialog;\n AbCabBrowser1: TAbCabBrowser;\n Memo1: TMemo;\n Panel1: TPanel;\n Button1: TButton;\n Button2: TButton;\n Label1: TLabel;\n Panel2: TPanel;\n AbMeter1: TAbMeter;\n AbMeter2: TAbMeter;\n Label2: TLabel;\n Label3: TLabel;\n procedure Button1Click(Sender: TObject);\n procedure Button2Click(Sender: TObject);\n procedure AbCabBrowser1Load(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n BoolToStr : array[Boolean] of string = ('No', 'Yes');\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n if OpenDialog1.Execute then\n AbCabBrowser1.FileName := OpenDialog1.FileName;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nbegin\n AbCabBrowser1.Filename := '';\n Memo1.Clear;\nend;\n\nprocedure TForm1.AbCabBrowser1Load(Sender: TObject);\nvar\n i : Integer;\n LI : Longint;\n DT : TDateTime;\n s : string;\nbegin\n Memo1.Clear;\n with AbCabBrowser1 do begin\n Memo1.Lines.Add(Filename);\n Memo1.Lines.Add('----------------------------------------------');\n Memo1.Lines.Add(' Size: ' + #9 + #9 + IntToStr(CabSize));\n Memo1.Lines.Add(' Folders: ' + #9 + #9 + IntToStr(FolderCount));\n Memo1.Lines.Add(' Files: ' + #9 + #9 + IntToStr(Count));\n Memo1.Lines.Add(' SetID: ' + #9 + #9 + IntToStr(SetID));\n Memo1.Lines.Add(' Cab #: ' + #9 + #9 + IntToStr(CurrentCab));\n Memo1.Lines.Add(' hasPrev: ' + #9 + BoolToStr[HasPrev]);\n Memo1.Lines.Add(' hasNext: ' + #9 + BoolToStr[HasNext]);\n Memo1.Lines.Add(' ');\n\n if (Count > 0) then begin\n Memo1.Lines.Add('Files' + #9 + #9 + 'Size' +\n #9 + 'Timestamp' + #9 + #9 + 'Attributes' + #9 +'Partial File');\n Memo1.Lines.Add('--------------------------------------------' +\n '--------------------------------------------' +\n '--------------------------------------------');\n for i := 0 to Pred(Count) do begin\n LI := LongInt(Items[i].LastModFileDate) shl 16 +\n Items[i].LastModFileTime;\n DT := FileDateToDateTime(LI);\n s := Items[i].FileName + #9 +\n IntToStr(Items[i].UnCompressedSize) + #9 +\n DateTimeToStr(DT) + #9 +\n IntToStr(Items[i].ExternalFileAttributes) + #9 +\n BoolToStr[Items[i].PartialFile];\n Memo1.Lines.Add(s);\n end;\n end;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExCf.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nprogram ExCf;\n\nuses\n Forms,\n uCfMain in 'uCfMain.pas' {fmCfMain},\n uCfGenDg in 'uCfGenDg.pas' {frmCfGenDlg},\n uCfNewDg in 'uCfNewDg.pas' {frmCfNewDlg};\n\n{$R *.RES}\n\nbegin\n Application.Initialize;\n Application.CreateForm(TfmCfMain, fmCfMain);\n Application.CreateForm(TfrmCfGenDlg, frmCfGenDlg);\n Application.CreateForm(TfrmCfNewDlg, frmCfNewDlg);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExFilter.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: EXFILTER.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram Exfilter;\n\nuses\n Forms,\n Exfiltru in 'EXFILTRU.PAS' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExFiltru.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: EXFILTRU.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit Exfiltru;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, Gauges, Grids, ExtCtrls, FileCtrl,\n\n AbZipper, AbArcTyp, AbZBrows, AbMeter, AbZipKit, AbView, AbZView, AbBrowse,\n AbBase, AbUtils;\ntype\n TForm1 = class(TForm)\n OpenDialog1: TOpenDialog;\n OpenBtn: TButton;\n AbZipView1: TAbZipView;\n CloseBtn: TButton;\n AddGroup: TGroupBox;\n Label1: TLabel;\n FileMask1: TEdit;\n Label2: TLabel;\n FilterMask1: TEdit;\n AddBtn: TButton;\n Label3: TLabel;\n DirectoryListBox1: TDirectoryListBox;\n Bevel1: TBevel;\n Label4: TLabel;\n DeleteGroup: TGroupBox;\n Label5: TLabel;\n FileMask2: TEdit;\n Label6: TLabel;\n FilterMask2: TEdit;\n DeleteBtn: TButton;\n Bevel2: TBevel;\n AbortBtn: TButton;\n ExitBtn: TButton;\n ExtractGroup: TGroupBox;\n Label7: TLabel;\n Label8: TLabel;\n Label9: TLabel;\n Bevel3: TBevel;\n FileMask3: TEdit;\n FilterMask3: TEdit;\n ExtractBtn: TButton;\n DirectoryListBox2: TDirectoryListBox;\n AbZipKit1: TAbZipKit;\n AbMeter1: TAbMeter;\n procedure AddBtnClick(Sender: TObject);\n procedure OpenBtnClick(Sender: TObject);\n procedure DeleteBtnClick(Sender: TObject);\n procedure CloseBtnClick(Sender: TObject);\n procedure AbortBtnClick(Sender: TObject);\n procedure ExitBtnClick(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n procedure ExtractBtnClick(Sender: TObject);\n procedure AbZipKit1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n MainCaption = ' ExFilter : Exception list example';\n AddCaption = ' Add files to zip archive ';\n DeleteCaption = ' Delete files from zip archive ';\n ExtractCaption = ' Extract files from zip archive ';\n\nvar\n AbortFlag : Boolean;\n\nprocedure TForm1.OpenBtnClick(Sender: TObject);\nbegin\n AbZipKit1.Filename := '';\n AddBtn.Enabled := False;\n DeleteBtn.Enabled := False;\n OpenDialog1.Filename := '*.zip';\n if OpenDialog1.Execute then begin\n AbZipKit1.Filename := OpenDialog1.Filename;\n OpenBtn.Enabled := False;\n CloseBtn.Enabled := True;\n AddBtn.Enabled := True;\n DeleteBtn.Enabled := True;\n ExtractBtn.Enabled := True;\n AbZipView1.Enabled := True;\n Caption := ' ' + AbZipKit1.Filename;\n end;\nend;\n\nprocedure TForm1.CloseBtnClick(Sender: TObject);\nbegin\n Screen.Cursor := crHourglass;\n Caption := 'Saving ' + AbZipKit1.Filename;\n AbZipKit1.CloseArchive;\n Screen.Cursor := crDefault;\n OpenBtn.Enabled := True;\n CloseBtn.Enabled := False;\n AddBtn.Enabled := False;\n DeleteBtn.Enabled := False;\n ExtractBtn.Enabled := False;\n AbZipView1.Enabled := False;\n Caption := MainCaption;\nend;\n\nprocedure TForm1.AddBtnClick(Sender: TObject);\nvar\n SavedColor : TColor;\nbegin\n AbortFlag := False;\n AbZipKit1.BaseDirectory := DirectoryListBox1.Directory;\n SavedColor := AddGroup.Font.Color;\n AddGroup.Font.Color := clRed;\n try\n AbZipKit1.AddFilesEx(FileMask1.Text, FilterMask1.Text, 0 );\n AbZipKit1.Save;\n finally\n AddGroup.Font.Color := SavedColor;\n AddGroup.Caption := AddCaption;\n end;\nend;\n\nprocedure TForm1.DeleteBtnClick(Sender: TObject);\nvar\n SavedColor : TColor;\nbegin\n AbortFlag := False;\n SavedColor := DeleteGroup.Font.Color;\n DeleteGroup.Font.Color := clRed;\n try\n AbZipKit1.DeleteFilesEx(FileMask2.Text, FilterMask2.Text);\n AbZipKit1.Save;\n finally\n DeleteGroup.Font.Color := SavedColor;\n DeleteGroup.Caption := DeleteCaption;\n end;\nend;\n\nprocedure TForm1.ExtractBtnClick(Sender: TObject);\nvar\n SavedColor : TColor;\nbegin\n AbortFlag := False;\n AbZipKit1.BaseDirectory := DirectoryListBox2.Directory;\n SavedColor := ExtractGroup.Font.Color;\n ExtractGroup.Font.Color := clRed;\n try\n AbZipKit1.ExtractFilesEx(FileMask3.Text, FilterMask3.Text);\n finally\n ExtractGroup.Font.Color := SavedColor;\n ExtractGroup.Caption := ExtractCaption;\n end;\nend;\n\nprocedure TForm1.AbortBtnClick(Sender: TObject);\nbegin\n AbortFlag := True;\nend;\n\nprocedure TForm1.ExitBtnClick(Sender: TObject);\nbegin\n AbZipKit1.CloseArchive;\n Close;\nend;\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n Caption := MainCaption;\n AddGroup.Caption := AddCaption;\n DeleteGroup.Caption := DeleteCaption;\n ExtractGroup.Caption := ExtractCaption;\nend;\n\nprocedure TForm1.AbZipKit1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType; var Confirm: Boolean);\nbegin\n case ProcessType of\n ptAdd : AddGroup.Caption := ' Adding ' + Item.Filename + ' ';\n ptDelete : DeleteGroup.Caption := ' Deleting ' + Item.Filename + ' ';\n ptExtract : ExtractGroup.Caption := ' Extracting ' + Item.Filename + ' ';\n end;\n Confirm := not AbortFlag;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExZipper.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nprogram ExZipper;\n\nuses\n Forms,\n Exzippru in 'EXZIPPRU.PAS' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ExZippru.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: EXZIPPRU.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ExZippru;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, FileCtrl,\n\n AbArcTyp, AbZipOut, AbZBrows, AbZipper, AbBrowse, AbBase, AbMeter, AbUtils;\n\ntype\n TForm1 = class(TForm)\n Button1: TButton;\n Button2: TButton;\n OpenDialog1: TOpenDialog;\n DirectoryListBox1: TDirectoryListBox;\n DriveComboBox1: TDriveComboBox;\n Label1: TLabel;\n AbZipper1: TAbZipper;\n Button3: TButton;\n AbMeter1: TAbMeter;\n procedure Button1Click(Sender: TObject);\n procedure DirectoryListBox1Change(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n procedure Button2Click(Sender: TObject);\n procedure AbZipper1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\n procedure Button3Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n DirectoryListBox1Change(nil);\n AbZipper1.LogFile := ExtractFilePath(Application.ExeName) + 'Log.txt';\nend;\n\nprocedure TForm1.DirectoryListBox1Change(Sender: TObject);\nbegin\n AbZipper1.BaseDirectory := DirectoryListBox1.Directory;\nend;\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n OpenDialog1.Filename := '*.zip';\n OpenDialog1.InitialDir := DirectoryListBox1.Directory;\n if OpenDialog1.Execute then\n AbZipper1.Filename := OpenDialog1.Filename;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nbegin\n AbZipper1.AddFiles('*.*', 0);\n Caption := 'ExZipper';\nend;\n\nprocedure TForm1.AbZipper1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType; var Confirm: Boolean);\nbegin\n Caption := 'adding ' + Item.Filename;\nend;\n\nprocedure TForm1.Button3Click(Sender: TObject);\nbegin\n Cursor := crHourGlass;\n AbZipper1.CloseArchive;\n Cursor := crDefault;\nend;\n\nend.\n\n\n"
},
{
"path": "lib/abbrevia/examples/Delphi/FCITest1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit FCITest1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, AbCabKit{, TestCab};\n\ntype\n TForm1 = class(TForm)\n Button1: TButton;\n Button2: TButton;\n Button3: TButton;\n OpenDialog1: TOpenDialog;\n Memo1: TMemo;\n procedure Button1Click(Sender: TObject);\n procedure Button2Click(Sender: TObject);\n procedure Button3Click(Sender: TObject);\n private\n { Private declarations }\n public\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n OpenDialog1.Filename := '*.cab';\n if OpenDialog1.Execute then begin\n Memo1.Clear;\n MakeCab(OpenDialog1.Filename);\n Memo1.Lines.Assign(TestCab.AuditTrail);\n end;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n OpenDialog1.Filename := '*.*';\n if OpenDialog1.Execute then\n if OpenDialog1.Files.Count > 0 then\n for i := 0 to Pred(OpenDialog1.Files.Count) do begin\n try\n AddFile(OpenDialog1.Files[i]);\n finally\n end;\n end;\n Memo1.Lines.Assign(TestCab.AuditTrail);\nend;\n\nprocedure TForm1.Button3Click(Sender: TObject);\nbegin\n CloseArchive;\n Memo1.Lines.Assign(TestCab.AuditTrail);\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Finder.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: FINDER.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram finder;\n\nuses\n Forms,\n ufinder in 'ufinder.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/MakeCab.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: MAKECAB.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram MakeCab;\n\nuses\n Forms,\n MakeCab1 in 'MakeCab1.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/MakeCab1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: MAKECAB1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit MakeCab1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, Gauges, ExtCtrls, ComCtrls,\n\n AbArcTyp, AbCBrows, AbCabMak, AbCabTyp, AbMeter, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n AddBtn: TButton;\n OpenDialog1: TOpenDialog;\n Label1: TLabel;\n CreateBtn: TButton;\n CloseBtn: TButton;\n Panel1: TPanel;\n NewFolderBtn: TButton;\n Label2: TLabel;\n NewCabBtn: TButton;\n AbMeter1: TAbMeter;\n AbMakeCab1: TAbMakeCab;\n procedure AddBtnClick(Sender: TObject);\n procedure CreateBtnClick(Sender: TObject);\n procedure CloseBtnClick(Sender: TObject);\n procedure NewFolderBtnClick(Sender: TObject);\n procedure NewCabBtnClick(Sender: TObject);\n procedure AbMakeCab1ArchiveItemProgress(Sender: TObject;\n Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n MainCaption = 'Make Cabinet Archive';\n\nprocedure TForm1.CreateBtnClick(Sender: TObject);\nbegin\n OpenDialog1.Filename := '*.Cab';\n OpenDialog1.Title := 'Name of 1st cabinet';\n if OpenDialog1.Execute then begin\n Panel1.Caption := 'Creating ' + OpenDialog1.FileName;\n AbMakeCab1.OpenArchive(OpenDialog1.FileName);\n Caption := AbMakeCab1.FileName;\n Panel1.Caption := 'Idle';\n end;\nend;\n\nprocedure TForm1.AddBtnClick(Sender: TObject);\nvar\n i : Integer;\n SC : TCursor;\n FileList : TStringList;\n\nbegin\n OpenDialog1.Filename := '*.*';\n OpenDialog1.Title := 'Add files to cabinet';\n if OpenDialog1.Execute then\n if (OpenDialog1.Files.Count > 0) then begin\n SC := Cursor;\n Cursor := crHourglass;\n FileList := TStringList.Create;\n try\n FileList.Assign(OpenDialog1.Files);\n for i := 0 to Pred(FileList.Count) do\n AbMakeCab1.AddFiles(FileList.Strings[i], 0);\n finally\n FileList.Free;\n end;\n Cursor := SC;\n Panel1.Caption := 'Idle';\n end;\nend;\n\nprocedure TForm1.CloseBtnClick(Sender: TObject);\nbegin\n Panel1.Caption := 'Closing ' + AbMakeCab1.FileName;\n AbMakeCab1.CloseArchive;\n Caption := MainCaption;\n Panel1.Caption := 'Idle';\nend;\n\nprocedure TForm1.NewFolderBtnClick(Sender: TObject);\nbegin\n AbMakeCab1.StartNewFolder;\nend;\n\nprocedure TForm1.NewCabBtnClick(Sender: TObject);\nbegin\n AbMakeCab1.StartNewCabinet;\nend;\n\nprocedure TForm1.AbMakeCab1ArchiveItemProgress(Sender: TObject;\n Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);\nbegin\n Panel1.Caption := 'Adding ' + ExtractFilename(Item.Filename);\n Abort := False;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/SelfStbv.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: SELFEXV.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram Selfstbv;\n\nuses\n Forms,\n Slfstbv1 in 'SLFSTBV1.PAS' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/SelfStub.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: SELFSTUB.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\n(* This program creates a ZIP stub called SELFEX.EXE. This\nstub can then be used to create self-extracting ZIP files.\nFor more information on self-extracting ZIPs and ZIP stubs see\npage 112 in the Abbrevia manual. *)\n\nprogram Selfstub;\n\n{$APPTYPE CONSOLE}\n\nuses\n AbArcTyp,\n AbUnzPrc,\n AbUtils,\n AbZipTyp,\n SysUtils;\n\ntype\n THelper = class\n public\n procedure UnzipProc(Sender : TObject;\n Item : TAbArchiveItem;\n const NewName : string);\n end;\n\nprocedure THelper.UnzipProc(Sender : TObject;\n Item : TAbArchiveItem;\n const NewName : string);\nbegin\n AbUnzip(Sender, TAbZipItem(Item), NewName);\nend;\n\n{Build this app using the Define \"BuildingStub\", to keep it smaller!}\n\nvar\n ZipArchive : TAbZipArchive;\n Helper : THelper;\nbegin\n WriteLn( 'Abbrevia Self Extracting Archive' );\n ZipArchive := TAbZipArchive.Create(ParamStr(0),\n fmOpenRead or fmShareDenyNone);\n ChDir( ExtractFilePath(ParamStr(0)));\n Helper := THelper.Create;\n try\n ZipArchive.Load;\n ZipArchive.ExtractHelper := Helper.UnzipProc;\n ZipArchive.ExtractFiles('*.*');\n finally\n Helper.Free;\n ZipArchive.Free;\n end;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/SlfStbv1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: SLFSTBV1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit Slfstbv1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, \n\n AbZBrows, AbUnZper, AbArcTyp, AbBrowse, AbBase, AbUtils;\n\ntype\n TForm1 = class(TForm)\n Button1: TButton;\n AbUnZipper1: TAbUnZipper;\n Memo1: TMemo;\n procedure Button1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n AbUnzipper1.FileName := ExtractFilePath(Application.ExeName) + 'abtest.exe';\n AbUnzipper1.ArchiveType := atSelfExtZip;\n\n AbUnzipper1.ExtractFiles( '*.*' );\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Streams.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: STREAMS.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram Streams;\n\nuses\n Forms,\n Streams1 in 'Streams1.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Streams1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: STREAMS1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit Streams1;\n\ninterface\n\nuses\n Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, Grids,\n\n AbView, AbZView, Menus, AbArcTyp, AbZBrows, AbUnZper,\n AbZipper, AbZipKit, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n MainMenu1: TMainMenu;\n File1: TMenuItem;\n Open1: TMenuItem;\n Exit1: TMenuItem;\n Action1: TMenuItem;\n Extract1: TMenuItem;\n AbZipView1: TAbZipView;\n Memo1: TMemo;\n OpenDialog1: TOpenDialog;\n Close1: TMenuItem;\n N1: TMenuItem;\n Add1: TMenuItem;\n AbZipKit1: TAbZipKit;\n Clearmemo1: TMenuItem;\n procedure Open1Click(Sender: TObject);\n procedure Extract1Click(Sender: TObject);\n procedure Close1Click(Sender: TObject);\n procedure Exit1Click(Sender: TObject);\n procedure AbZipView1DblClick(Sender: TObject);\n procedure Clearmemo1Click(Sender: TObject);\n procedure Add1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n MainCaption = ' Compressed Memo';\n\nprocedure TForm1.Open1Click(Sender: TObject);\nbegin\n OpenDialog1.Filename := '*.zip';\n if OpenDialog1.Execute then\n AbZipKit1.OpenArchive(OpenDialog1.Filename);\nend;\n\nprocedure TForm1.Extract1Click(Sender: TObject);\nvar\n ToStream : TMemoryStream;\n Item : TAbArchiveItem;\nbegin\n Memo1.Clear;\n ToStream := TMemoryStream.Create;\n try\n Item := AbZipView1.Items[AbZipView1.ActiveRow];\n Caption := Item.Filename;\n AbZipKit1.ExtractToStream(Item.FileName, ToStream);\n ToStream.Position := 0;\n Memo1.Lines.LoadFromStream(ToStream);\n finally\n ToStream.Free;\n end;\nend;\n\nprocedure TForm1.Close1Click(Sender: TObject);\nbegin\n AbZipKit1.CloseArchive;\n Caption := MainCaption;\nend;\n\nprocedure TForm1.Exit1Click(Sender: TObject);\nbegin\n Close1Click(nil);\n Close;\nend;\n\nprocedure TForm1.AbZipView1DblClick(Sender: TObject);\nbegin\n Extract1Click(nil);\nend;\n\nprocedure TForm1.Clearmemo1Click(Sender: TObject);\nbegin\n Memo1.Clear;\nend;\n\nprocedure TForm1.Add1Click(Sender: TObject);\nvar\n FromStream : TMemoryStream;\n FN : string;\nbegin\n FromStream := TMemoryStream.Create;\n try\n Memo1.Lines.SaveToStream(FromStream);\n if InputQuery('Streams', 'Give it a filename', FN) then begin\n Caption := FN;\n AbZipKit1.AddFromStream(FN, FromStream);\n end;\n finally\n FromStream.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/StrmBmp.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: STRMBMP.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram StrmBmp;\n\nuses\n Forms,\n StrmBmpU in 'StrmBmpU.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/StrmBmpU.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: STRMBMPU.DPR *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit StrmBmpU;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, ExtCtrls;\n\ntype\n TForm1 = class(TForm)\n Image1: TImage;\n Button1: TButton;\n Memo1: TMemo;\n procedure Button1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\nuses\n AbUnzPrc,\n AbZipPrc;\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nvar\n UStrm : TMemoryStream;\n CStrm : TMemoryStream;\n Image2 : TImage;\nbegin\n { Create the compressed stream and the uncompressed stream. }\n UStrm := TMemoryStream.Create;\n CStrm := TMemoryStream.Create;\n\n { Copy the bitmap image to the memory stream. }\n Image1.Picture.Bitmap.SaveToStream(UStrm);\n\n { Set the stream position to the beginning. }\n UStrm.Position := 0;\n\n { Compress the stream. }\n DeflateStream(UStrm, CStrm);\n\n { Remove all data from the uncompressed stream. }\n UStrm.Clear;\n\n { Reset the compressed stream back to the beginning. }\n CStrm.Position := 0;\n\n { Decompress the stream back to the original uncompressed }\n { stream and then reset the stream position back to 0. }\n InflateStream(CStrm, UStrm);\n UStrm.Position := 0;\n\n { Now create a new TImage. Make it the same size as the }\n { original image but move it down and to the left. }\n Image2 := TImage.Create(Self);\n Image2.Top := Image1.Top + 20;\n Image2.Left := Image1.Left + 20;\n Image2.Width := Image1.Width;\n Image2.Height := Image1.Height;\n Image2.Parent := Self;\n\n { Delete the original TImage. }\n Image1.Free;\n\n { Load the new bitmap with the data from the stream }\n { that contains the decompressed image. }\n Image2.Picture.Bitmap.LoadFromStream(UStrm);\n\n { Free the memory streams. }\n UStrm.Free;\n CStrm.Free;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/StrmPad.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: STRMPAD.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram StrmPad;\n\nuses\n Forms,\n Ustrpad in 'Ustrpad.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/TpZip.RC",
"content": ";{*********************************************************}\n;{* ABBREVIA: TPZIP.RC *}\n;{* Copyright (c) TurboPower Software Co 1997 *}\n;{* All rights reserved. *}\n;{*********************************************************}\n;{* ABBREVIA Example program file *}\n;{*********************************************************}\n\nMAINICON ICON \"tpzip.ico\"\n\n"
},
{
"path": "lib/abbrevia/examples/Delphi/TpZip.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: TPZIP.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram TPZip;\n\nuses\n Forms,\n ubasedlg in 'UBASEDLG.PAS' {BaseDirDlg},\n udemodlg in 'UDEMODLG.PAS' {DemoDlg},\n dgAbout in 'DGABOUT.PAS' {dlgAboutBox},\n usplash in 'USPLASH.PAS' {Splash},\n UMain in 'Umain.pas' {Form1};\n\n{$R *.R32}\n\nbegin\n Application.Title := 'TP Zip';\n Application.HelpFile := 'Tpzip31.hlp';\n Application.CreateForm(TForm1, Form1);\n Splash := TSplash.Create( Application );\n Splash.Show;\n Splash.Refresh;\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/UContent.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UCONTENT.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit UContent;\n\n\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,\n\n AbZBrows, AbArcTyp, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n ListBox1: TListBox;\n Button1: TButton;\n OpenDialog1: TOpenDialog;\n AbZipBrowser1: TAbZipBrowser;\n Label1: TLabel;\n procedure Button1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n ListBox1.Clear;\n if OpenDialog1.Execute then begin\n try\n with AbZipBrowser1 do begin\n FileName := OpenDialog1.FileName;\n if Count > 0 then\n for i := 0 to pred( Count ) do\n ListBox1.Items.Add( Items[i].FileName );\n end;\n except\n ListBox1.Items.Add( OpenDialog1.FileName + ' is not a valid archive.' );\n end;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/UMain.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UMAIN.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA: TPZip *}\n{*********************************************************}\n\n{$I AbDefine.inc}\n\nunit UMain;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n Menus, ExtCtrls, FileCtrl, StdCtrls, Gauges, Buttons, \n\n AbArcTyp, AbUtils, AbZipOut, AbMeter, AbBase, AbBrowse;\n\ntype\n TForm1 = class(TForm)\n MainMenu1: TMainMenu;\n File1: TMenuItem;\n Open1: TMenuItem;\n Save1: TMenuItem;\n N1: TMenuItem;\n Exit1: TMenuItem;\n Items1: TMenuItem;\n Help1: TMenuItem;\n Contents1: TMenuItem;\n N2: TMenuItem;\n About1: TMenuItem;\n Preferences1: TMenuItem;\n View1: TMenuItem;\n Attributes1: TMenuItem;\n za0: TMenuItem;\n za1: TMenuItem;\n za8: TMenuItem;\n Hierarchy1: TMenuItem;\n Style1: TMenuItem;\n Panel1: TPanel;\n Panel2: TPanel;\n za2: TMenuItem;\n za3: TMenuItem;\n za4: TMenuItem;\n za5: TMenuItem;\n za6: TMenuItem;\n za7: TMenuItem;\n za9: TMenuItem;\n za10: TMenuItem;\n N3: TMenuItem;\n None1: TMenuItem;\n All1: TMenuItem;\n Panel3: TPanel;\n Panel4: TPanel;\n DriveComboBox1: TDriveComboBox;\n FilterComboBox1: TFilterComboBox;\n DirectoryListBox1: TDirectoryListBox;\n FileListBox1: TFileListBox;\n Panel5: TPanel;\n FontDialog1: TFontDialog;\n Font1: TMenuItem;\n Panel6: TPanel;\n OpenDialog1: TOpenDialog;\n CompressionMethodToUse1: TMenuItem;\n Store1: TMenuItem;\n Deflate1: TMenuItem;\n Best1: TMenuItem;\n DeflationOption1: TMenuItem;\n Maximum1: TMenuItem;\n Normal1: TMenuItem;\n Fast1: TMenuItem;\n SuperFast1: TMenuItem;\n ExtractOptions1: TMenuItem;\n CreateDirs1: TMenuItem;\n RestorePath1: TMenuItem;\n Password1: TMenuItem;\n StoreOptions1: TMenuItem;\n RemoveDots1: TMenuItem;\n RecurseTree1: TMenuItem;\n StripPath1: TMenuItem;\n AddFiles1: TMenuItem;\n DeleteFiles1: TMenuItem;\n ExtractFiles1: TMenuItem;\n FreshenFiles1: TMenuItem;\n PopupMenu1: TPopupMenu;\n Delete1: TMenuItem;\n Run1: TMenuItem;\n Move1: TMenuItem;\n Freshen1: TMenuItem;\n Extract1: TMenuItem;\n Confirmations1: TMenuItem;\n Close1: TMenuItem;\n Convert1: TMenuItem;\n N4: TMenuItem;\n Default1: TMenuItem;\n Panel8: TPanel;\n SpeedButton1: TSpeedButton;\n SpeedButton2: TSpeedButton;\n SpeedButton3: TSpeedButton;\n SpeedButton4: TSpeedButton;\n SpeedButton5: TSpeedButton;\n SpeedButton7: TSpeedButton;\n SpeedButton8: TSpeedButton;\n SpeedButton9: TSpeedButton;\n SpeedButton10: TSpeedButton;\n SpeedButton11: TSpeedButton;\n SpeedButton12: TSpeedButton;\n SpeedButton13: TSpeedButton;\n SpeedButton14: TSpeedButton;\n Image1: TImage;\n ArchiveLabel: TLabel;\n Label1: TLabel;\n Label2: TLabel;\n FileComment1: TMenuItem;\n sbNone: TSpeedButton;\n sbAll: TSpeedButton;\n sbDef: TSpeedButton;\n Edit1: TEdit;\n Label3: TLabel;\n N5: TMenuItem;\n OS3: TMenuItem;\n OS4: TMenuItem;\n OS2: TMenuItem;\n OS1: TMenuItem;\n OS6: TMenuItem;\n OS5: TMenuItem;\n AbbreviaontheWeb1: TMenuItem;\n AbMeter1: TAbMeter;\n AbMeter2: TAbMeter;\n ShowEmptyfolders1: TMenuItem;\n TempDirectory1: TMenuItem;\n Logging1: TMenuItem;\n AbZipOutline1: TAbZipOutline;\n\n procedure AbZipOutline1Change(Sender: TObject);\n procedure AbZipOutline1ConfirmSave(Sender: TObject;\n var Confirm: Boolean);\n procedure AbZipOutline1DblClick(Sender: TObject);\n procedure AbZipOutline1DragDrop(Sender, Source: TObject; X,\n Y: Integer);\n procedure AbZipOutline1DragOver(Sender, Source: TObject; X, Y: Integer;\n State: TDragState; var Accept: Boolean);\n procedure AbZipOutline1MouseDown(Sender: TObject; Button: TMouseButton;\n Shift: TShiftState; X, Y: Integer);\n procedure AbZipOutline1WindowsDrop(Sender: TObject;\n FileName: string);\n procedure All1Click(Sender: TObject);\n procedure Best1Click(Sender: TObject);\n procedure Confirmations1Click(Sender: TObject);\n procedure CreateDirs1Click(Sender: TObject);\n procedure Exit1Click(Sender: TObject);\n procedure FileListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);\n procedure FileListBox1DragOver(Sender, Source: TObject; X, Y: Integer;\n State: TDragState; var Accept: Boolean);\n procedure Font1Click(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n procedure Hierarchy1Click(Sender: TObject);\n procedure None1Click(Sender: TObject);\n procedure Open1Click(Sender: TObject);\n procedure RestorePath1Click(Sender: TObject);\n procedure Save1Click(Sender: TObject);\n procedure StripPath1Click(Sender: TObject);\n procedure SuperFast1Click(Sender: TObject);\n procedure za10Click(Sender: TObject);\n\n procedure Delete1Click(Sender: TObject);\n procedure Extract1Click(Sender: TObject);\n procedure Freshen1Click(Sender: TObject);\n procedure Move1Click(Sender: TObject);\n procedure Password1Click(Sender: TObject);\n procedure AddFiles1Click(Sender: TObject);\n procedure FreshenFiles1Click(Sender: TObject);\n procedure SelectBaseDirectory1Click(Sender: TObject);\n procedure AbZipOutline1ArchiveItemProgress(Sender: TObject;\n Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);\n procedure AbZipOutline1NeedPassword(Sender: TObject;\n var NewPassword: AnsiString);\n procedure DeleteFiles1Click(Sender: TObject);\n procedure ExtractFiles1Click(Sender: TObject);\n procedure FormDestroy(Sender: TObject);\n procedure Close1Click(Sender: TObject);\n procedure AbZipOutline1Load(Sender: TObject);\n procedure Convert1Click(Sender: TObject);\n procedure AbZipOutline1ConfirmOverwrite(var Name: string;\n var Confirm: Boolean);\n procedure Default1Click(Sender: TObject);\n procedure Contents1Click(Sender: TObject);\n procedure About1Click(Sender: TObject);\n procedure FileListBox1DblClick(Sender: TObject);\n procedure AbZipOutline1EndDrag(Sender, Target: TObject; X, Y: Integer);\n procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton;\n Shift: TShiftState; X, Y: Integer);\n procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\n procedure AbZipOutline1MouseMove(Sender: TObject; Shift: TShiftState;\n X, Y: Integer);\n procedure Edit1Exit(Sender: TObject);\n procedure FormKeyPress(Sender: TObject; var Key: Char);\n procedure OS5Click(Sender: TObject);\n procedure AbZipOutline1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\n procedure AbZipOutline1ProcessItemFailure(Sender: TObject;\n Item: TAbArchiveItem; const ProcessType: TAbProcessType;\n ErrorClass: TAbErrorClass; ErrorCode: Integer);\n procedure TurboPowerontheWeb1Click(Sender: TObject);\n procedure AbbreviaontheWeb1Click(Sender: TObject);\n procedure TempDirectory1Click(Sender: TObject);\n procedure Logging1Click(Sender: TObject);\n private\n { Private declarations }\n OutlineX, OutlineY, FileX, FileY : Integer;\n StubName : string;\n IgnoreDuplicateWarning : Boolean;\n procedure ReadIniSettings;\n procedure SaveIniSettings;\n procedure SetCaption;\n procedure UpdateMenu;\n procedure DoConfirm( Sender : TObject; Item : TAbArchiveItem;\n var Confirm : Boolean; Caption : string );\n procedure GetMinMaxInfo( var Msg: TWMGetMinMaxInfo );\n message WM_GETMINMAXINFO;\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nuses\n AbConst,\n AbDlgDir,\n AbDlgPwd,\n AbZBrows,\n AbZipTyp,\n dgAbout,\n IniFiles,\n Outline,\n ShellAPI,\n UBaseDlg,\n UDemoDlg,\n uSplash;\n\nprocedure TForm1.All1Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n for i := 0 to Ord( High( TAbZipAttribute ) ) do\n Attributes1.Items[i].Checked := True;\n AbZipOutline1.Attributes := [zaCompressedSize, zaCompressionMethod,\n zaCompressionRatio, zaCRC, zaExternalFileAttributes,\n zaInternalFileAttributes, zaEncryption, zaTimeStamp,\n zaUncompressedSize, zaVersionMade, zaVersionNeeded,\n zaComment];\n AbZipOutline1.Update;\nend;\n\nprocedure TForm1.Exit1Click(Sender: TObject);\nbegin\n Close;\nend;\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n ReadIniSettings;\n SetCaption;\n UpdateMenu;\n if ParamCount > 0 then\n try\n AbZipOutline1.FileName := ParamStr( 1 );\n except\n end;\n\nend;\n\nprocedure TForm1.Hierarchy1Click(Sender: TObject);\nbegin\n Hierarchy1.Checked := not Hierarchy1.Checked;\n AbZipOutline1.Hierarchy := Hierarchy1.Checked;\nend;\n\nprocedure TForm1.None1Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n for i := 0 to pred( Attributes1.Count ) do\n Attributes1.Items[i].Checked := False;\n AbZipOutline1.Attributes := [];\n AbZipOutline1.Update;\nend;\n\nprocedure TForm1.Save1Click(Sender: TObject);\nbegin\n AbZipOutline1.Save;\nend;\n\nprocedure TForm1.SetCaption;\nbegin\n Caption := 'TPZip ' + AbZipOutline1.Version + ' - ' +\n AbZipOutline1.FileName;\nend;\n\nprocedure TForm1.UpdateMenu;\nvar\n i : TAbZipAttribute;\nbegin\n with AbZipOutline1 do begin\n i := Low( TAbZipAttribute );\n while i <> High( TAbZipAttribute ) do begin\n Attributes1.Items[Ord(i)].Checked := i in Attributes;\n i := succ( i );\n end;\n Hierarchy1.Checked := Hierarchy;\n// OS1.Checked := Ord( OutlineStyle ) = 0;\n// OS2.Checked := Ord( OutlineStyle ) = 1;\n// OS3.Checked := Ord( OutlineStyle ) = 2;\n// OS4.Checked := Ord( OutlineStyle ) = 3;\n// OS5.Checked := Ord( OutlineStyle ) = 4;\n// OS6.Checked := Ord( OutlineStyle ) = 5;\n\n Best1.Checked := CompressionMethodToUse = smBestMethod;\n Deflate1.Checked := CompressionMethodToUse = smDeflated;\n Store1.Checked := CompressionMethodToUse = smStored;\n {deflation options}\n Normal1.Checked := DeflationOption = doNormal;\n Maximum1.Checked := DeflationOption = doMaximum;\n Fast1.Checked := DeflationOption = doFast;\n SuperFast1.Checked := DeflationOption = doSuperFast;\n {extractOptions}\n CreateDirs1.Checked := eoCreateDirs in ExtractOptions;\n RestorePath1.Checked := eoRestorePath in ExtractOptions;\n {StoreOptions}\n RecurseTree1.Checked := soRecurse in StoreOptions;\n StripPath1.Checked := soStripPath in StoreOptions;\n RemoveDots1.Checked := soRemoveDots in StoreOptions;\n end;\nend;\n\nprocedure TForm1.za10Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n Item := (Sender as TMenuItem);\n Item.Checked := not Item.Checked;\n with AbZipOutline1 do\n if Item.Checked then\n Attributes := Attributes + [TAbZipAttribute( Item.Tag )]\n else\n Attributes := Attributes - [TAbZipAttribute( Item.Tag )];\n AbZipOutline1.Update;\nend;\n\nprocedure TForm1.Font1Click(Sender: TObject);\nbegin\n if FontDialog1.Execute then\n with FontDialog1 do begin\n AbZipOutline1.Font := Font;\n DirectoryListBox1.Font := Font;\n FileListBox1.Font := Font;\n DriveComboBox1.Font := Font;\n FilterComboBox1.Font := Font;\n end;\nend;\n\nprocedure TForm1.Open1Click(Sender: TObject);\nbegin\n if OpenDialog1.Execute then begin\n AbZipOutline1.FileName := OpenDialog1.FileName;\n end;\nend;\n\nprocedure TForm1.AbZipOutline1DragOver(Sender, Source: TObject; X,\n Y: Integer; State: TDragState; var Accept: Boolean);\nbegin\n Accept := Source is TFileListBox;\nend;\n\nprocedure TForm1.AbZipOutline1DragDrop(Sender, Source: TObject; X,\n Y: Integer);\nvar\n i, j : Integer;\n ZB : TAbZipBrowser;\n IsZip : Boolean;\n ZipName : string;\nbegin\n if Source is TFileListBox then\n with (Source as TFileListBox ) do\n if SelCount = 1 then begin\n for i := 0 to pred( Items.Count ) do\n if FileListBox1.Selected[i] then begin\n IsZip := False;\n ZB := TAbZipBrowser.Create( Self );\n try\n try\n ZB.FileName := Directory + '\\' + Items[i];\n IsZip := True;\n except\n end;\n finally\n ZB.Free;\n end;\n if IsZip then\n {only one file, and it is a zip file}\n AbZipOutline1.FileName := Directory + '\\' + Items[i]\n else if AbZipOutline1.FileName <> '' then\n {only one file, and it's not a zip file}\n AbZipOutline1.AddFiles( Directory + '\\' + Items[i], 0 )\n else begin\n if OpenDialog1.Execute then begin\n AbZipOutline1.FileName := OpenDialog1.FileName;\n AbZipOutline1.AddFiles( Directory + '\\' + Items[i], 0 );\n end;\n end;\n break;\n end;\n end\n else begin\n {multiple files dropped...}\n IsZip := False;\n ZB := TAbZipBrowser.Create( Self );\n try\n for i := 0 to pred( Items.Count ) do\n if FileListBox1.Selected[i] then begin\n try\n ZB.FileName := Directory + '\\' + Items[i];\n IsZip := True;\n ZipName := ZB.FileName;\n break;\n except\n end;\n end;\n finally\n ZB.Free;\n end;\n if IsZip and ( Application.MessageBox( \n 'One of the dropped files is a Zip Archive. Open it?',\n 'Open or Add Files?',\n MB_YESNO ) = IDYES ) then\n AbZipOutline1.FileName := ZipName\n else begin\n if AbZipOutline1.FileName <> '' then begin\n for i := 0 to pred( Items.Count ) do\n if FileListBox1.Selected[i] then\n AbZipOutline1.AddFiles( Directory + '\\' + Items[i], 0 );\n end\n else begin\n if OpenDialog1.Execute then begin\n AbZipOutline1.FileName := OpenDialog1.FileName;\n for j := 0 to pred( Items.Count ) do\n if FileListBox1.Selected[j] then\n AbZipOutline1.AddFiles( Directory + '\\' + Items[j], 0 )\n end;\n end;\n end;\n end;\nend;\n\nprocedure TForm1.AbZipOutline1DblClick(Sender: TObject);\nvar\n Restoring : Boolean;\n zFileName : array[0..79] of Char;\n TempDir, SaveDir : string;\n TempPath : array [0..255] of Char;\n TempName : string;\nbegin\n GetTempPath( sizeof( TempPath ), TempPath );\n SaveDir := StrPas( TempPath );\n if SaveDir[Length(SaveDir)] = '\\' then\n Delete( SaveDir, Length(SaveDir), 1 );\n StrPCopy( TempPath, SaveDir );\n\n with AbZipOutline1 do begin\n if SelectedZipItem <> nil then begin\n TempDir := BaseDirectory;\n Restoring := eoRestorePath in ExtractOptions;\n ExtractOptions := ExtractOptions - [eoRestorePath];\n BaseDirectory := SaveDir;\n try\n ExtractFiles( SelectedZipItem.FileName );\n TempName := SelectedZipItem.FileName;\n AbUnfixName( TempName );\n ShellExecute( Application.MainForm.Handle, nil,\n StrPCopy( zFileName, ExtractFileName( TempName ) ),\n '', TempPath, SW_SHOWNORMAL );\n finally\n BaseDirectory := TempDir;\n if Restoring then\n ExtractOptions := ExtractOptions + [eoRestorePath];\n end;\n end;\n end;\nend;\n\nprocedure TForm1.AbZipOutline1MouseDown(Sender: TObject;\n Button: TMouseButton; Shift: TShiftState; X, Y: Integer);\nvar\n i : Integer;\n PS, PC : TPoint;\nbegin\n if Button = mbLeft then begin\n OutlineX := X;\n OutlineY := Y;\n end\n else if Button = mbRight then begin\n {enable appropriate popup menu items.}\n {prepare popup menu}\n if AbZipOutline1.Count > 0 then begin\n {there are items in the outline - select the item under the mouse}\n i := AbZipOutline1.GetOutlineItem( X, Y );\n if i <> -1 then\n AbZipOutline1.SelectedItem := i;\n end;\n if AbZipOutline1.SelectedZipItem <> nil then begin\n PC.X := X;\n PC.Y := Y;\n PS := AbZipOutline1.ClientToScreen( PC );\n AbZipOutline1.PopupMenu.Popup( PS.X, PS.Y );\n end;\n end;\nend;\n\nprocedure TForm1.FileListBox1DragOver(Sender, Source: TObject; X,\n Y: Integer; State: TDragState; var Accept: Boolean);\nbegin\n Accept := Source is TAbZipOutline;\nend;\n\nprocedure TForm1.FileListBox1DragDrop(Sender, Source: TObject; X,\n Y: Integer);\nvar\n TempDir : string;\nbegin\n if Source is TAbZipOutline then\n with (Source as TAbZipOutline ) do begin\n TempDir := BaseDirectory;\n BaseDirectory := FileListBox1.Directory;\n try\n ExtractFiles( SelectedZipItem.FileName );\n FileListBox1.Update;\n finally\n BaseDirectory := TempDir;\n end;\n end;\nend;\n\nprocedure TForm1.AbZipOutline1WindowsDrop(Sender: TObject;\n FileName: string);\nvar\n ZB : TAbZipBrowser;\n IsZip : Boolean;\nbegin\n IsZip := False;\n ZB := TAbZipBrowser.Create( Self );\n try\n try\n ZB.FileName := FileName;\n IsZip := True;\n except\n end;\n finally\n ZB.Free;\n end;\n\n if IsZip and ( AbZipOutline1.FileName = '' ) then\n AbZipOutline1.FileName := FileName\n else if AbZipOutline1.FileName = '' then begin\n if OpenDialog1.Execute then begin\n AbZipOutline1.FileName := OpenDialog1.FileName;\n AbZipOutline1.AddFiles( FileName, 0 );\n end;\n end\n else begin\n {This is a Zip file, but there's already an open archive}\n if Application.MessageBox( 'Open this file as an archive?',\n 'Open or Add File', MB_YESNO ) = IDYES then\n AbZipOutline1.FileName := FileName\n else\n AbZipOutline1.AddFiles( FileName, 0 );\n end;\nend;\n\nprocedure TForm1.Best1Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n Store1.Checked := False;\n Deflate1.Checked := False;\n Best1.Checked := False;\n Item := (Sender as TMenuItem);\n Item.Checked := True;\n AbZipOutline1.CompressionMethodToUse := TAbZipSupportedMethod( Item.Tag );\nend;\n\nprocedure TForm1.SuperFast1Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n Normal1.Checked := False;\n Maximum1.Checked := False;\n Fast1.Checked := False;\n SuperFast1.Checked := False;\n Item := (Sender as TMenuItem);\n Item.Checked := True;\n AbZipOutline1.DeflationOption := TAbZipDeflationOption( Item.Tag );\nend;\n\nprocedure TForm1.CreateDirs1Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n Item := Sender as TMenuItem;\n Item.Checked := not Item.Checked;\n if Item.Checked then\n AbZipOutline1.ExtractOptions := AbZipOutline1.ExtractOptions +\n [eoCreateDirs]\n else\n AbZipOutline1.ExtractOptions := AbZipOutline1.ExtractOptions -\n [eoCreateDirs];\nend;\n\nprocedure TForm1.RestorePath1Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n Item := Sender as TMenuItem;\n Item.Checked := not Item.Checked;\n if Item.Checked then\n AbZipOutline1.ExtractOptions := AbZipOutline1.ExtractOptions +\n [eoRestorePath]\n else\n AbZipOutline1.ExtractOptions := AbZipOutline1.ExtractOptions -\n [eoRestorePath];\nend;\n\nprocedure TForm1.StripPath1Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n Item := Sender as TMenuItem;\n Item.Checked := not Item.Checked;\n if Item.Checked then\n AbZipOutline1.StoreOptions := AbZipOutline1.StoreOptions +\n [TAbStoreOption(Item.Tag)]\n else\n AbZipOutline1.StoreOptions := AbZipOutline1.StoreOptions -\n [TAbStoreOption(Item.Tag)];\nend;\n\nprocedure TForm1.AbZipOutline1Change(Sender: TObject);\nbegin\n if AbZipOutline1.FileName <> '' then\n ArchiveLabel.Caption := Format( 'Archive %s contains %d items.',\n [AbZipOutline1.FileName, AbZipOutline1.Count] )\n else\n ArchiveLabel.Caption := 'No Archive Open';\nend;\n\nprocedure TForm1.Confirmations1Click(Sender: TObject);\nbegin\n Confirmations1.Checked := not Confirmations1.Checked;\n SpeedButton7.Down := Confirmations1.Checked;\nend;\n\nprocedure TForm1.DoConfirm( Sender : TObject; Item : TAbArchiveItem;\n var Confirm : Boolean; Caption : string );\nvar\n pMessage : array [0..255] of Char;\n pCaption : array [0..80] of Char;\nbegin\n if Confirmations1.Checked then\n Confirm := MessageBox( 0,\n StrPCopy( pMessage,\n Format( '%s %s?',\n [Caption, Item.FileName] ) ),\n StrPCopy( pCaption, 'Confirmation' ),\n MB_ICONQUESTION or MB_OKCANCEL ) = IDOK;\nend;\n\nprocedure TForm1.AbZipOutline1ConfirmSave(Sender: TObject;\n var Confirm: Boolean);\nvar\n pMessage : array [0..255] of Char;\n pCaption : array [0..80] of Char;\nbegin\n if Confirmations1.Checked then\n Confirm := MessageBox( 0,\n StrPCopy( pMessage,\n Format( 'Save %s?',\n [TAbZipOutline(Sender).FileName] ) ),\n StrPCopy( pCaption, 'Confirmation' ),\n MB_ICONQUESTION or MB_OKCANCEL ) = IDOK;\nend;\n\nprocedure TForm1.Delete1Click(Sender: TObject);\nbegin\n if AbZipOutline1.SelectedZipItem <> nil then\n with AbZipOutline1 do begin\n AbZipOutline1.ClearTags;\n SelectedZipItem.Tagged := True;\n try\n DeleteTaggedItems;\n finally\n ClearTags;\n end;\n end;\nend;\n\nprocedure TForm1.Extract1Click(Sender: TObject);\nbegin\n if AbZipOutline1.SelectedZipItem <> nil then begin\n BaseDirDlg := TBaseDirDlg.Create( Application );\n try\n with BaseDirDlg, AbZipOutline1 do begin\n Caption := 'Extract Selected File';\n Edit1.Text := SelectedZipItem.FileName;\n Edit1.Enabled := False;\n ActionLabel.Caption := 'Target Directory:';\n if BaseDirectory <> '' then\n DLB.Directory := BaseDirectory;\n CheckBox1.Caption := 'Restore Path';\n CheckBox1.Checked := eoRestorePath in ExtractOptions;\n CheckBox2.Caption := 'Create Directories';\n CheckBox2.Checked := eoCreateDirs in ExtractOptions;\n ShowModal;\n if ModalResult = mrOK then begin\n BaseDirectory := DirLabel.Caption;\n if CheckBox1.Checked then\n ExtractOptions := ExtractOptions + [eoRestorePath]\n else\n ExtractOptions := ExtractOptions - [eoRestorePath];\n if CheckBox2.Checked then\n ExtractOptions := ExtractOptions + [eoCreateDirs]\n else\n ExtractOptions := ExtractOptions - [eoCreateDirs];\n ClearTags;\n SelectedZipItem.Tagged := True;\n try\n ExtractTaggedItems;\n finally\n ClearTags;\n end;\n FileListBox1.Update;\n end;\n end;\n finally\n BaseDirDlg.Free;\n end;\n end;\nend;\n\nprocedure TForm1.Freshen1Click(Sender: TObject);\nbegin\n if AbZipOutline1.SelectedZipItem <> nil then begin\n BaseDirDlg := TBaseDirDlg.Create( Application );\n try\n with BaseDirDlg, AbZipOutline1 do begin\n Caption := 'Freshen Selected File';\n Edit1.Text := SelectedZipItem.FileName;\n Edit1.Enabled := False;\n ActionLabel.Caption := 'Source Directory:';\n if BaseDirectory <> '' then\n DLB.Directory := BaseDirectory;\n CheckBox1.Caption := 'Recurse';\n CheckBox1.Checked := soRecurse in StoreOptions;\n CheckBox2.Caption := 'Strip Path';\n CheckBox2.Checked := soStripPath in StoreOptions;\n\n ShowModal;\n if ModalResult = mrOK then begin\n if CheckBox1.Checked then\n StoreOptions := StoreOptions + [soRecurse]\n else\n StoreOptions := StoreOptions - [soRecurse];\n if CheckBox2.Checked then\n StoreOptions := StoreOptions + [soStripPath]\n else\n StoreOptions := StoreOptions - [soStripPath];\n BaseDirectory := DirLabel.Caption;\n\n ClearTags;\n SelectedZipItem.Tagged := True;\n try\n FreshenTaggedItems;\n finally\n ClearTags;\n end;\n FileListBox1.Update;\n end;\n end;\n finally\n BaseDirDlg.Free;\n end;\n end;\nend;\n\nprocedure TForm1.Move1Click(Sender: TObject);\nbegin\n DemoDlg := TDemoDlg.Create( Application );\n try\n with DemoDlg do begin\n Caption := 'Move File to New Path';\n Edit1.Text := AbZipOutline1.SelectedZipItem.FileName;\n ShowModal;\n if ModalResult = mrOK then\n AbZipOutline1.Move( AbZipOutline1.SelectedZipItem, Edit1.Text );\n end;\n finally\n DemoDlg.Free;\n end;\nend;\n\nprocedure TForm1.Password1Click(Sender: TObject);\nvar\n Dlg : TPassWordDlg;\nbegin\n Dlg := TPassWordDlg.Create( Application );\n try\n Dlg.Edit1.Text := string(AbZipOutline1.Password);\n Dlg.ShowModal;\n if Dlg.ModalResult = mrOK then\n AbZipOutline1.Password := AnsiString(Dlg.Edit1.Text);\n finally\n Dlg.Free;\n end;\n if Length( AbZipOutline1.Password ) > 0 then\n Image1.Visible := True\n else\n Image1.Visible := False;\nend;\n\nprocedure TForm1.AddFiles1Click(Sender: TObject);\nbegin\n BaseDirDlg := TBaseDirDlg.Create( Application );\n try\n with BaseDirDlg, AbZipOutline1 do begin\n Caption := 'Add Files with FileMask';\n Edit1.Text := '*.*';\n ActionLabel.Caption := 'Source Directory';\n CheckBox1.Caption := 'Recurse';\n CheckBox1.Checked := soRecurse in StoreOptions;\n CheckBox2.Caption := 'Strip Path';\n CheckBox2.Checked := soStripPath in StoreOptions;\n\n if BaseDirectory <> '' then\n DLB.Directory := BaseDirectory;\n\n ShowModal;\n if ModalResult = mrOK then begin\n if CheckBox1.Checked then\n StoreOptions := StoreOptions + [soRecurse]\n else\n StoreOptions := StoreOptions - [soRecurse];\n if CheckBox2.Checked then\n StoreOptions := StoreOptions + [soStripPath]\n else\n StoreOptions := StoreOptions - [soStripPath];\n BaseDirectory := DirLabel.Caption;\n AddFiles( Edit1.Text, 0 );\n end;\n end;\n finally\n BaseDirDlg.Free;\n end;\nend;\n\nprocedure TForm1.FreshenFiles1Click(Sender: TObject);\nbegin\n BaseDirDlg := TBaseDirDlg.Create( Application );\n try\n with BaseDirDlg, AbZipOutline1 do begin\n Caption := 'Freshen Files with FileMask';\n Edit1.Text := '*.*';\n ActionLabel.Caption := 'Source Directory';\n CheckBox1.Caption := 'Recurse';\n CheckBox1.Checked := soRecurse in StoreOptions;\n CheckBox2.Caption := 'Strip Path';\n CheckBox2.Checked := soStripPath in StoreOptions;\n if BaseDirectory <> '' then\n DLB.Directory := BaseDirectory;\n\n ShowModal;\n if ModalResult = mrOK then begin\n if CheckBox1.Checked then\n StoreOptions := StoreOptions + [soRecurse]\n else\n StoreOptions := StoreOptions - [soRecurse];\n if CheckBox2.Checked then\n StoreOptions := StoreOptions + [soStripPath]\n else\n StoreOptions := StoreOptions - [soStripPath];\n BaseDirectory := DirLabel.Caption;\n FreshenFiles( Edit1.Text );\n end;\n end;\n finally\n BaseDirDlg.Free;\n end;\nend;\n\nprocedure TForm1.SelectBaseDirectory1Click(Sender: TObject);\nbegin\n with TAbDirDlg.Create(Self) do begin\n Caption := 'Directory';\n AdditionalText := 'Select folder to extract into';\n if Execute then\n AbZipOutline1.BaseDirectory := SelectedFolder;\n Free;\n end;\nend;\n\nprocedure TForm1.AbZipOutline1ArchiveItemProgress(Sender: TObject;\n Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);\nvar\n ActionString : string;\nbegin\n case Item.Action of\n aaAdd : ActionString := 'Adding ';\n aaFreshen : ActionString := 'Freshening ';\n else\n ActionString :='Extracting ';\n end;\n Panel5.Caption := ActionString + Item.FileName + ' ';\n if Progress = 100 then begin\n Panel5.Caption := 'Finished ';\n end;\nend;\n\nprocedure TForm1.AbZipOutline1NeedPassword(Sender: TObject;\n var NewPassword: AnsiString);\nvar\n Dlg : TPassWordDlg;\nbegin\n Dlg := TPassWordDlg.Create( Application );\n try\n Dlg.ShowModal;\n if Dlg.ModalResult = mrOK then\n NewPassword := AnsiString(Dlg.Edit1.Text);\n finally\n Dlg.Free;\n end;\n if Length( NewPassword ) > 0 then\n Image1.Visible := True;\nend;\n\nprocedure TForm1.DeleteFiles1Click(Sender: TObject);\nbegin\n DemoDlg := TDemoDlg.Create( Application );\n try\n with DemoDlg do begin\n Caption := 'Delete Files with FileMask';\n Edit1.Text := '*.*';\n ShowModal;\n if ModalResult = mrOK then\n AbZipOutline1.DeleteFiles( Edit1.Text );\n end;\n finally\n DemoDlg.Free;\n end;\nend;\n\nprocedure TForm1.ExtractFiles1Click(Sender: TObject);\nbegin\n BaseDirDlg := TBaseDirDlg.Create( Application );\n try\n with BaseDirDlg, AbZipOutline1 do begin\n Caption := 'Extract Files with FileMask';\n Edit1.Text := '*.*';\n ActionLabel.Caption := 'Target Directory:';\n if BaseDirectory <> '' then\n DLB.Directory := BaseDirectory;\n CheckBox1.Caption := 'Restore Path';\n CheckBox1.Checked := eoRestorePath in ExtractOptions;\n CheckBox2.Caption := 'Create Directories';\n CheckBox2.Checked := eoCreateDirs in ExtractOptions;\n ShowModal;\n if ModalResult = mrOK then begin\n BaseDirectory := BaseDirDlg.DLB.Directory;\n if CheckBox1.Checked then\n ExtractOptions := ExtractOptions + [eoRestorePath]\n else\n ExtractOptions := ExtractOptions - [eoRestorePath];\n if CheckBox2.Checked then\n ExtractOptions := ExtractOptions + [eoCreateDirs]\n else\n ExtractOptions := ExtractOptions - [eoCreateDirs];\n ExtractFiles( Edit1.Text );\n FileListBox1.Update;\n end;\n end;\n finally\n BaseDirDlg.Free;\n end;\nend;\n\nprocedure TForm1.FormDestroy(Sender: TObject);\nbegin\n AbZipOutline1.Save;\n SaveIniSettings;\nend;\n\nprocedure TForm1.ReadIniSettings;\nvar\n Value : Integer;\n Exists : Boolean;\nbegin\n with TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) ) do begin\n try\n {view menu}\n Exists := ReadBool( 'General', 'Exists', False );\n if Exists then begin\n AbZipOutline1.Attributes := [];\n if ReadBool( 'View', 'CSize', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaCompressedSize];\n if ReadBool( 'View', 'CMethod', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaCompressionMethod];\n if ReadBool( 'View', 'CRatio', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaCompressionRatio];\n if ReadBool( 'View', 'CRC', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaCRC];\n if ReadBool( 'View', 'EFA', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaExternalFileAttributes];\n if ReadBool( 'View', 'IFA', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaInternalFileAttributes];\n if ReadBool( 'View', 'Encryption', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaEncryption];\n if ReadBool( 'View', 'TimeStamp', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaTimeStamp];\n if ReadBool( 'View', 'USize', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaUnCompressedSize];\n if ReadBool( 'View', 'MadeBy', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaVersionMade];\n if ReadBool( 'View', 'Needed', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaVersionNeeded];\n if ReadBool( 'View', 'Comment', False ) then\n AbZipOutline1.Attributes := AbZipOutline1.Attributes +\n [zaComment];\n\n AbZipOutline1.Hierarchy := ReadBool( 'View', 'Hierarchy', True );\n\n// Value := ReadInteger( 'View', 'OutlineStyle', -1 );\n// if Value <> -1 then\n// AbZipOutline1.OutlineStyle := TOutlineStyle( Value );\n {preferences menu}\n AbZipOutline1.BaseDirectory := ReadString( 'Preferences',\n 'BaseDirectory',\n ExtractFilePath( Application.ExeName ) );\n if not DirectoryExists( AbZipOutline1.BaseDirectory ) then\n AbZipOutline1.BaseDirectory := ExtractFilePath( Application.ExeName );\n Confirmations1.Checked := ReadBool( 'Preferences',\n 'Confirmations', False );\n SpeedButton7.Down := Confirmations1.Checked;\n Value := ReadInteger( 'Preferences',\n 'CompressionMethodToUse',\n Ord( smBestMethod ) );\n AbZipOutline1.CompressionMethodToUse := TAbZipSupportedMethod( Value );\n Value := ReadInteger( 'Preferences', 'DeflationOption', Ord( doNormal));\n AbZipOutline1.DeflationOption := TAbZipDeflationOption( Value );\n AbZipOutline1.ExtractOptions := [];\n if ReadBool( 'Preferences', 'CreateDirs', False ) then\n AbZipOutline1.ExtractOptions := AbZipOutline1.ExtractOptions +\n [eoCreateDirs];\n if ReadBool( 'Preferences', 'RestorePath', False ) then\n AbZipOutline1.ExtractOptions := AbZipOutline1.ExtractOptions +\n [eoRestorePath];\n AbZipOutline1.StoreOptions := [];\n if ReadBool( 'Preferences', 'StripPath', False ) then\n AbZipOutline1.StoreOptions := AbZipOutline1.StoreOptions +\n [soStripPath];\n if ReadBool( 'Preferences', 'RemoveDots', False ) then\n AbZipOutline1.StoreOptions := AbZipOutline1.StoreOptions +\n [soRemoveDots];\n if ReadBool( 'Preferences', 'Recurse', False ) then\n AbZipOutline1.StoreOptions := AbZipOutline1.StoreOptions +\n [soRecurse];\n StubName := ReadString( 'Self Extracting', 'StubName', 'selfex.exe' );\n FilterComboBox1.Filter := ReadString( 'Navigator', 'Filter',\n 'All files (*.*)|*.*|Zip Files (*.ZIP)|*.ZIP|' +\n 'Executable Files (*.EXE)|*.EXE|Text files (*.TXT)|*.TXT|' +\n 'Pascal files (*.PAS)|*.PAS' );\n end;\n finally\n Free;\n end;\n end;\nend;\n\nprocedure TForm1.SaveIniSettings;\nbegin\n with TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) ) do begin\n try\n {view menu}\n WriteBool( 'General', 'Exists', True );\n with AbZipOutline1 do begin\n WriteBool( 'View', 'CSize', zaCompressedSize in Attributes );\n WriteBool( 'View', 'CMethod', zaCompressionMethod in Attributes );\n WriteBool( 'View', 'CRatio', zaCompressionRatio in Attributes );\n WriteBool( 'View', 'CRC', zaCRC in Attributes );\n WriteBool( 'View', 'EFA', zaExternalFileAttributes in Attributes );\n WriteBool( 'View', 'IFA', zaInternalFileAttributes in Attributes );\n WriteBool( 'View', 'Encryption', zaEncryption in Attributes );\n WriteBool( 'View', 'TimeStamp', zaTimeStamp in Attributes );\n WriteBool( 'View', 'USize', zaUnCompressedSize in Attributes );\n WriteBool( 'View', 'MadeBy', zaVersionMade in Attributes );\n WriteBool( 'View', 'Needed', zaVersionNeeded in Attributes );\n WriteBool( 'View', 'Comment', zaComment in Attributes );\n\n WriteBool( 'View', 'Hierarchy', Hierarchy );\n// WriteInteger( 'View', 'OutlineStyle', Ord( OutlineStyle ) );\n {preferences menu}\n WriteString( 'Preferences', 'BaseDirectory', BaseDirectory );\n WriteBool( 'Preferences', 'Confirmations', Confirmations1.Checked );\n WriteInteger( 'Preferences', 'CompressionMethodToUse',\n Ord( CompressionMethodToUse ) );\n WriteInteger( 'Preferences', 'DeflationOption',\n Ord( DeflationOption ));\n\n WriteBool( 'Preferences', 'CreateDirs',\n eoCreateDirs in ExtractOptions );\n WriteBool( 'Preferences', 'RestorePath',\n eoRestorePath in ExtractOptions );\n WriteBool( 'Preferences', 'StripPath', soStripPath in StoreOptions );\n WriteBool( 'Preferences', 'RemoveDots', soRemoveDots in StoreOptions );\n WriteBool( 'Preferences', 'Recurse', soRecurse in StoreOptions );\n end;\n finally\n Free;\n end;\n end;\nend;\n\nprocedure TForm1.Close1Click(Sender: TObject);\nbegin\n AbZipOutline1.FileName := '';\n AbZipOutline1.Color := clBtnFace;\nend;\n\nprocedure TForm1.AbZipOutline1Load(Sender: TObject);\nbegin\n IgnoreDuplicateWarning := False;\n AbZipOutline1.Color := clWindow;\n SetCaption;\nend;\n\nprocedure TForm1.Convert1Click(Sender: TObject);\nvar\n ZipName : string;\n ExeName : string;\n StubSpec : string;\n StubStream, ZipStream, SelfExtractingStream : TStream;\nbegin\n AbZipOutline1.Save;\n ZipName := ExpandFileName( AbZipOutline1.FileName );\n AbZipOutline1.FileName := '';\n\n ExeName := ChangeFileExt( ZipName, '.exe' );\n StubSpec := ExtractFilePath( Application.ExeName ) + StubName;\n\n StubStream := TFileStream.Create( StubSpec, fmOpenRead or fmShareDenyWrite );\n ZipStream := TFileStream.Create( ZipName , fmOpenRead or fmShareDenyWrite );\n SelfExtractingStream := TFileStream.Create( ExeName,\n fmCreate or fmShareExclusive );\n try\n MakeSelfExtracting( StubStream, ZipStream, SelfExtractingStream );\n finally\n SelfExtractingStream.Free;\n StubStream.Free;\n ZipStream.Free;\n end;\n {and reload...}\n AbZipOutline1.FileName := ExeName;\nend;\n\nprocedure TForm1.GetMinMaxInfo( var Msg: TWMGetMinMaxInfo );\nbegin\n with Msg.MinMaxInfo^ do begin\n ptMinTrackSize := Point( 700, 400 );\n ptMaxTrackSize := Point( 1600, 1200 );\n end;\nend;\n\nprocedure TForm1.AbZipOutline1ConfirmOverwrite(var Name: string;\n var Confirm: Boolean);\nvar\n pMessage : array [0..255] of Char;\n pCaption : array [0..80] of Char;\nbegin\n Confirm := MessageBox( 0,\n StrPCopy( pMessage,\n Format( 'Overwrite %s?',\n [Name] ) ),\n StrPCopy( pCaption, 'Confirmation' ),\n MB_ICONQUESTION or MB_OKCANCEL ) = IDOK;\nend;\n\nprocedure TForm1.Default1Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n AbZipOutline1.Attributes := AbDefZipAttributes;\n for i := 0 to Ord( High( TAbZipAttribute ) ) do\n Attributes1.Items[i].Checked := TAbZipAttribute(i) in AbDefZipAttributes;\n AbZipOutline1.Update;\nend;\n\nprocedure TForm1.Contents1Click(Sender: TObject);\nbegin\n Application.HelpCommand(HELP_CONTENTS, 0);\nend;\n\nprocedure TForm1.About1Click(Sender: TObject);\nbegin\n dlgAboutBox := TDlgAboutBox.Create( Self );\n try\n dlgAboutBox.ShowModal;\n finally\n dlgAboutBox.Free;\n end;\nend;\n\nprocedure TForm1.FileListBox1DblClick(Sender: TObject);\nvar\n Browser : TAbZipBrowser;\n Filename : string;\n OK : Boolean;\nbegin\n Filename := IncludeTrailingPathDelimiter(DirectoryListBox1.Directory) +\n FileListBox1.Items[FileListBox1.ItemIndex];\n if AbZipOutline1.FileName = '' then\n try\n AbZipOutline1.FileName := Filename;\n except\n AbZipOutline1.FileName := '';\n end\n else begin\n Browser := TAbZipBrowser.Create( Self );\n OK := True;\n try\n try\n Browser.FileName := Filename;\n except\n OK := False;\n end;\n finally\n Browser.Free;\n end;\n if OK then\n AbZipOutline1.FileName := Filename;\n end;\nend;\n\nprocedure TForm1.AbZipOutline1EndDrag(Sender, Target: TObject; X,\n Y: Integer);\nbegin\n FileListBox1.Update;\nend;\n\nprocedure TForm1.FileListBox1MouseDown(Sender: TObject;\n Button: TMouseButton; Shift: TShiftState; X, Y: Integer);\nbegin\n if Button = mbLeft then begin\n FileX := X;\n FileY := Y;\n end;\nend;\n\nprocedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;\n X, Y: Integer);\nbegin\n if ssLeft in Shift then\n if ( ( X - FileX ) * ( X - FileX ) +\n ( Y - FileY ) * ( Y - FileY ) > 100 ) then\n if FileListBox1.SelCount > 0 then\n if ( not FileListBox1.Dragging ) then\n FileListBox1.BeginDrag( True );\nend;\n\nprocedure TForm1.AbZipOutline1MouseMove(Sender: TObject;\n Shift: TShiftState; X, Y: Integer);\nbegin\n if ssLeft in Shift then\n if ( ( X - OutlineX ) * ( X - OutlineX ) +\n ( Y - OutlineY ) * ( Y - OutlineY ) > 100 ) then\n if AbZipOutline1.SelectedZipItem <> nil then\n if ( not FileListBox1.Dragging ) then\n AbZipOutline1.BeginDrag( True );\nend;\n\nprocedure TForm1.Edit1Exit(Sender: TObject);\nbegin\n FileListBox1.ApplyFilePath(Edit1.Text);\nend;\n\nprocedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);\nbegin\n if Key = #13 then\n Edit1Exit( Self );\nend;\n\nprocedure TForm1.OS5Click(Sender: TObject);\nvar\n Item : TMenuItem;\nbegin\n OS1.Checked := False;\n OS2.Checked := False;\n OS3.Checked := False;\n OS4.Checked := False;\n OS5.Checked := False;\n OS6.Checked := False;\n\n Item := (Sender as TMenuItem);\n Item.Checked := True;\n// AbZipOutline1.OutlineStyle := TOutlineStyle( Item.Tag );\nend;\n\nprocedure TForm1.AbZipOutline1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\nvar\n Process : string;\nbegin\n Confirm := True;\n case ProcessType of\n ptAdd : Process := 'Add';\n ptDelete : Process := 'Delete';\n ptExtract : Process := 'Extract';\n ptFreshen : Process := 'Freshen';\n ptMove : Process := 'Move';\n end;\n DoConfirm( Sender, Item, Confirm, Process );\nend;\n\nprocedure TForm1.AbZipOutline1ProcessItemFailure(Sender: TObject;\n Item: TAbArchiveItem; const ProcessType: TAbProcessType;\n ErrorClass: TAbErrorClass; ErrorCode: Integer);\nvar\n S : string;\n pMessage : array [0..128] of Char;\nbegin\n if ( ErrorClass = ecAbbrevia ) and\n ( ErrorCode = AbDuplicateName ) then begin\n if not IgnoreDuplicateWarning then begin\n if ProcessType = ptAdd then\n s := 'Cannot add '\n else\n s := 'Cannot move ';\n s := s + Item.FileName +\n '. Would create a duplicate name. Ignore future warnings?';\n if (Application.MessageBox( StrPCopy( pMessage, s ), 'Warning',\n MB_YESNO ) = IDYES ) then\n IgnoreDuplicateWarning := True;\n end;\n Exit;\n end;\n\n case ProcessType of\n ptAdd :\n ShowMessage( 'Cannot add ' + Item.FileName + ' to ' +\n TAbZipOutline(Sender).FileName );\n ptExtract :\n ShowMessage( 'Cannot extract ' + Item.FileName + ' from ' +\n TAbZipOutline(Sender).FileName );\n ptFreshen :\n ShowMessage( 'Cannot freshen ' + Item.FileName + ' in ' +\n TAbZipOutline(Sender).FileName );\n ptMove :\n ShowMessage( 'Cannot move ' + Item.FileName + ' to ' +\n TAbZipOutline(Sender).FileName );\n end;\n if ErrorClass = ecAbbrevia then\n ShowMessage( AbStrRes(ErrorCode) );\nend;\n\nprocedure TForm1.TurboPowerontheWeb1Click(Sender: TObject);\nbegin\n if ShellExecute(0, 'open', 'http://www.turbopower.com', '', '', SW_SHOWNORMAL) <= 32 then\n ShowMessage('Unable to start web browser. Make sure you have it properly set-up on your system.');\nend;\n\nprocedure TForm1.AbbreviaontheWeb1Click(Sender: TObject);\nbegin\n if ShellExecute(0, 'open', 'http://sf.net/projects/tpabbrevia', '', '', SW_SHOWNORMAL) <= 32 then\n ShowMessage('Unable to start web browser. Make sure you have it properly set-up on your system.');\nend;\n\nprocedure TForm1.TempDirectory1Click(Sender: TObject);\nbegin\n with TAbDirDlg.Create(Self) do begin\n Caption := 'Directory';\n AdditionalText := 'Select temporary directory';\n if Execute then\n AbZipOutline1.TempDirectory := SelectedFolder;\n Free;\n end;\nend;\n\nprocedure TForm1.Logging1Click(Sender: TObject);\nvar\n E, F : string;\nbegin\n AbZipOutline1.Logging := False;\n Logging1.Checked := not Logging1.Checked;\n if Logging1.Checked then with OpenDialog1 do begin\n Title := 'Select Text File for Logging';\n E := DefaultExt;\n DefaultExt := '';\n F := Filter;\n Filter := '';\n Filename := AbZipOutline1.LogFile;\n if Execute then begin\n AbZipOutline1.LogFile := Filename;\n AbZipOutline1.Logging := True;\n end;\n DefaultExt := E;\n Filter := F;\n end;\n Logging1.Checked := AbZipOutline1.Logging;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Uexample.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UEXAMPLE.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit uexample;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n Menus, ExtCtrls, Gauges, StdCtrls,\n\n AbZipOut, AbArcTyp, AbMeter, AbBase, AbUtils;\n\ntype\n TForm1 = class(TForm)\n BottomStatus: TPanel;\n MainMenu1: TMainMenu;\n File1: TMenuItem;\n Open1: TMenuItem;\n N1: TMenuItem;\n Exit1: TMenuItem;\n OpenDialog1: TOpenDialog;\n TopStatus: TPanel;\n PopupMenu1: TPopupMenu;\n Add1: TMenuItem;\n Delete1: TMenuItem;\n Extract1: TMenuItem;\n Freshen1: TMenuItem;\n Move1: TMenuItem;\n Panel1: TPanel;\n Memo1: TMemo;\n AbMeter1: TAbMeter;\n AbMeter2: TAbMeter;\n Label1: TLabel;\n Label2: TLabel;\n AbZipOutline1: TAbZipOutline;\n procedure Open1Click(Sender: TObject);\n procedure Exit1Click(Sender: TObject);\n procedure AbZipOutline1Load(Sender: TObject);\n procedure AbZipOutline1MouseDown(Sender: TObject; Button: TMouseButton;\n Shift: TShiftState; X, Y: Integer);\n procedure Delete1Click(Sender: TObject);\n procedure Extract1Click(Sender: TObject);\n procedure Freshen1Click(Sender: TObject);\n procedure Add1Click(Sender: TObject);\n procedure Move1Click(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n procedure AbZipOutline1ProcessItemFailure(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n ErrorClass: TAbErrorClass; ErrorCode: Integer);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\nuses udemodlg;\n\n{$R *.DFM}\n\nprocedure TForm1.Open1Click(Sender: TObject);\nbegin\n if OpenDialog1.Execute then begin\n AbZipOutline1.OpenArchive(OpenDialog1.FileName);\n end;\nend;\n\nprocedure TForm1.Exit1Click(Sender: TObject);\nbegin\n Close;\nend;\n\nprocedure TForm1.AbZipOutline1Load(Sender: TObject);\nbegin\n TopStatus.Caption := ' ' + AbZipOutline1.FileName;\nend;\n\n\nprocedure TForm1.AbZipOutline1MouseDown(Sender: TObject;\n Button: TMouseButton; Shift: TShiftState; X, Y: Integer);\nvar\n i : LongInt;\nbegin\n if Button = mbRight then begin\n {prepare popup menu}\n if AbZipOutline1.Count > 0 then begin\n {there are items in the outline - select the item under the mouse}\n i := AbZipOutline1.GetOutlineItem( X, Y );\n if i <> -1 then\n AbZipOutline1.SelectedItem := i;\n end;\n if AbZipOutline1.FileName <> '' then\n Add1.Enabled := True\n else\n {archive has to be initialized before we can add to it}\n Add1.Enabled := False;\n if AbZipOutline1.SelectedZipItem <> nil then begin\n {pointing at a file - allow file operations}\n Delete1.Enabled := True;\n Extract1.Enabled := True;\n Freshen1.Enabled := True;\n Move1.Enabled := True;\n end\n else begin\n {pointing at a directory - don't allow file operations}\n Delete1.Enabled := False;\n Extract1.Enabled := False;\n Freshen1.Enabled := False;\n Move1.Enabled := False;\n end;\n end;\nend;\n\nprocedure TForm1.Delete1Click(Sender: TObject);\nbegin\n AbZipOutline1.DeleteFiles(AbZipOutline1.SelectedZipItem.FileName);\nend;\n\nprocedure TForm1.Extract1Click(Sender: TObject);\nbegin\n AbZipOutline1.ExtractFiles(AbZipOutline1.SelectedZipItem.FileName);\nend;\n\nprocedure TForm1.Freshen1Click(Sender: TObject);\nbegin\n AbZipOutline1.FreshenFiles(AbZipOutline1.SelectedZipItem.FileName);\nend;\n\nprocedure TForm1.Add1Click(Sender: TObject);\nbegin\n DemoDlg.Caption := 'Add Files with FileMask';\n DemoDlg.Edit1.Text := '*.*';\n DemoDlg.ShowModal;\n if DemoDlg.ModalResult = mrOK then\n AbZipOutline1.AddFiles(DemoDlg.Edit1.Text, 0);\nend;\n\nprocedure TForm1.Move1Click(Sender: TObject);\nbegin\n DemoDlg.Caption := 'Move File to New Name';\n DemoDlg.Edit1.Text := AbZipOutline1.SelectedZipItem.FileName;\n DemoDlg.ShowModal;\n if DemoDlg.ModalResult = mrOK then\n AbZipOutline1.Move(AbZipOutline1.SelectedZipItem, DemoDlg.Edit1.Text);\nend;\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n AbZipOutline1.BaseDirectory := ExtractFilePath( Application.ExeName );\nend;\n\nprocedure TForm1.AbZipOutline1ProcessItemFailure(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n ErrorClass: TAbErrorClass; ErrorCode: Integer);\nbegin\n case ProcessType of\n ptAdd : ShowMessage( 'Failed to add ' + Item.Filename );\n ptExtract : ShowMessage('Failed to extract ' + Item.Filename);\n ptFreshen : ShowMessage('Failed to freshen ' + Item.Filename);\n end;\nend;\n\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Unzip.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UNZIP.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram Unzip;\n\nuses\n Forms,\n Uunzip in 'Uunzip.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Unzip.dproj",
"content": "\t\n\t\t\n\t\t\t{4193EA89-8316-4EA6-824B-CD35E8A098C8}\n\t\t\tUnzip.dpr\n\t\t\tTrue\n\t\t\tDebug\n\t\t\tWin32\n\t\t\tApplication\n\t\t\tVCL\n\t\t\tDCC32\n\t\t\t12.3\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\t00400000\n\t\t\tWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tVCLApplication\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tUnzip.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Unzip.dproj.2007",
"content": "\t\n\t\t\n\t\t\t{4193EA89-8316-4EA6-824B-CD35E8A098C8}\n\t\t\tUnzip.dpr\n\t\t\tTrue\n\t\t\tDebug\n\t\t\tWin32\n\t\t\tApplication\n\t\t\tVCL\n\t\t\tDCC32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tfalse\n\t\t\t00400000\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tVCLApplication\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tUnzip.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/examples/Delphi/UsingApi.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: USINGAPI.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\n{$APPTYPE CONSOLE}\n\nprogram UsingAPI;\n\n{Build this app using the Define \"BuildingStub\", to keep it smaller!}\n\nuses\n AbArcTyp, AbZipTyp, AbZipPrc, AbUnzPrc, Classes, SysUtils, AbUtils;\n\ntype\n THelper = class\n public\n procedure UnzipProc( Sender : TObject; Item : TAbArchiveItem;\n const NewName : string );\n procedure ZipProc( Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream );\n procedure ArchiveItemProgress( Sender: TObject;\n Item: TAbArchiveItem;\n Progress: Byte;\n var Abort: Boolean);\n end;\n\nprocedure THelper.ArchiveItemProgress( Sender: TObject;\n Item: TAbArchiveItem; Progress: Byte; var Abort: Boolean);\ntype\n TMethodStrings = array [ cmStored..cmDCLImploded ] of string;\nconst\n MethodStrings : TMethodStrings = ('UnStoring', 'UnShrinking', 'UnReducing',\n 'UnReducing', 'UnReducing', 'UnReducing',\n 'Exploding', 'DeTokenizing', 'Inflating',\n 'Enhanced Inflating', 'DCL Exploding');\nvar\n ActionString : string;\n CompMethod: TAbZipCompressionMethod;\nbegin\n case Item.Action of\n\n aaAdd : ActionString := 'Adding ';\n aaFreshen : ActionString := 'Freshening ';\n else begin\n CompMethod := (Item as TAbZipItem).CompressionMethod;\n if CompMethod in [cmStored..cmDCLImploded] then\n ActionString := MethodStrings[(Item as TAbZipItem).CompressionMethod] +\n ' '\n else\n ActionString := 'Decompressing ';\n end;\n end;\n WriteLn( ActionString + Item.FileName );\nend;\n\nprocedure THelper.UnzipProc( Sender : TObject; Item : TAbArchiveItem;\n const NewName : string );\nbegin\n AbUnzip( Sender, TAbZipItem(Item), NewName );\nend;\n\nprocedure THelper.ZipProc( Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream );\nbegin\n AbZip( TAbZipArchive(Sender), TAbZipItem(Item), OutStream );\nend;\n\n\nvar\n ZipFileName : string;\n OutDirectory : string;\n InDirectory : string;\n Mask : string;\n Archive : TAbZipArchive;\n Helper : THelper;\nbegin\n WriteLn;\n {usage: UsingAPI ZipFileName InDirectory Mask OutDirectory}\n if (ParamCount < 4) or\n ((ParamCount > 0) and (Pos('?', ParamStr(1))>0)) then begin\n WriteLn;\n WriteLn( ' Syntax: UsingAPI ZipFileName InDirectory Mask OutDirectory');\n Halt;\n end;\n\n ZipFileName := ParamStr(1);\n InDirectory := ParamStr(2);\n Mask := ParamStr(3);\n OutDirectory := ParamStr(4);\n {open the file}\n if FileExists( ZipFileName ) then begin\n Archive := TAbZipArchive.Create( ZipFileName,\n fmOpenReadWrite or fmShareDenyWrite );\n Archive.Load;\n end\n else\n Archive := TAbZipArchive.Create( ZipFileName,\n fmCreate or fmShareDenyNone );\n try\n Helper := THelper.Create;\n try\n {set the event handlers}\n Archive.InsertHelper := Helper.ZipProc;\n Archive.ExtractHelper := Helper.UnzipProc;\n Archive.OnArchiveItemProgress := Helper.ArchiveItemProgress;\n {set the BaseDirectory for input files}\n Archive.BaseDirectory := InDirectory;\n {add all the files in the BaseDirectory to the archive}\n Archive.AddFiles( Mask, 0 );\n {save the files to the zipfile}\n Archive.Save;\n {now, change the base directory to the output}\n Archive.BaseDirectory := OutDirectory;\n Archive.ExtractFiles( Mask );\n finally\n Helper.Free;\n end;\n finally\n Archive.Free;\n end;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Ustrpad.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: USTRPAD.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit Ustrpad;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, ExtCtrls;\n\ntype\n TForm1 = class(TForm)\n Memo1: TMemo;\n Panel1: TPanel;\n Memo2: TMemo;\n procedure FormCreate(Sender: TObject);\n procedure FormDestroy(Sender: TObject);\n private\n { Private declarations }\n ZnfName : string;\n TxtName : string;\n ZnfStream : TFileStream;\n TxtStream : TStream;\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\nuses\n AbUnzPrc,\n AbZipPrc;\n\n{$R *.DFM}\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n ZnfName := ChangeFileExt(Application.ExeName, '.zst');\n TxtName := ExtractFileName( ChangeFileExt(Application.ExeName, '.pad') );\n ChDir( ExtractFilePath( Application.ExeName ) );\n if FileExists( ZnfName ) then begin\n TxtStream := TMemoryStream.Create;\n try\n ZnfStream := TFileStream.Create( ZnfName,\n fmOpenRead or fmShareExclusive );\n try\n InflateStream( ZnfStream, TxtStream );\n finally\n ZnfStream.Free;\n end;\n TxtStream.Position := 0;\n Memo1.Lines.LoadFromStream( TxtStream );\n finally\n TxtStream.Free;\n end;\n end;\nend;\n\nprocedure TForm1.FormDestroy(Sender: TObject);\nbegin\n TxtStream := TMemoryStream.Create;\n try\n Memo1.Lines.SaveToStream( TxtStream );\n TxtStream.Position := 0;\n if FileExists( ZnfName ) then\n ZnfStream := TFileStream.Create( ZnfName,\n fmOpenWrite or fmShareExclusive )\n else\n ZnfStream := TFileStream.Create( ZnfName,\n fmCreate or fmShareExclusive );\n try\n DeflateStream( TxtStream, ZnfStream );\n finally\n ZnfStream.Free;\n end;\n finally\n TxtStream.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Uunzip.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UUNZIP.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit Uunzip;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,\n\n AbZBrows, AbUnZper, AbArcTyp, AbMeter, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n Button1: TButton;\n OpenDialog1: TOpenDialog;\n AbUnZipper1: TAbUnZipper;\n Memo1: TMemo;\n AbMeter1: TAbMeter;\n AbMeter2: TAbMeter;\n Label1: TLabel;\n Label2: TLabel;\n procedure Button1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n if OpenDialog1.Execute then begin\n with AbUnzipper1 do begin\n FileName := OpenDialog1.FileName;\n BaseDirectory := ExtractFilePath( FileName );\n ExtractFiles( '*.*' );\n end;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Uzip.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UZIP.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit Uzip;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, Gauges, \n\n AbZipper, AbArcTyp, AbZBrows, AbMeter, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n AbZipper1: TAbZipper;\n Button1: TButton;\n OpenDialog1: TOpenDialog;\n Memo1: TMemo;\n AbMeter1: TAbMeter;\n AbMeter2: TAbMeter;\n Label1: TLabel;\n Label2: TLabel;\n procedure Button1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n if OpenDialog1.Execute then\n AbZipper1.AddFiles( OpenDialog1.FileName, 0 );\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ZipReg.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ZIPREG.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram ZipReg;\n\nuses\n Forms,\n ZipReg1 in 'ZipReg1.pas' {ExZipAssociation};\n\nbegin\n Application.CreateForm(TExZipAssociation, ExZipAssociation);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ZipReg.dproj",
"content": "\t\n\t\t\n\t\t\t{623B6B04-BBC3-4044-85BC-8C225B160F0E}\n\t\t\tZipReg.dpr\n\t\t\tTrue\n\t\t\tDebug\n\t\t\tWin32\n\t\t\tApplication\n\t\t\tVCL\n\t\t\tDCC32\n\t\t\t12.3\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\t00400000\n\t\t\tWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tVCLApplication\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tZipReg.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ZipReg.dproj.2007",
"content": "\t\n\t\t\n\t\t\t{623B6B04-BBC3-4044-85BC-8C225B160F0E}\n\t\t\tZipReg.dpr\n\t\t\tTrue\n\t\t\tDebug\n\t\t\tWin32\n\t\t\tApplication\n\t\t\tVCL\n\t\t\tDCC32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tfalse\n\t\t\t00400000\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tVCLApplication\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tZipReg.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ZipReg1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ZIPREG1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ZipReg1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls,\n Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;\n\ntype\n TExZipAssociation = class(TForm)\n CheckZipReg: TButton;\n RegZipExt: TButton;\n Replace: TCheckBox;\n ExitBtn: TButton;\n GroupBox1: TGroupBox;\n Label1: TLabel;\n Label2: TLabel;\n Label3: TLabel;\n Label4: TLabel;\n Icon1: TImage;\n ID1: TEdit;\n FileType1: TEdit;\n App1: TEdit;\n Browse1: TSpeedButton;\n OpenDialog1: TOpenDialog;\n procedure CheckZipRegClick(Sender: TObject);\n procedure RegZipExtClick(Sender: TObject);\n procedure ExitBtnClick(Sender: TObject);\n procedure Browse1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n ExZipAssociation: TExZipAssociation;\n\nimplementation\n\n{$R *.DFM}\n\nuses\n AbZipExt, ShellApi;\n\nvar\n App, ID, FileType : string;\n FN : array[0..255] of char;\n IconIndex : Word;\n\n\nprocedure TExZipAssociation.CheckZipRegClick(Sender: TObject);\nbegin\n App := '';\n ID := '';\n FileType := '';\n if AbGetZipAssociation(App, ID, FileType) then begin\n GroupBox1.Caption := ' ''zip'' is currently registered ';\n StrPCopy(FN, App);\n {$IFNDEF Win32}\n Icon1.Picture.Icon.Handle := ExtractIcon(HInstance, FN, 0);\n {$ELSE}\n Icon1.Picture.Icon.Handle := ExtractAssociatedIcon(HInstance, FN, IconIndex);\n {$ENDIF}\n end else begin\n GroupBox1.Caption := ' ''zip'' is not registered ';\n Icon1.Picture.Icon.Handle := 0;\n end;\n ID1.Text := ID;\n FileType1.Text := FileType;\n App1.Text := App;\nend;\n\nprocedure TExZipAssociation.RegZipExtClick(Sender: TObject);\nbegin\n if (AbExistingZipAssociation and not Replace.Checked) then\n CheckZipRegClick(nil)\n else begin\n App := App1.Text;\n FileType := FileType1.Text;\n ID := ID1.Text;\n if AbRegisterZipExtension(App, ID, FileType, Replace.Checked) then\n CheckZipRegClick(nil)\n else begin\n GroupBox1.Caption := ' Error occurred during registration ';\n Icon1.Picture.Icon.Handle := 0;\n end;\n end;\nend;\n\nprocedure TExZipAssociation.ExitBtnClick(Sender: TObject);\nbegin\n Close;\nend;\n\nprocedure TExZipAssociation.Browse1Click(Sender: TObject);\nbegin\n OpenDialog1.Title := 'Select application to associate with ''zip'' files';\n OpenDialog1.Filename := '*.exe';\n if OpenDialog1.Execute then begin\n App := OpenDialog1.Filename;\n App1.Text := App;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ZipView.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ZIPVIEW.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram ZipView;\n\nuses\n Forms,\n ZipView1 in 'ZipView1.PAS' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ZipView1.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ZIPVIEW1.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ZipView1;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n Grids, StdCtrls, ExtCtrls, Menus, FileCtrl, Gauges, ComCtrls,\n\n AbArcTyp, AbUtils, AbZipper, AbZipKit, AbZipTyp, AbZBrows, AbMeter,\n AbDlgDir, AbView, AbZView, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n OpenDialog1: TOpenDialog;\n Panel1: TPanel;\n FontDialog1: TFontDialog;\n MainMenu1: TMainMenu;\n File1: TMenuItem;\n Open1: TMenuItem;\n Close1: TMenuItem;\n N1: TMenuItem;\n Print1: TMenuItem;\n Exit1: TMenuItem;\n ColorDialog1: TColorDialog;\n ZipView1: TMenuItem;\n Attributes1: TMenuItem;\n Itemname1: TMenuItem;\n Packed1: TMenuItem;\n Method1: TMenuItem;\n Ratio1: TMenuItem;\n CRC1: TMenuItem;\n Fileattributes1: TMenuItem;\n Filetype1: TMenuItem;\n Encryption1: TMenuItem;\n Timestamp1: TMenuItem;\n Filesize1: TMenuItem;\n Versionmade1: TMenuItem;\n Versionneeded1: TMenuItem;\n Path1: TMenuItem;\n Display1: TMenuItem;\n Columnlines1: TMenuItem;\n Columnmoving1: TMenuItem;\n Columnresizing1: TMenuItem;\n MultiSelect1: TMenuItem;\n Rowlines1: TMenuItem;\n Thumbtracking1: TMenuItem;\n Trackactiverow1: TMenuItem;\n Sort1: TMenuItem;\n Itemname2: TMenuItem;\n Packed2: TMenuItem;\n Ratio2: TMenuItem;\n Timestamp2: TMenuItem;\n Filesize2: TMenuItem;\n Select1: TMenuItem;\n SelectAll1: TMenuItem;\n ClearSelections1: TMenuItem;\n Rows1: TMenuItem;\n Rowheight1: TMenuItem;\n Headerheight1: TMenuItem;\n Font1: TMenuItem;\n Alternatecolors1: TMenuItem;\n Action1: TMenuItem;\n Add1: TMenuItem;\n Delete1: TMenuItem;\n Extract1: TMenuItem;\n Freshen1: TMenuItem;\n AbZipView1: TAbZipView;\n AbZipKit1: TAbZipKit;\n ZipKit1: TMenuItem;\n Compress1: TMenuItem;\n N2: TMenuItem;\n Store1: TMenuItem;\n Stored1: TMenuItem;\n Deflated1: TMenuItem;\n Best1: TMenuItem;\n Deflation1: TMenuItem;\n Normal1: TMenuItem;\n Maximum1: TMenuItem;\n Fast1: TMenuItem;\n SuperFast1: TMenuItem;\n CreateDirs1: TMenuItem;\n RestorePath1: TMenuItem;\n StripPath1: TMenuItem;\n RemoveDots1: TMenuItem;\n Recurse1: TMenuItem;\n ShowIcons1: TMenuItem;\n Colors1: TMenuItem;\n Selectedcolor: TMenuItem;\n Selectedtextcolor: TMenuItem;\n AlternateColor1: TMenuItem;\n AlternateTextColor1: TMenuItem;\n Freshen2: TMenuItem;\n Panel2: TPanel;\n AbMeter1: TAbMeter;\n Label1: TLabel;\n Label2: TLabel;\n Moveselecteditem1: TMenuItem;\n Replace1: TMenuItem;\n PopupMenu1: TPopupMenu;\n Delete2: TMenuItem;\n Extract2: TMenuItem;\n Freshen3: TMenuItem;\n Move1: TMenuItem;\n AbMeter2: TAbMeter;\n Save1: TMenuItem;\n Testselecteditems1: TMenuItem;\n Logging1: TMenuItem;\n DeletedColor1: TMenuItem;\n DeletedTextColor1: TMenuItem;\n procedure AbZipView1Click(Sender: TObject);\n procedure AttributeClick(Sender: TObject);\n procedure DisplayOptionClick(Sender: TObject);\n procedure SortAttributeClick(Sender: TObject);\n procedure Open1Click(Sender: TObject);\n procedure Close1Click(Sender: TObject);\n procedure SelectAll1Click(Sender: TObject);\n procedure ClearSelections1Click(Sender: TObject);\n procedure Font1Click(Sender: TObject);\n procedure Exit1Click(Sender: TObject);\n procedure Selected1Click(Sender: TObject);\n procedure Selectedtext1Click(Sender: TObject);\n procedure Rowheight1Click(Sender: TObject);\n procedure Headerheight1Click(Sender: TObject);\n procedure Add1Click(Sender: TObject);\n procedure Delete1Click(Sender: TObject);\n procedure Extract1Click(Sender: TObject);\n procedure ExtractOptionClick(Sender: TObject);\n procedure StoreOptionClick(Sender: TObject);\n procedure MethodClick(Sender: TObject);\n procedure DeflationOptionClick(Sender: TObject);\n procedure AbZipKit1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType;\n var Confirm: Boolean);\n procedure AbZipView1Change(Sender: TObject);\n procedure AlternateColor1Click(Sender: TObject);\n procedure AlternateTextColor1Click(Sender: TObject);\n procedure Freshen1Click(Sender: TObject);\n procedure Moveselecteditem1Click(Sender: TObject);\n procedure AbZipKit1Save(Sender: TObject);\n procedure Save1Click(Sender: TObject);\n procedure Testselecteditems1Click(Sender: TObject);\n procedure Logging1Click(Sender: TObject);\n procedure DeletedColor1Click(Sender: TObject);\n procedure DeletedTextColor1Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nconst\n MainCaption = ' TAbZipView example';\n\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbZipView1Click(Sender: TObject);\nbegin\n Panel1.Caption := AbZipView1.Items[AbZipView1.ActiveRow].Filename;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Open1Click(Sender: TObject);\nbegin\n OpenDialog1.Filename := '*.zip';\n if OpenDialog1.Execute then begin\n AbZipView1.BeginUpdate;\n// AbZipKit1.FileName := '';\n AbZipKit1.Filename := OpenDialog1.Filename;\n Caption := AbZipKit1.Filename +\n ' ' + IntToStr(AbZipView1.Count) + ' items';\n Action1.Enabled := True;\n AbZipView1.EndUpdate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Close1Click(Sender: TObject);\nbegin\n AbZipKit1.Filename := '';\n Caption := MainCaption;\n Panel1.Caption := '';\n Action1.Enabled := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AttributeClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := not Checked;\n if Checked then\n AbZipView1.Attributes := AbZipView1.Attributes + [TAbViewAttribute(Tag)]\n else\n AbZipView1.Attributes := AbZipView1.Attributes - [TAbViewAttribute(Tag)];\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.DisplayOptionClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := not Checked;\n if Checked then\n AbZipView1.DisplayOptions := AbZipView1.DisplayOptions +\n [TAbDisplayOption(Tag)]\n else\n AbZipView1.DisplayOptions := AbZipView1.DisplayOptions -\n [TAbDisplayOption(Tag)]\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SortAttributeClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := not Checked;\n if Checked then\n AbZipView1.SortAttributes := AbZipView1.SortAttributes +\n [TAbSortAttribute(Tag)]\n else\n AbZipView1.SortAttributes := AbZipView1.SortAttributes -\n [TAbSortAttribute(Tag)]\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.StoreOptionClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := not Checked;\n if Checked then\n AbZipKit1.StoreOptions := AbZipKit1.StoreOptions +\n [TAbStoreOption(Tag)]\n else\n AbZipKit1.StoreOptions := AbZipKit1.StoreOptions -\n [TAbStoreOption(Tag)]\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.ExtractOptionClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := not Checked;\n if Checked then\n AbZipKit1.ExtractOptions := AbZipKit1.ExtractOptions +\n [TAbExtractOption(Tag)]\n else\n AbZipKit1.ExtractOptions := AbZipKit1.ExtractOptions -\n [TAbExtractOption(Tag)]\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.MethodClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := true;\n AbZipKit1.CompressionMethodToUse := TAbZipSupportedMethod(Tag);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.DeflationOptionClick(Sender: TObject);\nbegin\n with TMenuItem(Sender) do begin\n Checked := true;\n AbZipKit1.DeflationOption := TAbZipDeflationOption(Tag);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.SelectAll1Click(Sender: TObject);\nbegin\n AbZipView1.SelectAll;\n AbZipView1Click(nil);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.ClearSelections1Click(Sender: TObject);\nbegin\n AbZipView1.ClearSelections;\n AbZipView1Click(nil);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Font1Click(Sender: TObject);\nbegin\n FontDialog1.Font := AbZipView1.Font;\n if FontDialog1.Execute then\n AbZipView1.Font := FontDialog1.Font;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Exit1Click(Sender: TObject);\nbegin\n Close;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.DeletedColor1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbZipView1.Colors.Deleted := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.DeletedTextColor1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbZipView1.Colors.DeletedText := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Selected1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbZipView1.Colors.Selected := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Selectedtext1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbZipView1.Colors.SelectedText := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Rowheight1Click(Sender: TObject);\nvar\n s : string;\nbegin\n s := IntToStr(AbZipView1.DefaultRowHeight);\n if InputQuery(MainCaption, 'Row Height', s) then\n AbZipView1.DefaultRowHeight := StrToIntDef(s, 18);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Headerheight1Click(Sender: TObject);\nvar\n s : string;\nbegin\n s := IntToStr(AbZipView1.HeaderRowHeight);\n if InputQuery(MainCaption, 'Header Height', s) then\n AbZipView1.HeaderRowHeight := StrToIntDef(s, 18);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Add1Click(Sender: TObject);\nvar\n i : Integer;\nbegin\n with OpenDialog1 do begin\n Filename := '*.*';\n Options := Options + [ofAllowMultiSelect];\n AbZipView1.BeginUpdate;\n if Execute then for i := 0 to Pred(Files.Count) do\n AbZipKit1.AddFiles(Files[i], 0);\n AbZipView1.EndUpdate;\n Panel1.Caption := '';\n Options := Options - [ofAllowMultiSelect];\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Delete1Click(Sender: TObject);\nvar\n i : Longint;\nbegin\n Panel1.Caption := '';\n with AbZipView1 do\n for i := 0 to Pred(Count) do\n Items[i].Tagged := Selected[i];\n AbZipKit1.DeleteTaggedItems;\n Panel1.Caption := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Extract1Click(Sender: TObject);\nvar\n i : Longint;\n Continue : Boolean;\nbegin\n{$IFDEF Win32}\n with TAbDirDlg.Create(Self) do begin\n Caption := 'Directory';\n AdditionalText := 'Select folder to extract into';\n SelectedFolder := AbZipKit1.BaseDirectory;\n Continue := Execute;\n if Continue then\n AbZipKit1.BaseDirectory := SelectedFolder;\n{$ELSE}\n with TDirDlg.Create(Self) do begin\n SelectedFolder := AbZipKit1.BaseDirectory;\n Continue := (ShowModal = mrOK);\n if Continue then\n AbZipKit1.BaseDirectory := SelectedFolder;\n{$ENDIF}\n Free;\n end;\n if not Continue then\n Exit;\n Panel1.Caption := '';\n with AbZipView1 do\n for i := 0 to Pred(Count) do\n Items[i].Tagged := Selected[i];\n AbZipKit1.ExtractTaggedItems;\n AbZipView1.ClearSelections;\n Panel1.Caption := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Freshen1Click(Sender: TObject);\nvar\n i : Longint;\nbegin\n Panel1.Caption := '';\n with AbZipView1 do\n for i := 0 to Pred(Count) do\n Items[i].Tagged := Selected[i];\n AbZipKit1.FreshenTaggedItems;\n AbZipKit1.Save;\n AbZipView1.ClearSelections;\n Panel1.Caption := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.TestSelecteditems1Click(Sender: TObject);\nvar\n i : Longint;\nbegin\n Panel1.Caption := '';\n with AbZipView1 do\n for i := 0 to Pred(Count) do\n Items[i].Tagged := Selected[i];\n AbZipKit1.TestTaggedItems;\n AbZipView1.ClearSelections;\n Panel1.Caption := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbZipKit1ConfirmProcessItem(Sender: TObject;\n Item: TAbArchiveItem; ProcessType: TAbProcessType; var Confirm: Boolean);\nvar\n s : string;\nbegin\n case ProcessType of\n ptAdd : s := 'Adding ';\n ptDelete : s := 'Deleting ';\n ptExtract : s := 'Extracting ';\n ptFreshen : s := 'Freshening ';\n else\n s := '??? ';\n end;\n Panel1.Caption := s + Item.Filename;\n Confirm := True;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbZipView1Change(Sender: TObject);\nbegin\n Caption := AbZipKit1.Filename +\n ' ' + IntToStr(AbZipView1.Count) + ' items';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AlternateColor1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbZipView1.Colors.Alternate := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AlternateTextColor1Click(Sender: TObject);\nbegin\n if ColorDialog1.Execute then\n AbZipView1.Colors.AlternateText := ColorDialog1.Color;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Moveselecteditem1Click(Sender: TObject);\nvar\n i : Longint;\n s : string;\nbegin\n with AbZipView1 do\n if (SelCount > 0) then begin\n for i := 0 to Pred(Count) do\n if Selected[i] then begin\n s := Items[i].Filename;\n if InputQuery(MainCaption, 'Rename file', s) then\n AbZipKit1.Move(Items[i], s);\n end;\n AbZipKit1.Save;\n AbZipView1.ClearSelections;\n Panel1.Caption := '';\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.AbZipKit1Save(Sender: TObject);\nbegin\n Panel1.Caption := 'Saving ' + AbZipKit1.Filename;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Save1Click(Sender: TObject);\nbegin\n if (AbZipKit1.Filename <> '') then\n AbZipKit1.Save;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TForm1.Logging1Click(Sender: TObject);\nbegin\n Logging1.Checked := not Logging1.Checked;\n if Logging1.Checked then begin\n OpenDialog1.Title := 'Select log file';\n if AbZipKit1.LogFile = '' then\n OpenDialog1.Filename := '*.txt'\n else\n OpenDialog1.Filename := AbZipKit1.LogFile;\n Logging1.Checked := OpenDialog1.Execute;\n if Logging1.Checked then\n AbZipKit1.LogFile := OpenDialog1.Filename;\n end;\n AbZipKit1.Logging := Logging1.Checked;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Zipper.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ZIPPER.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram zipper;\n\nuses\n Forms,\n Uzip in 'Uzip.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Zipper.dproj",
"content": "\t\n\t\t\n\t\t\t{3B87EA3D-333F-41D2-A7EE-A559DF4E7347}\n\t\t\tZipper.dpr\n\t\t\tTrue\n\t\t\tDebug\n\t\t\tWin32\n\t\t\tApplication\n\t\t\tVCL\n\t\t\tDCC32\n\t\t\t12.3\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\t00400000\n\t\t\tWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tVCLApplication\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tZipper.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/examples/Delphi/Zipper.dproj.2007",
"content": "\t\n\t\t\n\t\t\t{3B87EA3D-333F-41D2-A7EE-A559DF4E7347}\n\t\t\tZipper.dpr\n\t\t\tTrue\n\t\t\tDebug\n\t\t\tWin32\n\t\t\tApplication\n\t\t\tVCL\n\t\t\tDCC32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tfalse\n\t\t\t00400000\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tVCLApplication\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tZipper.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/examples/Delphi/dgAbout.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: DGABOUT.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit dgAbout;\n\ninterface\n\nuses\n Windows, Classes, Graphics, Forms, Controls, StdCtrls,\n Buttons, ExtCtrls;\n\ntype\n TdlgAboutBox = class(TForm)\n Panel1: TPanel;\n ProgramIcon: TImage;\n Label7: TLabel;\n Label8: TLabel;\n Panel2: TPanel;\n lnTitleShadow: TLabel;\n lblTitle: TLabel;\n Label5: TLabel;\n OKButton: TButton;\n Version: TLabel;\n Label1: TLabel;\n Label2: TLabel;\n Label3: TLabel;\n Label4: TLabel;\n Label6: TLabel;\n procedure FormCreate(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n dlgAboutBox: TdlgAboutBox;\n\nimplementation\n\n{$R *.DFM}\n\nuses\n AbConst;\n\nprocedure TdlgAboutBox.FormCreate(Sender: TObject);\nbegin\n Version.Caption := 'Abbrevia ' + AbVersionS;\nend;\n\n\n\n\n\nend.\n\n"
},
{
"path": "lib/abbrevia/examples/Delphi/makesfx.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: MAKESFX.DPR *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nprogram makesfx;\n\nuses\n Forms,\n umakesfx in 'umakesfx.pas' {Form1};\n\nbegin\n Application.CreateForm(TForm1, Form1);\n Application.Run;\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/spntst0.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit spntst0;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,\n\n {IpStrms,}\n {StStrms,}\n\n AbBufStm, AbBase, AbBrowse, AbZBrows, AbZipper, AbZipKit,\n AbSpanSt, ExtCtrls;\n\ntype\n TForm1 = class(TForm)\n AbZipKit1: TAbZipKit;\n Button1: TButton;\n OpenDialog1: TOpenDialog;\n Button3: TButton;\n Bevel1: TBevel;\n SaveDialog1: TSaveDialog;\n procedure Button1Click(Sender: TObject);\n procedure Button3Click(Sender: TObject);\n procedure DoRequestImage(Sender: TObject; ImageNumber: Integer;\n var ImageName: String; var Abort: Boolean);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.Button1Click(Sender: TObject);\nvar\n Span: TAbSpanStream;\n SrcFile : TFileStream;\n Src, Dest : string;\nbegin\n OpenDialog1.FileName := '*.*';\n OpenDialog1.Title := 'Select Source File';\n if OpenDialog1.Execute then begin\n Src := OpenDialog1.FileName;\n\n OpenDialog1.Title := 'Specify Destination File';\n if OpenDialog1.Execute then begin\n Dest := OpenDialog1.FileName;\n Span := TAbSpanStream.Create(Dest, fmCreate);\n SrcFile := TFileStream.Create(Src, fmOpenRead);\n\n Span.CopyFrom(SrcFile, SrcFile.Size);\n\n Span.Free;\n SrcFile.Free;\n\n end;\n end;\nend;\n\nprocedure TForm1.Button3Click(Sender: TObject);\nvar\n Span: TAbSpanStream;\n DestFile : TFileStream;\n Src, Dest : string;\nbegin\n OpenDialog1.FileName := '*.*';\n OpenDialog1.Title := 'Select Source File';\n if OpenDialog1.Execute then begin\n Src := OpenDialog1.FileName;\n\n SaveDialog1.Title := 'Specify Destination File';\n if SaveDialog1.Execute then begin\n Dest := SaveDialog1.FileName;\n Span := TAbSpanStream.Create(Src, fmOpenRead);\n Span.SpanType := stLocal;\n\n Span.OnRequestImage := DoRequestImage;\n DestFile := TFileStream.Create(Dest, fmCreate);\n\n DestFile.CopyFrom(Span, 3145728{Span.Size});\n\n Span.Free;\n DestFile.Free;\n end;\n end;\nend;\n\nprocedure TForm1.DoRequestImage(Sender: TObject;\n ImageNumber: Integer; var ImageName: String; var Abort: Boolean);\nbegin\n Abort := not OpenDialog1.Execute;\n if not Abort then\n ImageName := OpenDialog1.FileName;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/uCfGenDg.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit uCfGenDg;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls;\n\ntype\n TfrmCfGenDlg = class(TForm)\n Label1: TLabel;\n Edit1: TEdit;\n btnCancel: TButton;\n btnOK: TButton;\n procedure btnOKClick(Sender: TObject);\n procedure FormShow(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n frmCfGenDlg: TfrmCfGenDlg;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TfrmCfGenDlg.btnOKClick(Sender: TObject);\nbegin\n if Edit1.Text <> '' then\n ModalResult := mrOK;\nend;\n\nprocedure TfrmCfGenDlg.FormShow(Sender: TObject);\nbegin\n Edit1.Text := '';\n Edit1.SetFocus;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/uCfMain.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UCFMAIN.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit uCfMain;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n ExtCtrls, Menus, ImgList, ComCtrls,\n\n AbHexVw, AbCompnd;\n\ntype\n TfmCfMain = class(TForm)\n StatusBar1: TStatusBar;\n tvDirectory: TTreeView;\n tvImages: TImageList;\n OpenDialog1: TOpenDialog;\n mnuMain: TMainMenu;\n mnuFile: TMenuItem;\n mnuFileNew: TMenuItem;\n mnuFileOpen: TMenuItem;\n N6: TMenuItem;\n mnuFileExit: TMenuItem;\n mnuEdit: TMenuItem;\n mnuEditAddFile: TMenuItem;\n mnuEditAddFolder: TMenuItem;\n mnuEditDelete: TMenuItem;\n N1: TMenuItem;\n mnuEditChangeDir: TMenuItem;\n mnuPopupMenu: TPopupMenu;\n puAddFile: TMenuItem;\n puAddFolder: TMenuItem;\n puViewFile: TMenuItem;\n puChangeDir: TMenuItem;\n puViewCompoundFile: TMenuItem;\n puDelete: TMenuItem;\n Rename1: TMenuItem;\n SaveDialog1: TSaveDialog;\n OpenDialog2: TOpenDialog;\n pnlHexView: TPanel;\n procedure mnuFileNewClick(Sender: TObject);\n procedure mnuFileOpenClick(Sender: TObject);\n procedure mnuFileExitClick(Sender: TObject);\n procedure mnuEditAddFileClick(Sender: TObject);\n procedure mnuEditAddFolderClick(Sender: TObject);\n procedure mnuEditDeleteClick(Sender: TObject);\n procedure mnuEditChangeDirClick(Sender: TObject);\n procedure puViewFileClick(Sender: TObject);\n procedure puViewCompoundFileClick(Sender: TObject);\n procedure Rename1Click(Sender: TObject);\n procedure tvDirectoryClick(Sender: TObject);\n procedure FormDestroy(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n fmCfMain: TfmCfMain;\n AbCompoundFile1 : TAbCompoundFile;\n HexV : THexView;\n\nimplementation\n\nuses uCfNewDg, uCfGenDg;\n\n{$R *.DFM}\n\nprocedure TfmCfMain.mnuFileNewClick(Sender: TObject);\nvar\n AllocSize : Integer;\nbegin\n if SaveDialog1.Execute then begin\n if frmCfNewDlg.ShowModal = mrOK then begin\n if AbCompoundFile1 <> nil then\n AbCompoundFile1.Free;\n AllocSize := StrToInt(frmCfNewDlg.lbAllocSize.\n Items[frmCfNewDlg.lbAllocSize.ItemIndex]);\n AbCompoundFile1 := TAbCompoundFile.Create(SaveDialog1.FileName,\n frmCfNewDlg.edtVolLbl.Text, AllocSize);\n Caption := 'Abbrevia 3 Compound File Example (' + SaveDialog1.FileName + ')';\n HexV := THexView.Create(Self);\n HexV.BlockSize := AllocSize;\n HexV.Parent := pnlHexView;\n HexV.Align := alClient;\n HexV.Stream := AbCompoundFile1.Stream;\n AbCompoundFile1.PopulateTreeView(tvDirectory);\n end;\n end;\nend;\n\nprocedure TfmCfMain.mnuFileOpenClick(Sender: TObject);\nbegin\n {OpenExisting compound file}\n if OpenDialog1.Execute then begin\n if AbCompoundFile1 <> nil then\n AbCompoundFile1.Free;\n AbCompoundFile1 := TAbCompoundFile.Create('', '', 512);\n AbCompoundFile1.Open(OpenDialog1.FileName);\n Caption := 'Abbrevia 3 Compound File Example (' + OpenDialog1.FileName + ')';\n HexV := THexView.Create(Self);\n HexV.BlockSize := AbCompoundFile1.AllocationSize;\n HexV.Parent := pnlHexView;\n HexV.Align := alClient;\n HexV.Stream := AbCompoundFile1.Stream;\n AbCompoundFile1.PopulateTreeView(tvDirectory);\n end;\nend;\n\nprocedure TfmCfMain.mnuFileExitClick(Sender: TObject);\nbegin\n Application.Terminate;\nend;\n\nprocedure TfmCfMain.mnuEditAddFileClick(Sender: TObject);\nvar\n i : Integer;\n Strm : TFileStream;\nbegin\n if OpenDialog2.Execute then begin\n Strm := TFileStream.Create(OpenDialog2.FileName, fmOpenRead\n or fmShareDenyNone);\n AbCompoundFile1.AddFile(OpenDialog2.FileName, Strm, Strm.Size);\n Strm.Free;\n AbCompoundFile1.PopulateTreeView(tvDirectory);\n for i := 0 to tvDirectory.Items.Count - 1 do\n tvDirectory.Items.Item[i].Expand(True);\n HexV.Stream := AbCompoundFile1.Stream;\n end;\nend;\n\nprocedure TfmCfMain.mnuEditAddFolderClick(Sender: TObject);\nvar\n i : Integer;\nbegin\n if frmCfGenDlg.ShowModal = mrOK then begin\n AbCompoundFile1.AddFolder(frmCfGenDlg.Edit1.Text);\n AbCompoundFile1.PopulateTreeView(tvDirectory);\n for i := 0 to tvDirectory.Items.Count - 1 do\n tvDirectory.Items.Item[i].Expand(True);\n end;\n HexV.Stream := AbCompoundFile1.Stream;\nend;\n\nprocedure TfmCfMain.mnuEditDeleteClick(Sender: TObject);\nvar\n i : Integer;\nbegin\n if tvDirectory.Selected.ImageIndex = 0 then\n AbCompoundFile1.DeleteFolder(tvDirectory.Selected.Text)\n else\n AbCompoundFile1.DeleteFile(tvDirectory.Selected.Text);\n HexV.Stream := AbCompoundFile1.Stream;\n AbCompoundFile1.PopulateTreeView(tvDirectory);\n\n for i := 0 to tvDirectory.Items.Count - 1 do\n tvDirectory.Items.Item[i].Expand(True);\nend;\n\nprocedure TfmCfMain.mnuEditChangeDirClick(Sender: TObject);\nbegin\n frmCfGenDlg.Caption := AbCompoundFile1.CurrentDirectory;\n if frmCfGenDlg.ShowModal = mrOK then begin\n AbCompoundFile1.CurrentDirectory := frmCfGenDlg.Edit1.Text;\n StatusBar1.SimpleText := ' Current Directory: ' + AbCompoundFile1.CurrentDirectory;\n end;\nend;\n\nprocedure TfmCfMain.puViewFileClick(Sender: TObject);\nvar\n Strm : TStream;\nbegin\n Strm := TMemoryStream.Create;\n AbCompoundFile1.OpenFile(tvDirectory.Selected.Text, Strm);\n Hexv.SetStream(Strm);\n Strm.Free;\nend;\n\nprocedure TfmCfMain.puViewCompoundFileClick(Sender: TObject);\nbegin\n HexV.Stream := AbCompoundFile1.Stream;\nend;\n\nprocedure TfmCfMain.Rename1Click(Sender: TObject);\nbegin\n frmCfGenDlg.Caption := 'Rename';\n frmCfGenDlg.Label1.Caption := 'New Name';\n if frmCfGenDlg.ShowModal = mrOK then begin\n if tvDirectory.Selected.ImageIndex = 0 then\n AbCompoundFile1.RenameFolder(tvDirectory.Selected.Text, frmCfGenDlg.Edit1.Text)\n else\n AbCompoundFile1.RenameFile(tvDirectory.Selected.Text, frmCfGenDlg.Edit1.Text);\n end;\n frmCfGenDlg.Caption := 'Change Directory';\n frmCfGenDlg.Label1.Caption := 'New Directory';\nend;\n\nprocedure TfmCfMain.tvDirectoryClick(Sender: TObject);\nbegin\n if not Assigned(tvDirectory.Selected) then\n tvDirectory.Selected := tvDirectory.TopItem;\n if (tvDirectory.Selected.ImageIndex = 0) then begin\n AbCompoundFile1.CurrentDirectory := tvDirectory.Selected.Text;\n StatusBar1.SimpleText := ' Current Directory: ' + AbCompoundFile1.CurrentDirectory;\n end; \nend;\n\nprocedure TfmCfMain.FormDestroy(Sender: TObject);\nbegin\n if AbCompoundFile1 <> nil then\n AbCompoundFile1.Free;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/uCfNewDg.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit uCfNewDg;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls;\n\ntype\n TfrmCfNewDlg = class(TForm)\n Label1: TLabel;\n edtVolLbl: TEdit;\n Label2: TLabel;\n lbAllocSize: TListBox;\n btnCancel: TButton;\n btnOK: TButton;\n procedure FormShow(Sender: TObject);\n procedure btnOKClick(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n frmCfNewDlg: TfrmCfNewDlg;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TfrmCfNewDlg.FormShow(Sender: TObject);\nbegin\n lbAllocSize.ItemIndex := 2;\n edtVolLbl.SetFocus; \nend;\n\nprocedure TfrmCfNewDlg.btnOKClick(Sender: TObject);\nbegin\n if edtVolLbl.Text = '' then begin\n ShowMessage('Volume label required');\n edtVolLbl.SetFocus;\n end else\n ModalResult := mrOK;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ubasedlg.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UBASEDLG.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ubasedlg;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, FileCtrl;\n\ntype\n TBaseDirDlg = class(TForm)\n Button1: TButton;\n Button2: TButton;\n Edit1: TEdit;\n DriveComboBox1: TDriveComboBox;\n DLB: TDirectoryListBox;\n DirLabel: TLabel;\n ActionLabel: TLabel;\n CheckBox2: TCheckBox;\n CheckBox1: TCheckBox;\n Button3: TButton;\n procedure Button3Click(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n BaseDirDlg: TBaseDirDlg;\n\nimplementation\n\n{$R *.DFM}\n\nuses\n AbUtils,\n uDemoDlg;\n\nprocedure TBaseDirDlg.Button3Click(Sender: TObject);\nbegin\n DemoDlg := TDemoDlg.Create( Self );\n try\n DemoDlg.Caption := 'Create Subdirectory';\n DemoDlg.Edit1.Text := '';\n DemoDlg.ShowModal;\n if ( DemoDlg.ModalResult = mrOK ) and ( DemoDlg.Edit1.Text <> '' ) then\n AbCreateDirectory( DLB.Directory + '\\' + DemoDlg.Edit1.Text );\n DLB.Update;\n finally\n DemoDlg.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ucomppad.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UCOMPPAD.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ucomppad;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, Menus, ExtCtrls,\n\n AbZBrows, AbZipper, AbZipKit, AbArcTyp, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n Memo1: TMemo;\n AbZipKit1: TAbZipKit;\n Panel1: TPanel;\n Memo2: TMemo;\n procedure FormCreate(Sender: TObject);\n procedure FormDestroy(Sender: TObject);\n private\n { Private declarations }\n ZnfName : string;\n TxtName : string;\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.FormCreate(Sender: TObject);\nbegin\n ZnfName := ChangeFileExt(Application.ExeName, '.zip');\n TxtName := ExtractFileName( ChangeFileExt(Application.ExeName, '.txt') );\n with AbZipKit1 do begin\n BaseDirectory := ExtractFilePath( Application.ExeName );\n ChDir( BaseDirectory );\n FileName := ZnfName;\n if Count > 0 then begin\n ExtractFiles( TxtName );\n Memo1.Lines.LoadFromFile( TxtName );\n end;\n end;\nend;\n\nprocedure TForm1.FormDestroy(Sender: TObject);\nbegin\n Memo1.Lines.SaveToFile( TxtName );\n with AbZipKit1 do begin\n if Count = 0 then\n AddFiles( TxtName, 0 )\n else\n FreshenFiles( TxtName );\n Save;\n end;\n DeleteFile( TxtName );\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/udemodlg.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UDEMODLG.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit udemodlg;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls;\n\ntype\n TDemoDlg = class(TForm)\n Button1: TButton;\n Button2: TButton;\n Edit1: TEdit;\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n DemoDlg: TDemoDlg;\n\nimplementation\n\n{$R *.DFM}\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/ufinder.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UFINDER.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit ufinder;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n StdCtrls, FileCtrl, Buttons, ExtCtrls,\n\n AbZBrows, AbArcTyp, AbBrowse, AbBase;\n\ntype\n TForm1 = class(TForm)\n Edit1: TEdit;\n Label1: TLabel;\n Memo1: TMemo;\n DriveComboBox1: TDriveComboBox;\n DirectoryListBox1: TDirectoryListBox;\n AbZipBrowser1: TAbZipBrowser;\n Memo2: TMemo;\n Label2: TLabel;\n Button1: TButton;\n Button2: TButton;\n FileListBox1: TFileListBox;\n procedure FormClose(Sender: TObject; var Action: TCloseAction);\n procedure Edit1Change(Sender: TObject);\n procedure Button1Click(Sender: TObject);\n procedure Button2Click(Sender: TObject);\n private\n { Private declarations }\n Aborted: Boolean;\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);\nbegin\n Aborted := True;\nend;\n\nprocedure TForm1.Edit1Change(Sender: TObject);\nbegin\n Button1.Enabled := Length( Edit1.Text ) > 0;\nend;\n\nprocedure TForm1.Button1Click(Sender: TObject);\nvar\n i, j : Integer;\n CurFile : string;\nbegin\n Button1.Enabled := False;\n Memo1.Clear;\n try\n Button2.Enabled := True;\n Aborted := False;\n {look in the file list box for the file}\n for i := 0 to pred( FileListBox1.Items.Count ) do begin\n Application.ProcessMessages;\n if Aborted then\n Break;\n {now add search of zip and self extracting files}\n try\n AbZipBrowser1.FileName := FileListBox1.Directory + '\\' + FileListBox1.Items[i];\n for j := 0 to AbZipBrowser1.Count - 1 do\n if AbZipBrowser1[j].MatchesStoredName(Edit1.Text) then begin\n Memo1.Lines.Add( 'Found in ' + FileListBox1.Items[i] );\n Break;\n end;\n except\n end;\n end;\n finally\n Memo1.Lines.Add( 'Done!' );\n Edit1.Enabled := True;\n Button1.Enabled := True;\n Button2.Enabled := False;\n end;\nend;\n\nprocedure TForm1.Button2Click(Sender: TObject);\nbegin\n Aborted := True;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/umakesfx.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: UMAKESFX.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit umakesfx;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,\n\n AbArcTyp, AbSelfEx, AbBase;\n\ntype\n TForm1 = class(TForm)\n Memo1: TMemo;\n Button1: TButton;\n AbMakeSelfExe1: TAbMakeSelfExe;\n OpenDialog1: TOpenDialog;\n procedure Button1Click(Sender: TObject);\n procedure AbMakeSelfExe1GetStubExe(Sender: TObject;\n var aFilename: string; var Abort: Boolean);\n procedure AbMakeSelfExe1GetZipFile(Sender: TObject;\n var aFilename: string; var Abort: Boolean);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Form1: TForm1;\n\nimplementation\n\n{$R *.DFM}\nuses\n AbZipTyp;\n\nprocedure TForm1.Button1Click(Sender: TObject);\nbegin\n if AbMakeSelfExe1.Execute then\n ShowMessage(AbMakeSelfExe1.SelfExe + ' has been created');\nend;\n\nprocedure TForm1.AbMakeSelfExe1GetStubExe(Sender: TObject;\n var aFilename: string; var Abort: Boolean);\nbegin\n OpenDialog1.Title := 'Select executable stub';\n OpenDialog1.Filename := '';\n OpenDialog1.Filter := 'Exe files|*.exe';\n Abort := not OpenDialog1.Execute;\n if not Abort then\n aFileName := OpenDialog1.Filename;\nend;\n\nprocedure TForm1.AbMakeSelfExe1GetZipFile(Sender: TObject;\n var aFilename: string; var Abort: Boolean);\nbegin\n OpenDialog1.Title := 'Select Zip File';\n OpenDialog1.Filename := '';\n OpenDialog1.Filter := 'Zip files|*.zip';\n Abort := not OpenDialog1.Execute;\n if not Abort then\n aFileName := OpenDialog1.Filename;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/examples/Delphi/usplash.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: USPLASH.PAS *}\n{* Copyright (c) TurboPower Software Co 1997 *}\n{* All rights reserved. *}\n{*********************************************************}\n{* ABBREVIA Example program file *}\n{*********************************************************}\n\nunit usplash;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\n ExtCtrls;\n\ntype\n TSplash = class(TForm)\n Image1: TImage;\n Timer1: TTimer;\n procedure Timer1Timer(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n Splash: TSplash;\n\nimplementation\n\n{$R *.DFM}\n\nprocedure TSplash.Timer1Timer(Sender: TObject);\nbegin\n Close;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/localization/AbResString.pas.afr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Henri Hakl, Roman Kassebaum\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas *}\n{*********************************************************}\n{* Abbrevia: Resource strings, Africaans localization *}\n{*********************************************************}\nunit AbResString;\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Ongeldig - geen PKZIP bestaan nie';\n AbZipVersionNeededS = 'Ler kannie ontpak word nie - kry nuwer weergawe van PKZIP';\n AbUnknownCompressionMethodS = 'Ler kannie ontpak word nie - onbekende kompressiemetode'; \n AbNoExtractionMethodS = 'Ler kannie ontpak word nie - geen ondersteunende metode'; \n AbInvalidPasswordS = 'Ler kannie ontpak word nie - ongeldige paswoord'; \n AbNoInsertionMethodS = 'Ler kannie bygevoeg word nie - byvoeging is nie ondersteun nie'; \n AbInvalidFactorS = 'Ongeldige reduksiefaktoor'; \n AbDuplicateNameS = 'Ler kannie bygevoeg word nie - tweevoud by name gevind'; \n AbUnsupportedCompressionMethodS = 'Ler kannie bygevoeg word nie - nie ondersteunde kompressiemetode'; \n AbUserAbortS = 'Proses is deur gebruiker onderbreek';\n AbArchiveBusyS = 'Argief is besig - kan nuwe aanvrag nie bewerk nie'; \n AbLastDiskRequestS = 'Benodig laaste skyf van gedeelde argief'; \n AbDiskRequestS = 'Benodig skyf'; \n AbImageRequestS = 'Benodig naam';\n AbBadSpanStreamS = 'Gedeelde argief moet als bestandsstroom geopen word'; \n AbDiskNumRequestS = 'Benodig skyf %d van gedeelde argief'; \n AbImageNumRequestS = 'Benodig segment %d van gedeelde argief';\n AbNoOverwriteSpanStreamS = 'Kannie bestaande gedeelde argief verander nie'; \n AbNoSpannedSelfExtractS = 'Kannie selfontpakkende gedeelde argief maak nie'; \n AbBlankDiskS = 'Benodig le skyf'; \n AbStreamFullS = 'Stroom skryffout'; \n AbNoSuchDirectoryS = 'Gids bestaan nie'; \n AbInflateBlockErrorS = 'Kannie blok ontpak nie'; \n AbBadStreamTypeS = 'Ongeldige stroom';\n AbTruncateErrorS = 'Daar bestaan in afknottings fout in zip-ler'; \n AbZipBadCRCS = 'CRC kontroole his misluk'; \n AbZipBadStubS = 'Stomp moet uitvoerbaar wees'; \n AbFileNotFoundS = 'Ler nie gevind nie'; \n AbInvalidLFHS = 'Ongeldige lokaale ler obskrif element';\n AbNoArchiveS = 'Argief bestaan nie'; \n AbReadErrorS = 'Leesfout in argief'; \n AbInvalidIndexS = 'Ongeldige indeks van argiefelement'; \n AbInvalidThresholdS = 'Ongeldige drempel van argiefgroote';\n AbUnhandledFileTypeS = 'Onbekende argieftype'; \n AbSpanningNotSupportedS = 'Argief deeling is nie ondersteun nie'; \n AbLogCreateErrorS = 'Fout gedurende protokol skepping'; \n AbMoveFileErrorS = 'Fout gedurende verplasing van ler van %s na %s'; \n AbFileSizeTooBigS = 'Ler is te groot vir argieftype'; \n\n AbNoCabinetDllErrorS = 'Kannie ler cabinet.dll laai nie'; \n AbFCIFileOpenErrorS = 'FCI kannie ler oopmaak nie'; \n AbFCIFileReadErrorS = 'FCI kannie ler lees nie'; \n AbFCIFileWriteErrorS = 'FCI kannie ler skryf nie'; \n AbFCIFileCloseErrorS = 'FCI kannie ler toemaak nie'; \n AbFCIFileSeekErrorS = 'FCI kannie posisie verander nie'; \n AbFCIFileDeleteErrorS = 'FCI kannie ler verwyder nie'; \n AbFCIAddFileErrorS = 'FCI kannie ler byvoeg nie'; \n AbFCICreateErrorS = 'FCI kannie conteks skep nie'; \n AbFCIFlushCabinetErrorS = 'FCI kannie kabinet spoel nie'; \n AbFCIFlushFolderErrorS = 'FCI kannie gids spoel nie'; \n AbFDICopyErrorS = 'FDI kannie ler opsom nie'; \n AbFDICreateErrorS = 'FDI kannie konteks skep nie'; \n AbInvalidCabTemplateS = 'Ongeldige kabinet sjabloon'; \n AbInvalidCabFileS = 'Ongeldiger ler - geen kabinet bestaan nie'; \n\n AbZipStored = 'Opgeslagen';\n AbZipShrunk = 'Gekrimp'; \n AbZipReduced = 'Verminder'; \n AbZipImploded = 'Gemplodeerd';\n AbZipTokenized = 'In simboole gepak'; \n AbZipDeflated = 'Gedeflationeerd';\n AbZipDeflate64 = 'Uitgebreid gedeflationeerd';\n AbZipDCLImploded = 'DCL gemplodeerd';\n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Onbekend (%d)';\n AbZipBestMethod = 'Beste metode'; \n\n AbVersionFormatS = 'Weergawe'; \n AbCompressedSizeFormatS = 'Gekomprimeerde groote: %d'; \n AbUncompressedSizeFormatS = 'Ongekomprimeerde groote: %d'; \n AbCompressionMethodFormatS = 'Kompressie metode: %s'; \n AbCompressionRatioFormatS = 'Kompressieverhouding: %2.0f%%'; \n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'Eksterne lerattribute: %s';\n AbIFAFormatS = 'Lertype'; \n AbTextS = 'Teks'; \n AbBinaryS = 'Binre'; \n AbEncryptionFormatS = 'Versleuteling: %s';\n AbEncryptedS = 'Versleuteld';\n AbNotEncryptedS = 'Nie versleuteld nie'; \n AbUnknownS = 'Onbekend';\n AbTimeStampFormatS = 'Tydstempel: %s'; \n AbMadeByFormatS = 'Gemaak met weergawe: %f'; \n AbNeededFormatS = 'Weergawe benodig vir ontpakking: %f'; \n AbCommentFormatS = 'Opmerking: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'PKZIP argief (*.zip)|*.zip|Selfontpakkende Argief (*.exe)|*.exe|Alle Lers (*.*)|*.*'; \n AbFileNameTitleS = 'Kies lernaam';\n\n AbOKS = 'OK';\n AbCancelS = 'Verlaat'; \n AbSelectDirectoryS = 'Kies ler'; \n\n AbEnterPasswordS = 'Voeg paswoord in'; \n AbPasswordS = '&Paswoord';\n AbVerifyS = '&Verifiseer'; \n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Kabinetsargiewe (*.cab)|*.CAB|Alle Lers (*.*)|*.*'; \n AbLogExtS = '*.txt';\n AbLogFilterS = 'Tekslers (*.cab)|*.CAB|Alle Lers (*.*)|*.*'; \n AbExeExtS = '*.exe';\n AbExeFilterS = 'Selfontpakkende Zip Lers (*.cab)|*.CAB|Alle Lers (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = 'VMS: Te veel byte gelees';\n AbVMSInvalidOriginS = 'VMS: Ongeldige oorsprong %d, moet 0, 1 or 2 wees';\n AbVMSErrorOpenSwapS = 'VMS: Kannie wisseller oopmaak nie'; \n AbVMSSeekFailS = 'VMS: Kannie wisseller posisie verander nie'; \n AbVMSReadFailS = 'VMS: Kan %d byte in wisseller nie lees nie'; \n AbVMSWriteFailS = 'VMS: Kan %d byte in wisseller nie skryf nie'; \n AbVMSWriteTooManyBytesS = 'VMS: Aanvraag om te veel byte [%d] te skryf'; \n\n AbBBSReadTooManyBytesS = 'BBS: Aanvraag om te veel byte [%d] te lees'; \n AbBBSSeekOutsideBufferS = 'BBS: Nuwe posisie is buite die buffer'; \n AbBBSInvalidOriginS = 'BBS: Ongeldige oorsprongswaarde'; \n AbBBSWriteTooManyBytesS = 'BBS: Aanvrag om te veel byte [%d] te skryf'; \n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Nie by stroom einde nie'; \n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Posisioneering misluk'; \n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteCunk: Skryf misluk'; \n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Ongeldige oorsprong'; \n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Ongeldige nuwe posisie'; \n\n AbItemNameHeadingS = 'Naam';\n AbPackedHeadingS = 'Gepak'; \n AbMethodHeadingS = 'Metode';\n AbRatioHeadingS ='Besparing (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Attribuut';\n AbFileFormatHeadingS = 'Formaat';\n AbEncryptionHeadingS = 'Versleuteld';\n AbTimeStampHeadingS = 'Tydstempel';\n AbFileSizeHeadingS = 'Groote'; \n AbVersionMadeHeadingS = 'Gebruikte weergawe'; \n AbVersionNeededHeadingS = 'Benodigde weergawe'; \n AbPathHeadingS = 'Pad';\n AbPartialHeadingS = 'Partieel';\n AbExecutableHeadingS = 'Uitvoerbaar';\n\n AbCabMethod0S = 'Geen';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' toegevoegd ';\n AbLtDeleteS = ' gewist ';\n AbLtExtractS = ' ontpakt ';\n AbLtFreshenS = ' geaktualiseerd '; \n AbLtMoveS = ' verplaas '; \n AbLtReplaceS = ' vervang '; \n AbLtStartS = ' geprotocoleerd ';\n\n AbGzipInvalidS = 'Ongeldige Gzip';\n AbGzipBadCRCS = 'Ongeldige CRC';\n AbGzipBadFileSizeS = 'Ongeldige bestaandsgroote'; \n\n AbTarInvalidS = 'Tar ongeldig';\n AbTarBadFileNameS = 'Ler naam te lang';\n AbTarBadLinkNameS = 'Skakel naam te lang';\n AbTarBadOpS = 'Operasie nie ondersteun nie';\n \n AbUnhandledEntityS = 'Nie behandelde entiteit'; \n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'FAT Lersisteem (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (of OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'HPFS Lersisteem (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'NTFS Lersisteem (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISCOS';\n AbGzOsVFAT = 'VFAT Lersisteem (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox of PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'onbekend';\n AbGzOsUndefined = 'ID is Gzip nie bekend nie';\n\n{!!.03 - Moved from AbCompnd.inc }\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Indeks buite toegelate bereik'; \n AbCmpndBusyUpdating = 'Saamgestelde ler word geaktualiseer'; \n AbCmpndInvalidFile = 'Ongeldige saamgestelde ler'; \n AbCmpndFileNotFound = 'Ler/gids nie gevind nie'; \n AbCmpndFolderNotEmpty = 'Gids nie leeg nie'; \n AbCmpndExceedsMaxFileSize = 'Lergroote oorskryf toegelate maksimum'; \n{!!.03 - End Moved }\n\n\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/localization/AbResString.pas.de",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Roman Kassebaum\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas *}\n{*********************************************************}\n{* Abbrevia: Resource strings, German localization *}\n{*********************************************************}\nunit AbResString;\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Ungltige Datei - keine PKZip Datei';\n AbZipVersionNeededS = 'Kann die Datei nicht entpacken - neuere Version bentigt';\n AbUnknownCompressionMethodS = 'Kann die Datei nicht entpacken - nicht untersttzte Kommpressionsmethode';\n AbNoExtractionMethodS = 'Kann die Datei nicht entpacken - keine Entpackuntersttzung angeboten';\n AbInvalidPasswordS = 'Kann die Datei nicht entpacken - ungltiges Passwort';\n AbNoInsertionMethodS = 'Kann die Datei nicht entpacken - keine Einfgeuntersttzung angeboten';\n AbInvalidFactorS = 'Ungltiger Reduzierungsfaktor';\n AbDuplicateNameS = 'Kann die Datei nicht einfgen - doppelter gespeicherter Name';\n AbUnsupportedCompressionMethodS = 'Kann die Datei nicht einfgen - nicht untersttzt Kompressionsmethode';\n AbUserAbortS = 'Prozess wurde durch den Benutzer abgebrochen';\n AbArchiveBusyS = 'Das Archiv ist beschftigt - kann nicht die neue Anforderung bearbeiten';\n AbLastDiskRequestS = 'Legen Sie die letzte Diskette ein';\n AbDiskRequestS = 'Diskette einlegen ';\n AbImageRequestS = 'Name des Abbildes';\n AbBadSpanStreamS = 'Segmentierte Archive mssen als Datei-Strom geffnet werden';\n AbDiskNumRequestS = 'Legen Sie die Diskette %d des segmentierten Archivs ein';\n AbImageNumRequestS = 'Legen Sie das Segment %d des segmentierten Archivs ein';\n AbNoOverwriteSpanStreamS = 'Kann kein existierendes segmentiertes Archiv verndern';\n AbNoSpannedSelfExtractS = 'Kann kein selbstentpackendes segmentiertes Archiv erstellen';\n AbBlankDiskS = 'Legen Sie eine leere Diskette ein';\n AbStreamFullS = 'Strom Schreibfehler';\n AbNoSuchDirectoryS = 'Verzeichnis existiert nicht';\n AbInflateBlockErrorS = 'Kann den Bereich nicht entpacken';\n AbBadStreamTypeS = 'Ungltiger Strom';\n AbTruncateErrorS = 'Fehler beim Abschneiden der zip Datei';\n AbZipBadCRCS = 'Fehlgeschalgene CRC berprfung';\n AbZipBadStubS = 'Der Stamm muss ausfhrbar sein';\n AbFileNotFoundS = 'Datei nicht gefunden';\n AbInvalidLFHS = 'Ungltiger lokaler Dateianfang';\n AbNoArchiveS = 'Das Archiv existiert nicht- leerer Dateinahme';\n AbReadErrorS = 'Fehler beim Lesen des Archivse';\n AbInvalidIndexS = 'Ungltiger Archiv Element Eintrag';\n AbInvalidThresholdS = 'Ungltige Archivgren Schwelle';\n AbUnhandledFileTypeS = 'Unbekannter Archiv';\n AbSpanningNotSupportedS = 'Aufteilen wird bei diesem Archivtyp nicht untersttzt';\n AbLogCreateErrorS = 'Fehler beim Erzeugen der Protokolldatei';\n AbMoveFileErrorS = 'Fehler beim Verschieben der Datei %s nach %s';\n AbFileSizeTooBigS = 'Datei ist zu gro fr diesen Archivtypen';\n\n AbNoCabinetDllErrorS = 'Kann die Datei cabinet.dll nicht laden';\n AbFCIFileOpenErrorS = 'FCI kann die Datei nicht ffnen';\n AbFCIFileReadErrorS = 'FCI kann die Datei nicht lesen';\n AbFCIFileWriteErrorS = 'FCI kann die Datei nicht schreiben';\n AbFCIFileCloseErrorS = 'FCI Fehler beim Schlieen der Datei';\n AbFCIFileSeekErrorS = 'FCI Fehler beim Durchsuchen der Datei';\n AbFCIFileDeleteErrorS = 'FCI Fehler beim Lschen der Datei';\n AbFCIAddFileErrorS = 'FCI kann die Datei nicht hinzufgen';\n AbFCICreateErrorS = 'FCI kann den Zusammenhang nicht erstellen';\n AbFCIFlushCabinetErrorS = 'FCI kann das Cabinet-Archiv nicht leeren';\n AbFCIFlushFolderErrorS = 'FCI kann das Verzeichnis nicht leeren';\n AbFDICopyErrorS = 'FDI kann die Dateien nicht aufzhlen';\n AbFDICreateErrorS = 'FDI kann den Zusammenhang nicht herstellen';\n AbInvalidCabTemplateS = 'Ungltige Vorlage fr eine Cabinet-Datei';\n AbInvalidCabFileS = 'Ungltige Datei - keine Kabinett Datei';\n\n AbZipStored = 'Gespeichert';\n AbZipShrunk = 'Geschrumpft';\n AbZipReduced = 'Reduziert';\n AbZipImploded = 'Implodiert';\n AbZipTokenized = 'In Merkmale aufgeteilt';\n AbZipDeflated = 'Gepackt';\n AbZipDeflate64 = 'Strker gepackt';\n AbZipDCLImploded = 'DCL Implodiert';\n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Unbekannt (%d)';\n AbZipBestMethod = 'Beste Methode';\n\n AbVersionFormatS = 'Version %s';\n AbCompressedSizeFormatS = 'Komprimierte Gre: %d';\n AbUncompressedSizeFormatS = 'Komprimierte Gre: %d';\n AbCompressionMethodFormatS = 'Kompressions-Methode: %s';\n AbCompressionRatioFormatS = 'Kompressions-Verhltnis: %2.0f%%';\n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'Externe Datei Attribute: %s';\n AbIFAFormatS = 'Dateityp: %s';\n AbTextS = 'Text';\n AbBinaryS = 'Binr';\n AbEncryptionFormatS = 'Verschlsselung: %s';\n AbEncryptedS = 'Verschlsselt';\n AbNotEncryptedS = 'Nicht verschlsselt';\n AbUnknownS = 'Unbekannt';\n AbTimeStampFormatS = 'Zeitstemple: %s';\n AbMadeByFormatS = 'Erzeugt mit der Version: %f';\n AbNeededFormatS = 'Version bentigt zum Extrahieren: %f';\n AbCommentFormatS = 'Kommentar: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'PKZip Archive (*.zip)|*.zip|Selbstentpackende Archive (*.exe)|*.exe|Alle Dateien (*.*)|*.*';\n AbFileNameTitleS = 'Dateinamen auswhlen';\n\n AbOKS = 'OK';\n AbCancelS = 'Abbrechen';\n AbSelectDirectoryS = 'Verzeichnis auswhlen';\n\n AbEnterPasswordS = 'Passwort eingeben';\n AbPasswordS = '&Passwort';\n AbVerifyS = '&berprfen';\n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Cabinet Archive (*.cab)|*.CAB|Alle Dateien (*.*)|*.*';\n AbLogExtS = '*.txt';\n AbLogFilterS = 'Text Dateien (*.txt)|*.TXT|Alle Dateien (*.*)|*.*';\n AbExeExtS = '*.exe';\n AbExeFilterS = 'Selbstentpackende Zip Dateien (*.exe)|*.EXE|Alle Dateien (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = 'VMS: Anforderung, zu viele Bytes [%d] zu lesen';\n AbVMSInvalidOriginS = 'VMS: Ungltiger Ursprung %d, sollte 0, 1, 2 sein';\n AbVMSErrorOpenSwapS = 'VMS: Kann die Auslagerungsdatei %s nicht ffnen';\n AbVMSSeekFailS = 'VMS: Konnte nicht in der Auslagerungsdatei %s suchen';\n AbVMSReadFailS = 'VMS: Konnte nicht %d Bytes in der Auslagerungsdatei %s lesen';\n AbVMSWriteFailS = 'VMS: Konnte nicht %d Bytes in die Auslagerungsdatei %s schreiben';\n AbVMSWriteTooManyBytesS = 'VMS: Anforderung, zu viele Bytes [%d] zu schreiben';\n\n AbBBSReadTooManyBytesS = 'BBS: Anforderung, zu viele Bytes [%d] zu lesen';\n AbBBSSeekOutsideBufferS = 'BBS: Die neue Position ist auerhalb des Puffers';\n AbBBSInvalidOriginS = 'BBS: Ungltiger Ursprungswert';\n AbBBSWriteTooManyBytesS = 'BBS: Anforderung, zu viele Bytes [%d] zu schreiben';\n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Nicht am Ende des Datenstroms';\n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Suche fehlgeschlagen';\n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: Schreiben fehlgeschlagen';\n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Ungltiger Ursprung';\n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Ungltige neue Position';\n\n AbItemNameHeadingS = 'Name';\n AbPackedHeadingS = 'Gepacked';\n AbMethodHeadingS = 'Methode';\n AbRatioHeadingS = 'Einsparung (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Attribute';\n AbFileFormatHeadingS = 'Format';\n AbEncryptionHeadingS = 'Verschlsselt';\n AbTimeStampHeadingS = 'Zeitstempel';\n AbFileSizeHeadingS = 'Gre';\n AbVersionMadeHeadingS = 'Version genutzt';\n AbVersionNeededHeadingS = 'Version bentigt';\n AbPathHeadingS = 'Pfad';\n AbPartialHeadingS = 'Teilweise';\n AbExecutableHeadingS = 'Ausfhrbar';\n AbFileTypeHeadingS = 'Typ';\n AbLastModifiedHeadingS = 'Modifiziert';\n\n AbCabMethod0S = 'Keine';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' hinzugefgt ';\n AbLtDeleteS = ' gelscht ';\n AbLtExtractS = ' extrahiert ';\n AbLtFreshenS = ' aktualisiert ';\n AbLtMoveS = ' verschoben ';\n AbLtReplaceS = ' ersetzt ';\n AbLtStartS = ' protokolliert ';\n\n AbGzipInvalidS = 'Ungltiges Gzip';\n AbGzipBadCRCS = 'Ungltiger CRC';\n AbGzipBadFileSizeS = 'Ungltige Datei Gre';\n\n AbTarInvalidS = 'Ungltiges Tar';\n AbTarBadFileNameS = 'Dateiname zu lang';\n AbTarBadLinkNameS = 'Linkname zu lang';\n AbTarBadOpS = 'Nicht untersttzte Operation';\n\n AbUnhandledEntityS = 'Nicht behandelte Entitt';\n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'FAT Datei-System (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (oder OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'HPFS Datei-System (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'NTFS Datei-System (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISCOS';\n AbGzOsVFAT = 'VFAT Datei-System (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox oder PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'unkekannt';\n AbGzOsUndefined = 'ID ist Gzip nicht bekannt';\n\n{!!.03 - Moved from AbCompnd.inc }\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Index auerhalb des zulssigen Bereichs';\n AbCmpndBusyUpdating = 'Verbindungsdatei wird aktualisiert';\n AbCmpndInvalidFile = 'Ungltige Verbindungsdatei';\n AbCmpndFileNotFound = 'Datei/Verzeichnis nicht gefunden';\n AbCmpndFolderNotEmpty = 'Verzeichnis ist nicht leer';\n AbCmpndExceedsMaxFileSize = 'Dateigre berschreitet das erlaubte Maximum';\n{!!.03 - End Moved }\n\n\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/localization/AbResString.pas.fr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Hichem BOUKSANI, John Riche, Roman Kassebaum\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas *}\n{*********************************************************}\n{* Abbrevia: Resource strings *}\n{*********************************************************}\nunit AbResString;\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Fichier non valide - N''est pas un fichier PKZip';\n AbZipVersionNeededS = 'Impossible d''extraire le fichier - nouvelle version requise';\n AbUnknownCompressionMethodS = 'Impossible d''extraire le fichier - mthode de compression non supporte';\n AbNoExtractionMethodS = 'Impossible d''extraire le fichier - aucun support d''extraction fourni';\n AbInvalidPasswordS = 'Impossible d''extraire le fichier - Mot de passe incorrect';\n AbNoInsertionMethodS = 'Imossible d''insrer le fichier - aucun support d''insertion fourni';\n AbInvalidFactorS = 'Facteur de rduction Invalide';\n AbDuplicateNameS = 'Impossible d''insrer le fichier - Nom du fichier existe en double';\n AbUnsupportedCompressionMethodS = 'Impossible d''insrer le fichier - mthode de compression non suppote';\n AbUserAbortS = 'Processus abandonn par l''utilisateur';\n AbArchiveBusyS = 'Archivage en cours - ne peut traiter de nouvelles demandes'; \n AbLastDiskRequestS = 'Insrer la dernire disquette du jeu multi-disquettes';\n AbDiskRequestS = 'Insrer une disquette'; \n AbImageRequestS = 'Nom du fichier image';\n AbBadSpanStreamS = 'Archives multi-disquettes doivent tre ouvertes comme fichiers de flux';\n AbDiskNumRequestS = 'Insrer la disquette %d du jeu multi-disquettes';\n AbImageNumRequestS = 'Insrer la disquette %d du jeu multi-disquettes'; \n AbNoOverwriteSpanStreamS = 'Impossible de mettre jour un jeu multi-disquettes existant';\n AbNoSpannedSelfExtractS = 'Impossible de crer un fichier auto-extractible partir d''une archive multi-disquettes';\n AbBlankDiskS = 'Insrer une disquette vierge';\n AbStreamFullS = 'Erreur d''criture du flux';\n AbNoSuchDirectoryS = 'Dossier inexistant';\n AbInflateBlockErrorS = 'Dcompression du bloc impossible';\n AbBadStreamTypeS = 'Flux Invalide';\n AbTruncateErrorS = 'Erreur de troncage du fichier ZIP';\n AbZipBadCRCS = 'Echec du contrle CRC';\n AbZipBadStubS = 'La souche doit tre un executable';\n AbFileNotFoundS = 'Fichier inexistant';\n AbInvalidLFHS = 'Entre de l''entte du fichier local invalide'; \n AbNoArchiveS = 'L''archive n''existe pas - Nom de fichier non spcifi';\n AbReadErrorS = 'Erreur de l''ecture de l''archive';\n AbInvalidIndexS = 'L''indice de l''lment de l''archive est invalide'; \n AbInvalidThresholdS = 'Le seuil de la taille de l''archive est invalide'; \n AbUnhandledFileTypeS = 'Type d''archive non support'; \n AbSpanningNotSupportedS = 'Multi-disquette non support par ce type d''archive'; \n AbLogCreateErrorS = 'Erreur de cration du fichier log';\n AbMoveFileErrorS = 'Erreur de dplacement du fichier %s vers %s';\n AbFileSizeTooBigS = 'Taille du fichier trop grande pour le type d''archive'; \n\n AbNoCabinetDllErrorS = 'Impossible de charger cabinet.dll';\n AbFCIFileOpenErrorS = 'FCI impossible d''ouvrir le fichier';\n AbFCIFileReadErrorS = 'FCI impossible de lire le fichier';\n AbFCIFileWriteErrorS = 'FCI Ecriture impossible sur le fichier';\n AbFCIFileCloseErrorS = 'FCI erreur de fermeture du fichier';\n AbFCIFileSeekErrorS = 'FCI Erreur de recherche de fichier'; \n AbFCIFileDeleteErrorS = 'FCI erreur de suppression du fichier';\n AbFCIAddFileErrorS = 'FCI impossible d''ajouter le fichier';\n AbFCICreateErrorS = 'FCI impossible de crer le contexte';\n AbFCIFlushCabinetErrorS = 'FCI impossible de vider le cabinet';\n AbFCIFlushFolderErrorS = 'FCI Impossible de vider le dossier';\n AbFDICopyErrorS = 'FDI impossible d''enumrer les fichiers'; \n AbFDICreateErrorS = 'FDI impossible de crer le contexte';\n AbInvalidCabTemplateS = 'Modle du fichier CAB invalide';\n AbInvalidCabFileS = 'Fichier invalide - n''est pas un fichier cabinet';\n\n AbZipStored = 'Stock';\n AbZipShrunk = 'Compact'; \n AbZipReduced = 'Rduit';\n AbZipImploded = 'Implos';\n AbZipTokenized = 'Divis en plusieurs parties';\n AbZipDeflated = 'Dflation'; \n AbZipDeflate64 = 'Dflation amliore';\n AbZipDCLImploded = 'DCL Implos'; \n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Inconnu (%d)';\n AbZipBestMethod = 'Meilleure Mthode';\n\n AbVersionFormatS = 'Version %s';\n AbCompressedSizeFormatS = 'Taille compresse: %d';\n AbUncompressedSizeFormatS = 'Taille non compresse: %d';\n AbCompressionMethodFormatS = 'Mthode de compression: %s';\n AbCompressionRatioFormatS = 'Ratio de compression: %2.0f%%';\n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'Attribut du fichier externe: %s';\n AbIFAFormatS = 'Type du fichier: %s';\n AbTextS = 'Text';\n AbBinaryS = 'Binaire';\n AbEncryptionFormatS = 'Crypt: %s';\n AbEncryptedS = 'Crypt';\n AbNotEncryptedS = 'Non crypt';\n AbUnknownS = 'Inconnu';\n AbTimeStampFormatS = 'Heure: %s';\n AbMadeByFormatS = 'Version utilise: %f'; \n AbNeededFormatS = 'Version d''extraction: %f'; \n AbCommentFormatS = 'Commentaire: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'Archives PKZip (*.zip)|*.zip|Archives Auto extractibles (*.exe)|*.exe|Tous les fichiers (*.*)|*.*';\n AbFileNameTitleS = 'Slectionner un fichier';\n\n AbOKS = 'OK';\n AbCancelS = 'Annuler';\n AbSelectDirectoryS = 'Slectionner un Dossier';\n\n AbEnterPasswordS = 'Saisir Mot de passe';\n AbPasswordS = '&Mot de passe';\n AbVerifyS = '&Vrifier';\n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Archives Cabinet (*.cab)|*.CAB|Tous les fichiers (*.*)|*.*';\n AbLogExtS = '*.txt';\n AbLogFilterS = 'Fichiers Text (*.txt)|*.TXT|Tous les fichiers (*.*)|*.*';\n AbExeExtS = '*.exe';\n AbExeFilterS = 'Fichiers Zip auto-extractibles (*.exe)|*.EXE|Tous les fichiers (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = VMS: Tentative de l''ecture de trop d''octets [%d]';\n AbVMSInvalidOriginS = 'VMS: Origine invalide %d, doit tre 0, 1, 2';\n AbVMSErrorOpenSwapS = 'VMS: Impossible d''ouvrir le fichier d''change %s';\n AbVMSSeekFailS = 'VMS: Impossible de se dplacer dans le fichier d''change %s';\n AbVMSReadFailS = 'VMS: impossible de lire %d octets du fichier d''change %s';\n AbVMSWriteFailS = 'VMS: impossible d''crire %d octets dans le fichier d''change %s'; \n AbVMSWriteTooManyBytesS = 'VMS: tentative d''crire trop d''octets [%d]';\n\n AbBBSReadTooManyBytesS = 'BBS: tentative de lecture de trop d''octets [%d]';\n AbBBSSeekOutsideBufferS = 'BBS: la nouvelle position est en dehors du buffer';\n AbBBSInvalidOriginS = 'BBS: Valeur d''origine invalide';\n AbBBSWriteTooManyBytesS = 'BBS: tentative d''crire de trop d''octets [%d]';\n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Pas la fin du flux';\n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: chec de recherche';\n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: chec d''criture';\n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Origine incorrecte';\n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Nouvelle position incorrecte';\n\n AbItemNameHeadingS = 'Nom';\n AbPackedHeadingS = 'Compress';\n AbMethodHeadingS = 'Mthode';\n AbRatioHeadingS = 'Ratio (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Attribut';\n AbFileFormatHeadingS = 'Format';\n AbEncryptionHeadingS = 'Crypt';\n AbTimeStampHeadingS = 'Heure';\n AbFileSizeHeadingS = 'Taille';\n AbVersionMadeHeadingS = 'Version Utilise';\n AbVersionNeededHeadingS = 'Version ncessaire';\n AbPathHeadingS = 'Chemin';\n AbPartialHeadingS = 'Partiel';\n AbExecutableHeadingS = 'Excutable';\n\n AbCabMethod0S = 'Aucune';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' Ajout ';\n AbLtDeleteS = ' Supprim ';\n AbLtExtractS = ' Extrait ';\n AbLtFreshenS = ' Rafraichir ';\n AbLtMoveS = ' Dplac ';\n AbLtReplaceS = ' Remplac ';\n AbLtStartS = ' Connexion ';\n\n AbGzipInvalidS = 'Gzip Invalide';\n AbGzipBadCRCS = 'Mauvais CRC'; \n AbGzipBadFileSizeS = 'Taille du fichier errone'; \n\n AbTarInvalidS = 'Tar invalide';\n AbTarBadFileNameS = 'Nom de fichier trop long';\n AbTarBadLinkNameS = 'Chemin du lien symbolique trop long';\n AbTarBadOpS = 'Opration non supporte';\n \n AbUnhandledEntityS = 'Entit non prise en charge';\n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'Systme de fichier FAT (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (ou OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'Systme de fichier HPFS (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'Systme de fichier NTFS (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISCOS';\n AbGzOsVFAT = 'Systme de fichier VFAT (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox ou PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'Inconnu';\n AbGzOsUndefined = 'ID non dfini par gzip'; \n\n{!!.03 - Moved from AbCompnd.inc }\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Indice hors limite';\n AbCmpndBusyUpdating = 'Fichier compos est occup par la mise jour';\n AbCmpndInvalidFile = 'Fichier compos invalide';\n AbCmpndFileNotFound = 'Fichier/Dossier introuvable';\n AbCmpndFolderNotEmpty = 'Dossier n''est pas vide';\n AbCmpndExceedsMaxFileSize = 'Taille du fichier dpasse la limite maximale'; \n{!!.03 - End Moved }\n\n\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/localization/AbResString.pas.nl",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Rudy Velthuis\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas 3.05 *}\n{*********************************************************}\n{* Abbrevia: Resource strings, Dutch localization *}\n{*********************************************************}\nunit AbResString;\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Ongeldig bestand - geen PKZip bestand';\n AbZipVersionNeededS = 'Kan bestand niet ontpakken - nieuwere versie nodig';\n AbUnknownCompressionMethodS = 'Kan bestand niet ontpakken - niet ondersteunde compressiemethode';\n AbNoExtractionMethodS = 'Kan bestand niet ontpakken - ontpakken wordt niet ondersteund';\n AbInvalidPasswordS = 'Kan bestand niet ontpakken - ongeldig paswoord';\n AbNoInsertionMethodS = 'Kan bestand niet invoegen - invoegen wordt niet ondersteund';\n AbInvalidFactorS = 'Ongeldige reductiefactor';\n AbDuplicateNameS = 'Kan het bestand niet invoegen - dupliceert opgeslagen naam';\n AbUnsupportedCompressionMethodS = 'Kan het bestand niet invoegen - niet ondersteunde compressiemethode';\n AbUserAbortS = 'Proces werd door gebruiker afgebroken';\n AbArchiveBusyS = 'Archief is bezig - kan nieuwe aanvraag niet bewerken';\n AbLastDiskRequestS = 'Plaats laatste diskette van opgesplitst archief';\n AbDiskRequestS = 'Plaats diskette';\n AbImageRequestS = 'Bestandsnaam afbeelding';\n AbBadSpanStreamS = 'Opgesplitste archieven moeten als bestandsstroom geopend worden';\n AbDiskNumRequestS = 'Plaats diskette %d van opgesplitst archief';\n AbImageNumRequestS = 'Plaats segment %d van opgesplitst archief';\n AbNoOverwriteSpanStreamS = 'Kan bestaand opgesplitst archief niet veranderen';\n AbNoSpannedSelfExtractS = 'Kan geen zelfontpakkend opgesplitst archief aanmaken';\n AbBlankDiskS = 'Plaats een lege diskette';\n AbStreamFullS = 'Schrijffout stroom';\n AbNoSuchDirectoryS = 'Directory bestaat niet';\n AbInflateBlockErrorS = 'Kan blok niet ontpakken';\n AbBadStreamTypeS = 'Ongeldige stroom';\n AbTruncateErrorS = 'Fout bij het afknotten van het zip bestand';\n AbZipBadCRCS = 'Mislukte CRC controle';\n AbZipBadStubS = 'Stomp moet uitvoerbaar bestand zijn';\n AbFileNotFoundS = 'Bestand niet gevonden';\n AbInvalidLFHS = 'Ongeldig Local File Header element';\n AbNoArchiveS = 'Archief bestaat niet - lege bestandsnaam';\n AbReadErrorS = 'Fout tijdens lezen van archief';\n AbInvalidIndexS = 'Ongeldige index van archiefelement';\n AbInvalidThresholdS = 'Ongeldige drempel van archiefgrootte';\n AbUnhandledFileTypeS = 'Onbekend archieftype';\n AbSpanningNotSupportedS = 'Opsplitsen wordt voor dit archieftype niet ondersteund';\n AbLogCreateErrorS = 'Fout tijdens aanmaken van protocolbestand';\n AbMoveFileErrorS = 'Fout tijdens het verplaatsen van bestand %s naar %s';\n AbFileSizeTooBigS = 'Bestand is te groot voor dit archieftype';\n\n AbNoCabinetDllErrorS = 'Kan bestand cabinet.dll niet laden';\n AbFCIFileOpenErrorS = 'FCI kan bestand niet openen';\n AbFCIFileReadErrorS = 'FCI kan bestand niet lezen';\n AbFCIFileWriteErrorS = 'FCI kan bestand niet schrijven';\n AbFCIFileCloseErrorS = 'FCI fout tijdens sluiten van bestand';\n AbFCIFileSeekErrorS = 'FCI fout tijdens positioneren in bestand';\n AbFCIFileDeleteErrorS = 'FCI fout tijdens wissen van bestand';\n AbFCIAddFileErrorS = 'FCI kan bestand niet toevoegen';\n AbFCICreateErrorS = 'FCI kan context niet aanmaken';\n AbFCIFlushCabinetErrorS = 'FCI kan cabinet niet legen';\n AbFCIFlushFolderErrorS = 'FCI kan folder niet legen';\n AbFDICopyErrorS = 'FDI kann bestanden niet opsommen';\n AbFDICreateErrorS = 'FDI kan context niet aanmaken';\n AbInvalidCabTemplateS = 'Ongeldige sjabloon voor cabinetsbestand';\n AbInvalidCabFileS = 'Ongeldig bestand - geen cabinetsbestand';\n\n AbZipStored = 'Opgeslagen';\n AbZipShrunk = 'Gekrompen';\n AbZipReduced = 'Gereduceerd';\n AbZipImploded = 'Gemplodeerd';\n AbZipTokenized = 'In symbolen gepakt';\n AbZipDeflated = 'Gedeflationeerd';\n AbZipDeflate64 = 'Uitgebreid gedeflationeerd';\n AbZipDCLImploded = 'DCL gemplodeerd';\n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Onbekend (%d)';\n AbZipBestMethod = 'Beste methode';\n\n AbVersionFormatS = 'Versie %s';\n AbCompressedSizeFormatS = 'Gecomprimeerde grootte: %d';\n AbUncompressedSizeFormatS = 'Ongecomprimeerde grootte: %d';\n AbCompressionMethodFormatS = 'Compressiemethode: %s';\n AbCompressionRatioFormatS = 'Compressieverhouding: %2.0f%%';\n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'Externe bestandsattributen: %s';\n AbIFAFormatS = 'Bestandstype: %s';\n AbTextS = 'Tekst';\n AbBinaryS = 'Binair';\n AbEncryptionFormatS = 'Versleuteling: %s';\n AbEncryptedS = 'Versleuteld';\n AbNotEncryptedS = 'Niet versleuteld';\n AbUnknownS = 'Onbekend';\n AbTimeStampFormatS = 'Tijdstempel: %s';\n AbMadeByFormatS = 'Gemaakt met versie: %f';\n AbNeededFormatS = 'Versie benodigd voor ontpakken: %f';\n AbCommentFormatS = 'Opmerking: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'PKZip Archieven (*.zip)|*.zip|Zelfontpakkende Archieven (*.exe)|*.exe|Alle Bestanden (*.*)|*.*';\n AbFileNameTitleS = 'Bestandsnaam Kiezen';\n\n AbOKS = 'OK';\n AbCancelS = 'Verlaten';\n AbSelectDirectoryS = 'Bestand kiezen';\n\n AbEnterPasswordS = 'Paswoord ingeven';\n AbPasswordS = '&Paswoord';\n AbVerifyS = '&Verificeren';\n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Cabinetsarchieven (*.cab)|*.CAB|Alle Bestanden (*.*)|*.*';\n AbLogExtS = '*.txt';\n AbLogFilterS = 'Tekstbestanden (*.txt)|*.TXT|Alle Bestanden (*.*)|*.*';\n AbExeExtS = '*.exe';\n AbExeFilterS = 'Zelfontpakkende Zip Bestanden (*.exe)|*.EXE|Alle Bestanden (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = 'VMS: Anvraag om te veel byte [%d] te lezen';\n AbVMSInvalidOriginS = 'VMS: Ongeldige oorsprong %d, moet 0, 1 of 2 zijn';\n AbVMSErrorOpenSwapS = 'VMS: Kan wisselbestand %s niet openen';\n AbVMSSeekFailS = 'VMS: Kon niet in wisselbestand %s positioneren';\n AbVMSReadFailS = 'VMS: Kon %d byte in wisselbestand %s niet lezen';\n AbVMSWriteFailS = 'VMS: Kon %d byte niet in wisselbestand %s schrijven';\n AbVMSWriteTooManyBytesS = 'VMS: Anvraag om te veel byte [%d] te schrijven';\n\n AbBBSReadTooManyBytesS = 'BBS: Anvraag om te veel byte [%d] te lezen';\n AbBBSSeekOutsideBufferS = 'BBS: Nieuwe positie is buiten de buffer';\n AbBBSInvalidOriginS = 'BBS: Ongeldige oorsprongswaarde';\n AbBBSWriteTooManyBytesS = 'BBS: Anvraag om te veel byte [%d] te schrijven';\n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Niet aan eind van stroom';\n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Positioneren mislukt';\n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: Schrijven mislukt';\n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Ongeldige oorsprong';\n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Ongeldige nieuwe positie';\n\n AbItemNameHeadingS = 'Naam';\n AbPackedHeadingS = 'Gepakt';\n AbMethodHeadingS = 'Methode';\n AbRatioHeadingS = 'Besparing (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Attribuut';\n AbFileFormatHeadingS = 'Formaat';\n AbEncryptionHeadingS = 'Versleuteld';\n AbTimeStampHeadingS = 'Tijdstempel';\n AbFileSizeHeadingS = 'Grootte';\n AbVersionMadeHeadingS = 'Gebruikte versie';\n AbVersionNeededHeadingS = 'Benodigde versie';\n AbPathHeadingS = 'Pad';\n AbPartialHeadingS = 'Partieel';\n AbExecutableHeadingS = 'Uitvoerbaar';\n\n AbCabMethod0S = 'Geen';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' toegevoegd ';\n AbLtDeleteS = ' gewist ';\n AbLtExtractS = ' ontpakt ';\n AbLtFreshenS = ' geactualiseerd ';\n AbLtMoveS = ' verplaatst ';\n AbLtReplaceS = ' vervangen ';\n AbLtStartS = ' geprotocolleerd ';\n\n AbGzipInvalidS = 'Ongeldige Gzip';\n AbGzipBadCRCS = 'Ongeldige CRC';\n AbGzipBadFileSizeS = 'Ongeldige bestandsgrootte';\n\n AbTarInvalidS = 'Ongeldige Tar';\n \n AbTarBadFileNameS = 'Bestandsnaam te lang';\n \n AbTarBadLinkNameS = 'Link naam te lang';\n \n AbTarBadOpS = 'Niet ondersteunde functie';\n\n \n\n AbUnhandledEntityS = 'Niet behandelde entiteit';\n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'FAT Bestandssysteem (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (oder OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'HPFS Bestandssysteem (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'NTFS Bestandssysteem (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISC OS';\n AbGzOsVFAT = 'VFAT Bestandssysteem (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox of PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'onbekend';\n AbGzOsUndefined = 'ID is Gzip niet bekend';\n\n{!!.03 - Moved from AbCompnd.inc }\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Index niet in toegelaten bereik';\n AbCmpndBusyUpdating = 'Samengesteld bestand wordt geactualiseerd';\n AbCmpndInvalidFile = 'Ongeldig samengesteld bestand ';\n AbCmpndFileNotFound = 'Bestand/directory niet gevonden';\n AbCmpndFolderNotEmpty = 'Directory is niet leeg';\n AbCmpndExceedsMaxFileSize = 'Bestandsgrootte overschrijdt toegelaten maximum';\n{!!.03 - End Moved }\n\n\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/localization/AbResString.pas.ru",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Pavel Koptev, Roman Kassebaum\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas *}\n{*********************************************************}\n{* Abbrevia: Resource strings, Russian localization *}\n{*********************************************************}\n{* Warning: This file is UTF-8 encoded *}\n{*********************************************************}\n{* You need D2009 or higher to compile this unit *}\n{*********************************************************}\nunit AbResString;\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Формат архива не соответствует PKZip-формату';\n AbZipVersionNeededS = 'Действие невозможно. Файл запакован более новой версией программы';\n AbUnknownCompressionMethodS = 'Действие невозможно. Нераспознанный метод сжатия';\n AbNoExtractionMethodS = 'Действие невозможно. Не доступен метод распаковки архива';\n AbInvalidPasswordS = 'Действие невозможно. Неверный пароль';\n AbNoInsertionMethodS = 'Действие невозможно. Архивом не поддерживается добавление новых файлов';\n AbInvalidFactorS = 'Недействительный фактор сжатия';\n AbDuplicateNameS = 'Действие невозможно. Файл с таким именем в архиве уже присутствует';\n AbUnsupportedCompressionMethodS = 'Действие невозможно. Неподдерживаемый метод сжатия';\n AbUserAbortS = 'Действие отменено пользователем';\n AbArchiveBusyS = 'Действие невозможно. Архив поврежден';\n AbLastDiskRequestS = 'Вставьте последнюю дискету в дисковод';\n AbDiskRequestS = 'Вставьте дискету в дисковод';\n AbImageRequestS = 'Имя образа';\n AbBadSpanStreamS = 'Многотомные архивы открываются как файловый поток';\n AbDiskNumRequestS = 'Вставьте %d дискету в дисковод';\n AbImageNumRequestS = 'Укажите расположение %d тома архива';\n AbNoOverwriteSpanStreamS = 'Невозможно изменить существующий многотомный архив';\n AbNoSpannedSelfExtractS = 'Невозможно создать многотомный SFX-Архив';\n AbBlankDiskS = 'Вставьте чистую дискету в дисковод';\n AbStreamFullS = 'Ошибка записи в память';\n AbNoSuchDirectoryS = 'Папка не существует';\n AbInflateBlockErrorS = 'Блок данных не может быть распакован';\n AbBadStreamTypeS = 'Недействительный поток';\n AbTruncateErrorS = 'Ошибка при разделении Zip-Файла';\n AbZipBadCRCS = 'Не верная контрольная сумма';\n AbZipBadStubS = 'Корневой элемент архива должен быть исполняемым файлом';\n AbFileNotFoundS = 'Файл не найден';\n AbInvalidLFHS = 'Неверное начало файла';\n AbNoArchiveS = 'Архив не существует';\n AbReadErrorS = 'Ошибка чтения архива';\n AbInvalidIndexS = 'Неверный индекс елемента архива';\n AbInvalidThresholdS = 'Неверный размер частей архива';\n AbUnhandledFileTypeS = 'Неизвестный архив';\n AbSpanningNotSupportedS = 'Многотомность не поддерживается этим типом архивов';\n AbLogCreateErrorS = 'Ошибка при создании файла протокола';\n AbMoveFileErrorS = 'Ошибка при перемещении файла %s в %s';\n AbFileSizeTooBigS = 'Файл слишком велик для выбранного типа архива';\n\n AbNoCabinetDllErrorS = 'Библиотека cabinet.dll не может быть загружена';\n AbFCIFileOpenErrorS = 'FCI невозможно открыть файл';\n AbFCIFileReadErrorS = 'FCI невозможно прочитать файл';\n AbFCIFileWriteErrorS = 'FCI невозможно записать файл';\n AbFCIFileCloseErrorS = 'FCI ошибка при закрытии файла';\n AbFCIFileSeekErrorS = 'FCI ошибка при поиске в файле';\n AbFCIFileDeleteErrorS = 'FCI ошибка при удалении файла';\n AbFCIAddFileErrorS = 'FCI невозможно добавить файл';\n AbFCICreateErrorS = 'FCI ошибка создания';\n AbFCIFlushCabinetErrorS = 'FCI Cabinet-архив не может быть создан';\n AbFCIFlushFolderErrorS = 'FCI невозможно удалить все файлы из папки';\n AbFDICopyErrorS = 'FDI невозможно пересчитать файлы';\n AbFDICreateErrorS = 'FDI ошибка создания';\n AbInvalidCabTemplateS = 'Неверный шаблон Cabinet-файла';\n AbInvalidCabFileS = ' Неверный Cabinet-файл';\n\n AbZipStored = 'Сохранено';\n AbZipShrunk = 'Сжато';\n AbZipReduced = 'Сжато';\n AbZipImploded = 'Сжато';\n AbZipTokenized = 'Разделен на части';\n AbZipDeflated = 'Сжато';\n AbZipDeflate64 = 'Лучшее сжатие';\n AbZipDCLImploded = 'DCL Сжато';\n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Неизвестно (%d)';\n AbZipBestMethod = 'Лучший метод';\n\n AbVersionFormatS = 'Версия %s';\n AbCompressedSizeFormatS = 'Размер в архиве: %d';\n AbUncompressedSizeFormatS = 'Размер: %d';\n AbCompressionMethodFormatS = 'Метод сжатия: %s';\n AbCompressionRatioFormatS = 'Степень сжатия: %2.0f%%';\n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'Внешние атрибуты файла: %s';\n AbIFAFormatS = 'Тип файла: %s';\n AbTextS = 'Текст';\n AbBinaryS = 'Двоичный';\n AbEncryptionFormatS = 'Шифрование: %s';\n AbEncryptedS = 'Зашифрован';\n AbNotEncryptedS = 'Не зашифрован';\n AbUnknownS = 'Неизвестно';\n AbTimeStampFormatS = 'Формат времени: %s';\n AbMadeByFormatS = 'Версия программы создания: %f';\n AbNeededFormatS = 'Для распаковки требуется версия: %f';\n AbCommentFormatS = 'Комментарии: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'PKZip-архив (*.zip)|*.zip|SFX-Архив (*.exe)|*.exe|Все файлы (*.*)|*.*';\n AbFileNameTitleS = 'Выберите имя файла';\n\n AbOKS = 'OK';\n AbCancelS = 'Отмена';\n AbSelectDirectoryS = 'Выберете папку';\n\n AbEnterPasswordS = 'Введите пароль';\n AbPasswordS = '&Пароль';\n AbVerifyS = '&Проверка';\n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Cabinet-архив (*.cab)|*.CAB|Все файлы (*.*)|*.*';\n AbLogExtS = '*.txt';\n AbLogFilterS = 'Текстовые файлы (*.txt)|*.TXT|Все файлы (*.*)|*.*';\n AbExeExtS = '*.exe';\n AbExeFilterS = 'SFX-архивы (*.exe)|*.EXE|Все файлы (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = 'VMS: попытка чтения слишком большого числа байт [%d]';\n AbVMSInvalidOriginS = 'VMS: недействительный источник %d, разрешены 0, 1, 2';\n AbVMSErrorOpenSwapS = 'VMS: Невозможно открыть файл %s';\n AbVMSSeekFailS = 'VMS: Невозможно осуществить поиск в файле %s';\n AbVMSReadFailS = 'VMS: Невозможно прочитать файл %s';\n AbVMSWriteFailS = 'VMS: Невозможно %d байт записать в файл %s';\n AbVMSWriteTooManyBytesS = 'VMS: попытка записи слишком большого числа байт [%d]';\n\n AbBBSReadTooManyBytesS = 'BBS: попытка чтения слишком большого числа байт [%d]';\n AbBBSSeekOutsideBufferS = 'BBS: позиция находится вне буфера';\n AbBBSInvalidOriginS = 'BBS: недействительно предыдущее значение';\n AbBBSWriteTooManyBytesS = 'BBS: попытка записи слишком большого числа байт [%d]';\n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: попытка записи данных не в конец потока';\n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: поиск не удался';\n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: запись не удалась';\n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Недействительный источник';\n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: недействительная новая позиция';\n\n AbItemNameHeadingS = 'Имя';\n AbPackedHeadingS = 'Сжато';\n AbMethodHeadingS = 'Метод';\n AbRatioHeadingS = 'Коэффициент сжатия (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Атрибуты';\n AbFileFormatHeadingS = 'Формат';\n AbEncryptionHeadingS = 'Шифрование';\n AbTimeStampHeadingS = 'Время';\n AbFileSizeHeadingS = 'Размер';\n AbVersionMadeHeadingS = 'Использована версия';\n AbVersionNeededHeadingS = 'Необходима версия';\n AbPathHeadingS = 'Путь';\n AbPartialHeadingS = 'Частично';\n AbExecutableHeadingS = 'Выполнимо';\n\n AbCabMethod0S = 'нет';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' вставлен ';\n AbLtDeleteS = ' удален ';\n AbLtExtractS = ' распакован ';\n AbLtFreshenS = ' обновлен ';\n AbLtMoveS = ' перемещен ';\n AbLtReplaceS = ' заменено ';\n AbLtStartS = ' запротоколировано ';\n\n AbGzipInvalidS = 'Недействительный Gzip';\n AbGzipBadCRCS = 'Недействительная контрольная сумма';\n AbGzipBadFileSizeS = 'Недействительный размер файла';\n\n AbTarInvalidS = 'Недествительный Tar-архив'; \n AbTarBadFileNameS = 'Слишком длинное имя файла';\n AbTarBadLinkNameS = 'Слишком длинная ссылка';\n AbTarBadOpS = 'Неподдерживаемая операция';\n \n AbUnhandledEntityS = 'Необрабатываемый объект';\n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'FAT файловая система (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (или OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'HPFS файловая система (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'NTFS файловая система (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISCOS';\n AbGzOsVFAT = 'VFAT файловая система (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox или PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'неизвестно';\n AbGzOsUndefined = 'Идентификационный номер для Gzip не известен';\n\n{!!.03 - Moved from AbCompnd.inc }\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Индекс выходит за пределы допустимого диапазона';\n AbCmpndBusyUpdating = 'Обновляется файл связок';\n AbCmpndInvalidFile = 'Недействительный файл связок';\n AbCmpndFileNotFound = 'Файл или папка не найдены';\n AbCmpndFolderNotEmpty = 'Папка не пуста';\n AbCmpndExceedsMaxFileSize = 'Допустимый размер файла был превышен';\n{!!.03 - End Moved }\n\n\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/localization/AbResString.pas.tr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Durali Kiraz 2014-05-06\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas *}\n{*********************************************************}\n{* Abbrevia: Resource strings, Turkish localization *}\n{*********************************************************}\n{* Encoded in Code Page 1252 (Windows Latin 5 Turkish) *}\n{*********************************************************}\nunit AbResString;\n\n{$I AbDefine.inc}\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Geersiz dosya - bir PKZip dosyas deil';\n AbZipVersionNeededS = 'Dosya Ayklanamyor - daha yeni bir srm gerekli.';\n AbUnknownCompressionMethodS = 'Dosya Ayklanamyor - desteklenmeyen sktrma yntemi';\n AbNoExtractionMethodS = 'Dosya Ayklanamyor - salanan bir karma destei yok';\n AbInvalidPasswordS = 'Dosya Ayklanamyor - geersiz ifre';\n AbNoInsertionMethodS = 'Dosya Eklenemiyor - salanan bir ekleme destei yok';\n AbInvalidFactorS = 'Geersiz Faktr azaltn';\n AbDuplicateNameS = 'Dosya Eklenemiyor - saklanan dosya ad ift';\n AbUnsupportedCompressionMethodS = 'Dosya Eklenemiyor - desteklenmeyen sktrma yntemi';\n AbUserAbortS = 'Sre kullanc tarafndan iptal edildi';\n AbArchiveBusyS = 'Ariv megul - yeni istekleri ileyemiyor';\n AbLastDiskRequestS = 'Yaylm disk setinde son diski yerletirin';\n AbDiskRequestS = 'Disket takn';\n AbImageRequestS = 'Kalp dosya ad';\n AbBadSpanStreamS = 'Yaylm arivler dosya akkanlar gibi almaldr';\n AbDiskNumRequestS = 'Yaylm disk setinin %d numaral diskini ekleyin';\n AbImageNumRequestS = 'Yaylm dosya setinin aralkl %d numaral dosyasn ekleyin ';\n AbNoOverwriteSpanStreamS = 'Varolan Yaylm disk seti gncelleme yaplamaz';\n AbNoSpannedSelfExtractS = 'Bir kendi kendini ayklayan(exe dosyas) disk seti yaplamaz';\n AbBlankDiskS = 'Bo bir disket ekle';\n AbStreamFullS = 'Akkan yazma hatas';\n AbNoSuchDirectoryS = 'Klasr mevcut deil';\n AbInflateBlockErrorS = 'Blou iiremezsin (connot inflate)';\n AbBadStreamTypeS = 'Geersiz Akkan';\n AbTruncateErrorS = 'Zip dosyas hata ile kesiliyor';\n AbZipBadCRCS = 'Baarsz CRC kontrol';\n AbZipBadStubS = 'Stub bir altrlabilir(exe) olmal';\n AbFileNotFoundS = 'Dosya bulunamad';\n AbInvalidLFHS = 'Geersiz Yerel Dosya Bal giri';\n AbNoArchiveS = 'Ariv mevcut deil - Dosyaad bo';\n AbReadErrorS = 'Okuma hatas arivi';\n AbInvalidIndexS = 'Geersiz ariv e Endeksi';\n AbInvalidThresholdS = 'Geersiz ariv boyutu eii';\n AbUnhandledFileTypeS = 'lenmeyen Ariv Tr';\n AbSpanningNotSupportedS = 'Yaylma bu Ariv tr tarafndan desteklenmiyor ';\n AbLogCreateErrorS = 'Gnlk Dosyas olutururken hata';\n AbMoveFileErrorS = '%s kaynandan %s hedefine Dosya Tamada Hata';\n AbFileSizeTooBigS = 'Dosya boyutu ariv tr iin ok byk';\n\n AbNoCabinetDllErrorS = 'cabinet.dll yklenemedi';\n AbFCIFileOpenErrorS = 'FCI dosya alamad';\n AbFCIFileReadErrorS = 'FCI dosya okunmad';\n AbFCIFileWriteErrorS = 'FCI dosya yazlamad';\n AbFCIFileCloseErrorS = 'FCI dosya kapatmada hata';\n AbFCIFileSeekErrorS = 'FCI dosya konumlanma hatas';\n AbFCIFileDeleteErrorS = 'FCI dosya silme hatas';\n AbFCIAddFileErrorS = 'FCI dosya eklenemedi';\n AbFCICreateErrorS = 'FCI ierii oluturulamyor';\n AbFCIFlushCabinetErrorS = 'FCI kabini flush yaplamyor';\n AbFCIFlushFolderErrorS = 'FCI klasr flush yaplamyor';\n AbFDICopyErrorS = 'FDI dosyalar numaralandrma yaplamyor';\n AbFDICreateErrorS = 'FDI ierii oluturulamyor';\n AbInvalidCabTemplateS = 'Geersiz cab dosya ablonu';\n AbInvalidCabFileS = 'Geersiz Dosya - bir kabin dosyas deil';\n\n AbZipStored = 'Depoland';\n AbZipShrunk = 'Bzlm';\n AbZipReduced = 'Azaltlm';\n AbZipImploded = 'ine kt';\n AbZipTokenized = 'Simgeletirilmi';\n AbZipDeflated = 'nik';\n AbZipDeflate64 = 'Gelitirilmi niklik';\n AbZipDCLImploded = 'DCL Bzlm';\n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Bilinmeyen (%d)';\n AbZipBestMethod = 'En yi Yntem';\n\n AbVersionFormatS = 'Srm %s';\n AbCompressedSizeFormatS = 'Sktrlm uzunluk: %d';\n AbUncompressedSizeFormatS = 'Sktrlmam uzunluk: %d';\n AbCompressionMethodFormatS = 'Sktrma Yntemi: %s';\n AbCompressionRatioFormatS = 'Sktrma Oran: %2.0f%%';\n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'Harici Dosya zellikleri: %s';\n AbIFAFormatS = 'Dosya Tr: %s';\n AbTextS = 'Text';\n AbBinaryS = 'Binary';\n AbEncryptionFormatS = 'ifreleme: %s';\n AbEncryptedS = 'ifrelenmi';\n AbNotEncryptedS = 'ifreli Deil';\n AbUnknownS = 'Bilinmiyor';\n AbTimeStampFormatS = 'Zaman Damgas: %s';\n AbMadeByFormatS = 'Srm Yapan: %f';\n AbNeededFormatS = 'Ayklamaya Gerekli Srm: %f';\n AbCommentFormatS = 'Aklama: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'PKZip Arivleri (*.zip)|*.zip|Kendinden Ayklanabilen Arivler (*.exe)|*.exe|Tm Dosyalar (*.*)|*.*';\n AbFileNameTitleS = 'Dosya Ad Se';\n\n AbOKS = 'Tamam';\n AbCancelS = 'Vazge';\n AbSelectDirectoryS = 'Klasr Se';\n\n AbEnterPasswordS = 'ifre Gir';\n AbPasswordS = 'i&fre';\n AbVerifyS = '&Dorula';\n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Kabin Arivleri (*.cab)|*.CAB|Tm Dosyalar (*.*)|*.*';\n AbLogExtS = '*.txt';\n AbLogFilterS = 'Metin Dosyalar (*.txt)|*.TXT|Tm Dosyalar (*.*)|*.*';\n AbExeExtS = '*.exe';\n AbExeFilterS = 'Kendinden-Ayklanabilen Zip Dosyalar (*.exe)|*.EXE|Tm Dosyalar (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = 'VMS: ok bayt okuma istei [%d]';\n AbVMSInvalidOriginS = 'VMS: %d kkeni geersiz. Geerli deerler 0, 1, 2 olmaldr';\n AbVMSErrorOpenSwapS = 'VMS: %s takas dosyas alamyor';\n AbVMSSeekFailS = 'VMS: %s takas dosyasnda arama baarsz oldu';\n AbVMSReadFailS = 'VMS: %d bayt %s takas dosyasndan okunurken baarsz oldu';\n AbVMSWriteFailS = 'VMS: %d bayt %s takas dosyasndan yazlrken baarsz oldu';\n AbVMSWriteTooManyBytesS = 'VMS: ok fazla bayt yazma istei [%d]';\n\n AbBBSReadTooManyBytesS = 'BBS: ok fazla bayt okuma istei [%d]';\n AbBBSSeekOutsideBufferS = 'BBS: Yeni konum arabellek dndadr';\n AbBBSInvalidOriginS = 'BBS: Geersiz Kken deeri';\n AbBBSWriteTooManyBytesS = 'BBS: ok fazla bayt yazma istei [%d]';\n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Akn sonunda deil';\n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: Arama baarsz oldu';\n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: Yazma baarsz oldu';\n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: Geersiz kken';\n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: Geersiz yeni konum';\n\n AbItemNameHeadingS = 'Ad';\n AbPackedHeadingS = 'Paketli';\n AbMethodHeadingS = 'Yntemi';\n AbRatioHeadingS = 'Oran (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Nitelikler';\n AbFileFormatHeadingS = 'Biim';\n AbEncryptionHeadingS = 'ifrelenmi';\n AbTimeStampHeadingS = 'Zaman Damgas';\n AbFileSizeHeadingS = 'Uzunluk';\n AbVersionMadeHeadingS = 'Srm Yapm';\n AbVersionNeededHeadingS = 'Srm Gerekli';\n AbPathHeadingS = 'Yolu';\n AbPartialHeadingS = 'Ksmi';\n AbExecutableHeadingS = 'altrlabilir';\n AbFileTypeHeadingS = 'Tr';\n AbLastModifiedHeadingS = 'Deitirilmi';\n\n AbCabMethod0S = 'None';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' eklendi ';\n AbLtDeleteS = ' silindi ';\n AbLtExtractS = ' aykland ';\n AbLtFreshenS = ' tazelendi ';\n AbLtMoveS = ' tand ';\n AbLtReplaceS = ' deitirildi ';\n AbLtStartS = ' gnlklendi ';\n\n AbGzipInvalidS = 'Geersiz Gzip';\n AbGzipBadCRCS = 'Bozuk CRC';\n AbGzipBadFileSizeS = 'Bozuk Dosya Uzunluu';\n\n AbTarInvalidS = 'Geersiz Tar';\n AbTarBadFileNameS = 'Dosya ad ok uzun';\n AbTarBadLinkNameS = 'ok uzun sembolik balant yolu';\n AbTarBadOpS = 'Desteklenmeyen Operasyon';\n\n AbUnhandledEntityS = 'lenmeyen Varlk';\n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'FAT Dosya Sistemi (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (veya OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'HPFS Dosya Sistemi (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'NTFS Dosya Sistemi (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISCOS';\n AbGzOsVFAT = 'VFAT Dosya Sistemi (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox veya PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'bilinmeyen';\n AbGzOsUndefined = 'gzip tarafndan tanmsz ID';\n\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Endeks araln dndadr';\n AbCmpndBusyUpdating = 'Bileik dosya gncelleme ile megul';\n AbCmpndInvalidFile = 'Geersiz bileik dosya';\n AbCmpndFileNotFound = 'Dosya/Klasr bulunamad';\n AbCmpndFolderNotEmpty = 'Klasr bo deil';\n AbCmpndExceedsMaxFileSize = 'Dosya boyutu izin verilen Azami deeri ayor';\n\nimplementation\n\nend."
},
{
"path": "lib/abbrevia/packages/Delphi XE/Abbrevia.dpk",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\npackage Abbrevia;\n\n{$R *.res}\n{$ALIGN 8}\n{$ASSERTIONS ON}\n{$BOOLEVAL OFF}\n{$DEBUGINFO OFF}\n{$EXTENDEDSYNTAX ON}\n{$IMPORTEDDATA ON}\n{$IOCHECKS ON}\n{$LOCALSYMBOLS OFF}\n{$LONGSTRINGS ON}\n{$OPENSTRINGS ON}\n{$OPTIMIZATION ON}\n{$OVERFLOWCHECKS OFF}\n{$RANGECHECKS OFF}\n{$REFERENCEINFO OFF}\n{$SAFEDIVIDE OFF}\n{$STACKFRAMES OFF}\n{$TYPEDADDRESS OFF}\n{$VARSTRINGCHECKS ON}\n{$WRITEABLECONST ON}\n{$MINENUMSIZE 1}\n{$IMAGEBASE $400000}\n{$DESCRIPTION 'Abbrevia Run-time package - RTL XE'}\n{$LIBSUFFIX '150'}\n{$RUNONLY}\n{$IMPLICITBUILD OFF}\n\nrequires\n rtl;\n\ncontains\n AbArcTyp in '..\\..\\source\\AbArcTyp.pas',\n AbBase in '..\\..\\source\\AbBase.pas',\n AbBitBkt in '..\\..\\source\\AbBitBkt.pas',\n AbBrowse in '..\\..\\source\\AbBrowse.pas',\n AbBzip2 in '..\\..\\source\\AbBzip2.pas',\n AbBzip2Typ in '..\\..\\source\\AbBzip2Typ.pas',\n AbCabExt in '..\\..\\source\\AbCabExt.pas',\n AbCabKit in '..\\..\\source\\AbCabKit.pas',\n AbCabMak in '..\\..\\source\\AbCabMak.pas',\n AbCabTyp in '..\\..\\source\\AbCabTyp.pas',\n AbCBrows in '..\\..\\source\\AbCBrows.pas',\n AbCharset in '..\\..\\source\\AbCharset.pas',\n AbConst in '..\\..\\source\\AbConst.pas',\n AbCrtl in '..\\..\\source\\AbCrtl.pas',\n AbDfBase in '..\\..\\source\\AbDfBase.pas',\n AbDfCryS in '..\\..\\source\\AbDfCryS.pas',\n AbDfDec in '..\\..\\source\\AbDfDec.pas',\n AbDfEnc in '..\\..\\source\\AbDfEnc.pas',\n AbDfHufD in '..\\..\\source\\AbDfHufD.pas',\n AbDfInW in '..\\..\\source\\AbDfInW.pas',\n AbDfOutW in '..\\..\\source\\AbDfOutW.pas',\n AbDfPkMg in '..\\..\\source\\AbDfPkMg.pas',\n AbDfStrm in '..\\..\\source\\AbDfStrm.pas',\n AbDfXlat in '..\\..\\source\\AbDfXlat.pas',\n AbExcept in '..\\..\\source\\AbExcept.pas',\n AbFciFdi in '..\\..\\source\\AbFciFdi.pas',\n AbGzTyp in '..\\..\\source\\AbGzTyp.pas',\n AbLzma in '..\\..\\source\\AbLzma.pas',\n AbPPMd in '..\\..\\source\\AbPPMd.pas',\n AbResString in '..\\..\\source\\AbResString.pas',\n AbSelfEx in '..\\..\\source\\AbSelfEx.pas',\n AbSpanSt in '..\\..\\source\\AbSpanSt.pas',\n AbSWStm in '..\\..\\source\\AbSWStm.pas',\n AbTarTyp in '..\\..\\source\\AbTarTyp.pas',\n AbUnzOutStm in '..\\..\\source\\AbUnzOutStm.pas',\n AbUnzper in '..\\..\\source\\AbUnzper.pas',\n AbUnzPrc in '..\\..\\source\\AbUnzPrc.pas',\n AbUtils in '..\\..\\source\\AbUtils.pas',\n AbVMStrm in '..\\..\\source\\AbVMStrm.pas',\n AbWavPack in '..\\..\\source\\AbWavPack.pas',\n AbZBrows in '..\\..\\source\\AbZBrows.pas',\n AbZipExt in '..\\..\\source\\AbZipExt.pas',\n AbZipKit in '..\\..\\source\\AbZipKit.pas',\n AbZipper in '..\\..\\source\\AbZipper.pas',\n AbZipPrc in '..\\..\\source\\AbZipPrc.pas',\n AbZipTyp in '..\\..\\source\\AbZipTyp.pas',\n AbZLTyp in '..\\..\\source\\AbZLTyp.pas';\n\nend.\n"
},
{
"path": "lib/abbrevia/packages/Delphi XE/Abbrevia.dproj",
"content": "\t\n\t\t\n\t\t\t{F41FD54F-C677-468D-B2F6-F7DEE8EEF36C}\n\t\t\tAbbrevia.dpk\n\t\t\tDebug\n\t\t\tDCC32\n\t\t\t12.2\n\t\t\tTrue\n\t\t\tWin32\n\t\t\tPackage\n\t\t\tNone\n\t\t\tWin32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t$(BDSCOMMONDIR)\\Bpl\n\t\t\tAbbrevia.bpl\n\t\t\tWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)\n\t\t\ttrue\n\t\t\tfalse\n\t\t\tAbbrevia Run-time package - RTL XE\n\t\t\ttrue\n\t\t\ttrue\n\t\t\ttrue\n\t\t\ttrue\n\t\t\t150\n\t\t\tfalse\n\t\t\t0\n\t\t\t00400000\n\t\t\tx86\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tPackage\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia.dpk\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tTrue\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t4\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia Components\n\t\t\t\t\t\t5.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\tCopyright (c) Abbrevia Group 2011\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia\n\t\t\t\t\t\t5.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tMicrosoft Office 2000 Sample Automation Server Wrapper Components\n\t\t\t\t\t\tMicrosoft Office XP Sample Automation Server Wrapper Components\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/packages/Delphi XE/AbbreviaVCL.dpk",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\npackage AbbreviaVCL;\n\n{$R *.res}\n{$ALIGN 8}\n{$ASSERTIONS ON}\n{$BOOLEVAL OFF}\n{$DEBUGINFO OFF}\n{$EXTENDEDSYNTAX ON}\n{$IMPORTEDDATA ON}\n{$IOCHECKS ON}\n{$LOCALSYMBOLS OFF}\n{$LONGSTRINGS ON}\n{$OPENSTRINGS ON}\n{$OPTIMIZATION ON}\n{$OVERFLOWCHECKS OFF}\n{$RANGECHECKS OFF}\n{$REFERENCEINFO OFF}\n{$SAFEDIVIDE OFF}\n{$STACKFRAMES OFF}\n{$TYPEDADDRESS OFF}\n{$VARSTRINGCHECKS ON}\n{$WRITEABLECONST ON}\n{$MINENUMSIZE 1}\n{$IMAGEBASE $400000}\n{$DESCRIPTION 'Abbrevia Run-time package - VCLXE'}\n{$LIBSUFFIX '150'}\n{$RUNONLY}\n{$IMPLICITBUILD OFF}\n\nrequires\n rtl,\n vcl,\n vclx,\n Abbrevia;\n\ncontains\n AbBseVCL in '..\\..\\source\\AbBseVCL.pas',\n AbMeter in '..\\..\\source\\AbMeter.pas',\n AbView in '..\\..\\source\\AbView.pas',\n AbZipOut in '..\\..\\source\\AbZipOut.pas',\n AbCView in '..\\..\\source\\AbCView.pas',\n AbZView in '..\\..\\source\\AbZView.pas',\n AbCompnd in '..\\..\\source\\AbCompnd.pas',\n AbHexVw in '..\\..\\source\\AbHexVw.pas',\n AbComCtrls in '..\\..\\source\\AbComCtrls.pas';\n\nend.\n"
},
{
"path": "lib/abbrevia/packages/Delphi XE/AbbreviaVCL.dproj",
"content": "\t\n\t\t\n\t\t\t{8F5900DA-6C2D-4EFA-96A5-D5AD0C68D886}\n\t\t\tAbbreviaVCL.dpk\n\t\t\tDebug\n\t\t\tDCC32\n\t\t\t12.2\n\t\t\tTrue\n\t\t\tWin32\n\t\t\tPackage\n\t\t\tVCL\n\t\t\tWin32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\tC:\\Users\\Public\\Documents\\RAD Studio\\7.0\\Bpl\\B305vr2010.bpl\n\t\t\tWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)\n\t\t\ttrue\n\t\t\tfalse\n\t\t\tAbbrevia Run-time package - VCLXE\n\t\t\ttrue\n\t\t\ttrue\n\t\t\ttrue\n\t\t\ttrue\n\t\t\t150\n\t\t\tfalse\n\t\t\t0\n\t\t\t00400000\n\t\t\tx86\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tPackage\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tAbbreviaVCL.dpk\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tTrue\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t4\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia Components\n\t\t\t\t\t\t5.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\tCopyright (c) Abbrevia Group\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia\n\t\t\t\t\t\t5.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/packages/Delphi XE/AbbreviaVCLDesign.dpk",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\npackage AbbreviaVCLDesign;\n\n{$R *.res}\n{$ALIGN 8}\n{$ASSERTIONS ON}\n{$BOOLEVAL OFF}\n{$DEBUGINFO OFF}\n{$EXTENDEDSYNTAX ON}\n{$IMPORTEDDATA ON}\n{$IOCHECKS ON}\n{$LOCALSYMBOLS OFF}\n{$LONGSTRINGS ON}\n{$OPENSTRINGS ON}\n{$OPTIMIZATION ON}\n{$OVERFLOWCHECKS OFF}\n{$RANGECHECKS OFF}\n{$REFERENCEINFO OFF}\n{$SAFEDIVIDE OFF}\n{$STACKFRAMES OFF}\n{$TYPEDADDRESS OFF}\n{$VARSTRINGCHECKS ON}\n{$WRITEABLECONST ON}\n{$MINENUMSIZE 1}\n{$IMAGEBASE $400000}\n{$DESCRIPTION 'Abbrevia Design-time package - VCLXE'}\n{$LIBSUFFIX '150'}\n{$DESIGNONLY}\n{$IMPLICITBUILD OFF}\n\nrequires\n designide,\n AbbreviaVCL;\n\ncontains\n AbPeCol in '..\\..\\source\\AbPeCol.pas',\n AbPeDir in '..\\..\\source\\AbPeDir.pas',\n AbPeFn in '..\\..\\source\\AbPeFn.pas',\n AbPePass in '..\\..\\source\\AbPePass.pas',\n AbPeVer in '..\\..\\source\\AbPeVer.pas',\n AbRegVcl in '..\\..\\source\\AbRegVcl.pas',\n AbDlgDir in '..\\..\\source\\AbDlgDir.pas' {DirDlg},\n AbDlgPwd in '..\\..\\source\\AbDlgPwd.pas' {PassWordDlg};\n\nend.\n"
},
{
"path": "lib/abbrevia/packages/Delphi XE/AbbreviaVCLDesign.dproj",
"content": "\t\n\t\t\n\t\t\t{24BE4180-8AB3-4667-927F-163D8C1A0D54}\n\t\t\tAbbreviaVCLDesign.dpk\n\t\t\tDebug\n\t\t\tDCC32\n\t\t\t12.2\n\t\t\tTrue\n\t\t\tWin32\n\t\t\tPackage\n\t\t\tNone\n\t\t\tWin32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t..\\..\\..\\..\\..\\..\\Public\\Documents\\RAD Studio\\7.0\\Bpl\\B305vd2010.bpl\n\t\t\ttrue\n\t\t\tAbbrevia Design-time package - VCLXE\n\t\t\tWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\t150\n\t\t\ttrue\n\t\t\ttrue\n\t\t\ttrue\n\t\t\tfalse\n\t\t\t0\n\t\t\t00400000\n\t\t\tx86\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\t0\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\tPackage\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tAbbreviaVCLDesign.dpk\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tTrue\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t4\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia Components\n\t\t\t\t\t\t5.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\tCopyright (c) Abbrevia Group\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia\n\t\t\t\t\t\t5.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/packages/Delphi XE.groupproj",
"content": "\t\n\t\t\n\t\t\t{3FC8294C-9FE8-49B9-9FF0-C33C59C18002}\n\t\t\n\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\tDefault.Personality.12\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\t\t\n\t\t\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/source/AbArcTyp.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbArcTyp.pas *}\n{*********************************************************}\n{* ABBREVIA: TABArchive, TABArchiveItem classes *}\n{*********************************************************}\n\nunit AbArcTyp;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n {$IFDEF MSWINDOWS}\n Windows,\n {$ENDIF MSWINDOWS}\n Classes,\n Types,\n AbUtils;\n\n{ ===== TAbArchiveItem ====================================================== }\ntype\n TAbArchiveItem = class(TObject)\n protected {private}\n NextItem : TAbArchiveItem;\n FAction : TAbArchiveAction;\n FCompressedSize : Int64;\n FCRC32 : Longint;\n FDiskFileName : string;\n FExternalFileAttributes : LongWord;\n FFileName : string;\n FIsEncrypted : Boolean;\n FLastModFileTime : Word;\n FLastModFileDate : Word;\n FTagged : Boolean;\n FUncompressedSize : Int64;\n\n protected {property methods}\n function GetCompressedSize : Int64; virtual;\n function GetCRC32 : Longint; virtual;\n function GetDiskPath : string;\n function GetExternalFileAttributes : LongWord; virtual;\n function GetFileName : string; virtual;\n function GetIsDirectory: Boolean; virtual;\n function GetIsEncrypted : Boolean; virtual;\n function GetLastModFileDate : Word; virtual;\n function GetLastModFileTime : Word; virtual;\n function GetNativeFileAttributes : LongInt; virtual;\n function GetStoredPath : string;\n function GetUncompressedSize : Int64; virtual;\n procedure SetCompressedSize(const Value : Int64); virtual;\n procedure SetCRC32(const Value : Longint); virtual;\n procedure SetExternalFileAttributes( Value : LongWord ); virtual;\n procedure SetFileName(const Value : string); virtual;\n procedure SetIsEncrypted(Value : Boolean); virtual;\n procedure SetLastModFileDate(const Value : Word); virtual;\n procedure SetLastModFileTime(const Value : Word); virtual;\n procedure SetUncompressedSize(const Value : Int64); virtual;\n function GetLastModTimeAsDateTime: TDateTime; virtual;\n procedure SetLastModTimeAsDateTime(const Value: TDateTime); virtual;\n\n public {methods}\n constructor Create;\n destructor Destroy; override;\n function MatchesDiskName(const FileMask : string) : Boolean;\n function MatchesStoredName(const FileMask : string) : Boolean;\n function MatchesStoredNameEx(const FileMask : string) : Boolean;\n\n\n public {properties}\n property Action : TAbArchiveAction\n read FAction\n write FAction;\n property CompressedSize : Int64\n read GetCompressedSize\n write SetCompressedSize;\n property CRC32 : Longint\n read GetCRC32\n write SetCRC32;\n property DiskFileName : string\n read FDiskFileName\n write FDiskFileName;\n property DiskPath : string\n read GetDiskPath;\n property ExternalFileAttributes : LongWord\n read GetExternalFileAttributes\n write SetExternalFileAttributes;\n property FileName : string\n read GetFileName\n write SetFileName;\n property IsDirectory: Boolean\n read GetIsDirectory;\n property IsEncrypted : Boolean\n read GetIsEncrypted\n write SetIsEncrypted;\n property LastModFileDate : Word\n read GetLastModFileDate\n write SetLastModFileDate;\n property LastModFileTime : Word\n read GetLastModFileTime\n write SetLastModFileTime;\n property NativeFileAttributes : LongInt\n read GetNativeFileAttributes;\n property StoredPath : string\n read GetStoredPath;\n property Tagged : Boolean\n read FTagged\n write FTagged;\n property UncompressedSize : Int64\n read GetUncompressedSize\n write SetUncompressedSize;\n\n property LastModTimeAsDateTime : TDateTime\n read GetLastModTimeAsDateTime\n write SetLastModTimeAsDateTime;\n end;\n\n\n{ ===== TAbArchiveListEnumerator ============================================ }\ntype\n TAbArchiveList = class;\n TAbArchiveListEnumerator = class\n private\n FIndex: Integer;\n FList: TAbArchiveList;\n public\n constructor Create(aList: TAbArchiveList);\n function GetCurrent: TAbArchiveItem;\n function MoveNext: Boolean;\n property Current: TAbArchiveItem read GetCurrent;\n end;\n\n\n{ ===== TAbArchiveList ====================================================== }\n\n TAbArchiveList = class\n protected {private}\n FList : TList;\n FOwnsItems: Boolean;\n HashTable : array[0..1020] of TAbArchiveItem;\n protected {methods}\n function GenerateHash(const S : string) : LongInt;\n function GetCount : Integer;\n function Get(Index : Integer) : TAbArchiveItem;\n procedure Put(Index : Integer; Item : TAbArchiveItem);\n procedure UpdateHash(aItem: TAbArchiveItem; const aOldFileName: string);\n public {methods}\n constructor Create(AOwnsItems: Boolean);\n destructor Destroy; override;\n function Add(aItem : TAbArchiveItem): Integer;\n procedure Clear;\n procedure Delete(Index : Integer);\n function Find(const FN : string) : Integer;\n function GetEnumerator: TAbArchiveListEnumerator;\n function IsActiveDupe(const FN : string) : Boolean;\n public {properties}\n property Count : Integer\n read GetCount;\n property Items[Index : Integer] : TAbArchiveItem\n read Get\n write Put; default;\n end;\n\n\n{ ===== TAbArchive specific types =========================================== }\ntype\n TAbStoreOption =\n (soStripDrive, soStripPath, soRemoveDots, soRecurse, soFreshen, soReplace);\n TAbStoreOptions =\n set of TAbStoreOption;\n\n TAbExtractOption =\n (eoCreateDirs, eoRestorePath);\n TAbExtractOptions =\n set of TAbExtractOption;\n\n TAbArchiveStatus =\n (asInvalid, asIdle, asBusy);\n\n TAbArchiveEvent =\n procedure(Sender : TObject) of object;\n TAbArchiveConfirmEvent =\n procedure (Sender : TObject; var Confirm : Boolean) of object;\n TAbArchiveProgressEvent =\n procedure(Sender : TObject; Progress : Byte; var Abort : Boolean) of object;\n TAbArchiveItemEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem) of object;\n TAbArchiveItemConfirmEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem;\n ProcessType : TAbProcessType; var Confirm : Boolean) of object;\n TAbConfirmOverwriteEvent =\n procedure(var Name : string; var Confirm : Boolean) of object;\n TAbArchiveItemFailureEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem;\n ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;\n ErrorCode : Integer) of object;\n TAbArchiveItemExtractEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem;\n const NewName : string) of object;\n TAbArchiveItemExtractToStreamEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream) of object;\n TAbArchiveItemTestEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem) of object;\n TAbArchiveItemInsertEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream) of object;\n TAbArchiveItemInsertFromStreamEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem;\n OutStream, InStream : TStream) of object;\n TAbArchiveItemProgressEvent =\n procedure(Sender : TObject; Item : TAbArchiveItem; Progress : Byte;\n var Abort : Boolean) of object;\n TAbProgressEvent =\n procedure(Progress : Byte; var Abort : Boolean) of object;\n TAbRequestDiskEvent =\n procedure(Sender : TObject; var Abort : Boolean) of object;\n TAbRequestImageEvent =\n procedure(Sender : TObject; ImageNumber : Integer;\n var ImageName : string; var Abort : Boolean) of object;\n TAbRequestNthDiskEvent =\n procedure(Sender : TObject; DiskNumber : Byte; var Abort : Boolean) of object;\n\n\ntype\n TAbArchiveStreamHelper = class\n protected\n FStream : TStream;\n public\n constructor Create(AStream : TStream);\n procedure ExtractItemData(AStream : TStream); virtual; abstract;\n function FindFirstItem : Boolean; virtual; abstract;\n function FindNextItem : Boolean; virtual; abstract;\n procedure ReadHeader; virtual; abstract;\n procedure ReadTail; virtual; abstract;\n function SeekItem(Index : Integer): Boolean; virtual; abstract;\n procedure WriteArchiveHeader; virtual; abstract;\n procedure WriteArchiveItem(AStream : TStream); virtual; abstract;\n procedure WriteArchiveTail; virtual; abstract;\n function GetItemCount : Integer; virtual; abstract;\n end;\n\n\n{ ===== TAbArchive ========================================================== }\ntype\n TAbArchive = class(TObject)\n public\n FStream : TStream;\n FStatus : TAbArchiveStatus;\n\n protected {property variables} //These break Encapsulation\n FArchiveName : string;\n FAutoSave : Boolean;\n FBaseDirectory : string;\n FCurrentItem : TAbArchiveItem;\n FDOSMode : Boolean;\n FExtractOptions : TAbExtractOptions;\n FImageNumber : Word;\n FInStream : TStream;\n FIsDirty : Boolean;\n FSpanningThreshold : Int64;\n FItemList : TAbArchiveList;\n FLogFile : string;\n FLogging : Boolean;\n FLogStream : TFileStream;\n FMode : Word;\n FOwnsStream : Boolean;\n FSpanned : Boolean;\n FStoreOptions : TAbStoreOptions;\n FTempDir : string;\n\n protected {event variables}\n FOnProcessItemFailure : TAbArchiveItemFailureEvent;\n FOnArchiveProgress : TAbArchiveProgressEvent;\n FOnArchiveSaveProgress : TAbArchiveProgressEvent;\n FOnArchiveItemProgress : TAbArchiveItemProgressEvent;\n FOnConfirmProcessItem : TAbArchiveItemConfirmEvent;\n FOnConfirmOverwrite : TAbConfirmOverwriteEvent;\n FOnConfirmSave : TAbArchiveConfirmEvent;\n FOnLoad : TAbArchiveEvent;\n FOnProgress : TAbProgressEvent;\n FOnRequestImage : TAbRequestImageEvent;\n FOnSave : TAbArchiveEvent;\n\n protected {methods}\n constructor CreateInit;\n procedure CheckValid;\n function ConfirmPath(Item : TAbArchiveItem; const NewName : string;\n out UseName : string) : Boolean;\n procedure FreshenAt(Index : Integer);\n function FreshenRequired(Item : TAbArchiveItem) : Boolean;\n procedure GetFreshenTarget(Item : TAbArchiveItem);\n function GetItemCount : Integer;\n procedure MakeLogEntry(const FN: string; LT : TAbLogType);\n procedure ReplaceAt(Index : Integer);\n procedure SaveIfNeeded(aItem : TAbArchiveItem);\n procedure SetBaseDirectory(Value : string);\n procedure SetLogFile(const Value : string);\n procedure SetLogging(Value : Boolean);\n\n protected {abstract methods}\n function CreateItem(const FileSpec : string): TAbArchiveItem;\n virtual; abstract;\n procedure ExtractItemAt(Index : Integer; const UseName : string);\n virtual; abstract;\n procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);\n virtual; abstract;\n procedure LoadArchive;\n virtual; abstract;\n procedure SaveArchive;\n virtual; abstract;\n procedure TestItemAt(Index : Integer);\n virtual; abstract;\n\n protected {virtual methods}\n procedure DoProcessItemFailure(Item : TAbArchiveItem;\n ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;\n ErrorCode : Integer);\n virtual;\n procedure DoArchiveSaveProgress(Progress : Byte; var Abort : Boolean);\n virtual;\n procedure DoArchiveProgress(Progress : Byte; var Abort : Boolean);\n virtual;\n procedure DoArchiveItemProgress(Item : TAbArchiveItem; Progress : Byte;\n var Abort : Boolean);\n virtual;\n procedure DoConfirmOverwrite(var FileName : string; var Confirm : Boolean);\n virtual;\n procedure DoConfirmProcessItem(Item : TAbArchiveItem;\n const ProcessType : TAbProcessType; var Confirm : Boolean);\n virtual;\n procedure DoConfirmSave(var Confirm : Boolean);\n virtual;\n\n procedure DoLoad;\n virtual;\n procedure DoProgress(Progress : Byte; var Abort : Boolean);\n virtual;\n procedure DoSave;\n virtual;\n function FixName(const Value : string) : string;\n virtual;\n function GetSpanningThreshold : Int64;\n virtual;\n function GetSupportsEmptyFolders : Boolean;\n virtual;\n procedure SetSpanningThreshold( Value : Int64 );\n virtual;\n\n protected {properties and events}\n property InStream : TStream\n read FInStream;\n\n public {methods}\n constructor Create(const FileName : string; Mode : Word);\n virtual;\n constructor CreateFromStream(aStream : TStream; const aArchiveName : string);\n virtual;\n destructor Destroy;\n override;\n procedure Add(aItem : TAbArchiveItem);\n virtual;\n procedure AddFiles(const FileMask : string; SearchAttr : Integer);\n procedure AddFilesEx(const FileMask, ExclusionMask : string;\n SearchAttr : Integer);\n procedure AddFromStream(const NewName : string; aStream : TStream);\n procedure ClearTags;\n procedure Delete(aItem : TAbArchiveItem);\n procedure DeleteAt(Index : Integer);\n procedure DeleteFiles(const FileMask : string);\n procedure DeleteFilesEx(const FileMask, ExclusionMask : string);\n procedure DeleteTaggedItems;\n procedure Extract(aItem : TAbArchiveItem; const NewName : string);\n procedure ExtractAt(Index : Integer; const NewName : string);\n procedure ExtractFiles(const FileMask : string);\n procedure ExtractFilesEx(const FileMask, ExclusionMask : string);\n procedure ExtractTaggedItems;\n procedure ExtractToStream(const aFileName : string; aStream : TStream);\n function FindFile(const aFileName : string): Integer;\n function FindItem(aItem : TAbArchiveItem): Integer;\n procedure Freshen(aItem : TAbArchiveItem);\n procedure FreshenFiles(const FileMask : string);\n procedure FreshenFilesEx(const FileMask, ExclusionMask : string);\n procedure FreshenTaggedItems;\n procedure Load; virtual;\n procedure Move(aItem : TAbArchiveItem; const NewStoredPath : string);\n virtual;\n procedure Replace(aItem : TAbArchiveItem);\n procedure Save;\n virtual;\n procedure TagItems(const FileMask : string);\n procedure TestTaggedItems;\n procedure UnTagItems(const FileMask : string);\n\n\n procedure DoDeflateProgress(aPercentDone : integer);\n virtual;\n procedure DoInflateProgress(aPercentDone : integer);\n virtual;\n procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer;\n var ImageName : string; var Abort : Boolean); virtual;\n public {properties}\n property OnProgress : TAbProgressEvent\n read FOnProgress write FOnProgress;\n property ArchiveName : string\n read FArchiveName;\n property AutoSave : Boolean\n read FAutoSave\n write FAutoSave;\n property BaseDirectory : string\n read FBaseDirectory\n write SetBaseDirectory;\n property Count : Integer\n read GetItemCount;\n property DOSMode : Boolean\n read FDOSMode\n write FDOSMode;\n property ExtractOptions : TAbExtractOptions\n read FExtractOptions\n write FExtractOptions;\n property IsDirty : Boolean\n read FIsDirty\n write FIsDirty;\n property ItemList : TAbArchiveList\n read FItemList;\n property LogFile : string\n read FLogFile\n write SetLogFile;\n property Logging : Boolean\n read FLogging\n write SetLogging;\n property Mode : Word\n read FMode;\n property Spanned : Boolean\n read FSpanned;\n property SpanningThreshold : Int64\n read GetSpanningThreshold\n write SetSpanningThreshold;\n property Status : TAbArchiveStatus\n read FStatus;\n property StoreOptions : TAbStoreOptions\n read FStoreOptions\n write FStoreOptions;\n property SupportsEmptyFolders : Boolean\n read GetSupportsEmptyFolders;\n property TempDirectory : string\n read FTempDir\n write FTempDir;\n\n public {events}\n property OnProcessItemFailure : TAbArchiveItemFailureEvent\n read FOnProcessItemFailure\n write FOnProcessItemFailure;\n property OnArchiveProgress : TAbArchiveProgressEvent\n read FOnArchiveProgress\n write FOnArchiveProgress;\n property OnArchiveSaveProgress : TAbArchiveProgressEvent\n read FOnArchiveSaveProgress\n write FOnArchiveSaveProgress;\n property OnArchiveItemProgress : TAbArchiveItemProgressEvent\n read FOnArchiveItemProgress\n write FOnArchiveItemProgress;\n property OnConfirmProcessItem : TAbArchiveItemConfirmEvent\n read FOnConfirmProcessItem\n write FOnConfirmProcessItem;\n property OnConfirmOverwrite : TAbConfirmOverwriteEvent\n read FOnConfirmOverwrite\n write FOnConfirmOverwrite;\n property OnConfirmSave : TAbArchiveConfirmEvent\n read FOnConfirmSave\n write FOnConfirmSave;\n property OnLoad : TAbArchiveEvent\n read FOnLoad\n write FOnLoad;\n property OnRequestImage : TAbRequestImageEvent\n read FOnRequestImage\n write FOnRequestImage;\n property OnSave : TAbArchiveEvent\n read FOnSave\n write FOnSave;\n end;\n\n\n{ ===== TAbExtraField ======================================================= }\ntype\n PAbExtraSubField = ^TAbExtraSubField;\n TAbExtraSubField = packed record\n ID : Word;\n Len : Word;\n Data : record end;\n end;\n\n TAbExtraField = class\n private {fields}\n FBuffer : TByteDynArray;\n private {methods}\n procedure DeleteField(aSubField : PAbExtraSubField);\n function FindField(aID : Word; out aSubField : PAbExtraSubField) : Boolean;\n function FindNext(var aCurField : PAbExtraSubField) : Boolean;\n function GetCount : Integer;\n function GetID(aIndex : Integer): Word;\n procedure SetBuffer(const aValue : TByteDynArray);\n protected {methods}\n procedure Changed; virtual;\n public {methods}\n procedure Assign(aSource : TAbExtraField);\n procedure Clear;\n procedure CloneFrom(aSource : TAbExtraField; aID : Word);\n procedure Delete(aID : Word);\n function Get(aID : Word; out aData : Pointer; out aDataSize : Word) : Boolean;\n function GetStream(aID : Word; out aStream : TStream): Boolean;\n function Has(aID : Word): Boolean;\n procedure LoadFromStream(aStream : TStream; aSize : Word);\n procedure Put(aID : Word; const aData; aDataSize : Word);\n public {properties}\n property Count : Integer\n read GetCount;\n property Buffer : TByteDynArray\n read FBuffer\n write SetBuffer;\n property IDs[aIndex : Integer]: Word\n read GetID;\n end;\n\n\nconst\n AbDefAutoSave = False;\n AbDefExtractOptions = [eoCreateDirs];\n AbDefStoreOptions = [soStripDrive, soRemoveDots];\n AbBufferSize = 32768;\n AbLastDisk = -1;\n AbLastImage = -1;\n\nimplementation\n\n{.$R ABRES.R32}\n\nuses\n RTLConsts,\n SysUtils,\n AbExcept,\n AbDfBase,\n AbConst,\n AbResString;\n\n\n{ TAbArchiveItem implementation ============================================ }\n{ TAbArchiveItem }\nconstructor TAbArchiveItem.Create;\nbegin\n inherited Create;\n FCompressedSize := 0;\n FUncompressedSize := 0;\n FFileName := '';\n FAction := aaNone;\n FLastModFileTime := 0;\n FLastModFileDate := 0;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbArchiveItem.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetCompressedSize : Int64;\nbegin\n Result := FCompressedSize;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetCRC32 : LongInt;\nbegin\n Result := FCRC32;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetDiskPath : string;\nbegin\n Result := ExtractFilePath(DiskFileName);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetExternalFileAttributes : LongWord;\nbegin\n Result := FExternalFileAttributes;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetFileName : string;\nbegin\n Result := FFileName;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetIsDirectory: Boolean;\nbegin\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetIsEncrypted : Boolean;\nbegin\n Result := FIsEncrypted;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetLastModFileTime : Word;\nbegin\n Result := FLastModFileTime;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetLastModFileDate : Word;\nbegin\n Result := FLastModFileDate;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetNativeFileAttributes : LongInt;\nbegin\n {$IFDEF MSWINDOWS}\n if IsDirectory then\n Result := faDirectory\n else\n Result := 0;\n {$ENDIF}\n {$IFDEF UNIX}\n if IsDirectory then\n Result := AB_FPERMISSION_GENERIC or AB_FPERMISSION_OWNEREXECUTE\n else\n Result := AB_FPERMISSION_GENERIC;\n {$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetStoredPath : string;\nbegin\n Result := ExtractFilePath(DiskFileName);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetUnCompressedSize : Int64;\nbegin\n Result := FUnCompressedSize;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.MatchesDiskName(const FileMask : string) : Boolean;\nvar\n DiskName, Mask : string;\nbegin\n DiskName := DiskFileName;\n AbUnfixName(DiskName);\n Mask := FileMask;\n AbUnfixName(Mask);\n Result := AbFileMatch(DiskName, Mask);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.MatchesStoredName(const FileMask : string) : Boolean;\nvar\n Value : string;\n Drive, Dir, Name : string;\nbegin\n Value := FileMask;\n AbUnfixName(Value);\n AbParseFileName(Value, Drive, Dir, Name);\n Value := Dir + Name;\n Name := FileName;\n AbUnfixName(Name);\n if IsDirectory then\n Name := ExcludeTrailingPathDelimiter(Name);\n Result := AbFileMatch(Name, Value);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.MatchesStoredNameEx(const FileMask : string) : Boolean;\nvar\n I, J: Integer;\n MaskPart: string;\nbegin\n Result := True;\n I := 1;\n while I <= Length(FileMask) do begin\n J := I;\n while (I <= Length(FileMask)) and (FileMask[I] <> PathSep {';'}) do Inc(I);\n MaskPart := Trim(Copy(FileMask, J, I - J));\n if (I <= Length(FileMask)) and (FileMask[I] = PathSep {';'}) then Inc(I);\n\n if MatchesStoredName(MaskPart) then Exit;\n end;\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetCompressedSize(const Value : Int64);\nbegin\n FCompressedSize := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetCRC32(const Value : LongInt);\nbegin\n FCRC32 := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetExternalFileAttributes( Value : LongWord );\nbegin\n FExternalFileAttributes := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetFileName(const Value : string);\nbegin\n FFileName := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetIsEncrypted(Value : Boolean);\nbegin\n FIsEncrypted := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetLastModFileDate(const Value : Word);\nbegin\n FLastModFileDate := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetLastModFileTime(const Value : Word);\nbegin\n FLastModFileTime := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetUnCompressedSize(const Value : Int64);\nbegin\n FUnCompressedSize := Value;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveItem.GetLastModTimeAsDateTime: TDateTime;\nbegin\n Result := AbDosFileDateToDateTime(LastModFileDate, LastModFileTime);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveItem.SetLastModTimeAsDateTime(const Value: TDateTime);\nvar\n FileDate : Integer;\nbegin\n FileDate := AbDateTimeToDosFileDate(Value);\n LastModFileTime := LongRec(FileDate).Lo;\n LastModFileDate := LongRec(FileDate).Hi;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbArchiveEnumeratorList implementation ================================== }\n{ TAbArchiveEnumeratorList }\nconstructor TAbArchiveListEnumerator.Create(aList: TAbArchiveList);\nbegin\n inherited Create;\n FIndex := -1;\n FList := aList;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveListEnumerator.GetCurrent: TAbArchiveItem;\nbegin\n Result := FList[FIndex];\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveListEnumerator.MoveNext: Boolean;\nbegin\n Result := FIndex < FList.Count - 1;\n if Result then\n Inc(FIndex);\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbArchiveList implementation ============================================ }\n\n{ TAbArchiveList }\nconstructor TAbArchiveList.Create(AOwnsItems: Boolean);\nbegin\n inherited Create;\n FList := TList.Create;\n FOwnsItems := AOwnsItems;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbArchiveList.Destroy;\nbegin\n Clear;\n FList.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveList.Add(aItem : TAbArchiveItem) : Integer;\nvar\n H : LongInt;\nbegin\n if FOwnsItems then begin\n H := GenerateHash(aItem.FileName);\n aItem.NextItem := HashTable[H];\n HashTable[H] := aItem;\n end;\n Result := FList.Add(aItem);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveList.Clear;\nvar\n i : Integer;\nbegin\n if FOwnsItems then\n for i := 0 to Count - 1 do\n TObject(FList[i]).Free;\n FList.Clear;\n FillChar(HashTable, SizeOf(HashTable), #0);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveList.Delete(Index: Integer);\nvar\n Look : TAbArchiveItem;\n Last : ^TAbArchiveItem;\n FN : string;\nbegin\n if FOwnsItems then begin\n FN := TAbArchiveItem(FList[Index]).FileName;\n Last := @HashTable[GenerateHash(FN)];\n Look := Last^;\n while Look <> nil do begin\n if CompareText(Look.FileName, FN) = 0 then begin\n Last^ := Look.NextItem;\n Break;\n end;\n Last := @Look.NextItem;\n Look := Last^;\n end;\n TObject(FList[Index]).Free;\n end;\n FList.Delete(Index);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveList.Find(const FN : string) : Integer;\nvar\n Look : TAbArchiveItem;\n I : Integer;\nbegin\n if FOwnsItems then begin\n Look := HashTable[GenerateHash(FN)];\n while Look <> nil do begin\n if CompareText(Look.FileName, FN) = 0 then begin\n Result := FList.IndexOf(Look);\n Exit;\n end;\n Look := Look.NextItem;\n end;\n end\n else begin\n for I := 0 to FList.Count - 1 do\n if CompareText(Items[I].FileName, FN) = 0 then begin\n Result := I;\n Exit;\n end;\n end;\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFOPT Q+}{$DEFINE OVERFLOW_CHECKS_ON}{$Q-}{$ENDIF}\nfunction TAbArchiveList.GenerateHash(const S : string) : LongInt;\nvar\n G : LongInt;\n I : Integer;\n U : string;\nbegin\n Result := 0;\n U := AnsiUpperCase(S);\n for I := 1 to Length(U) do begin\n Result := (Result shl 4) + Ord(U[I]);\n G := LongInt(Result and $F0000000);\n if (G <> 0) then\n Result := Result xor (G shr 24);\n Result := Result and (not G);\n end;\n Result := Result mod 1021;\nend;\n{$IFDEF OVERFLOW_CHECKS_ON}{$Q+}{$ENDIF}\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveList.Get(Index : Integer): TAbArchiveItem;\nbegin\n Result := TAbArchiveItem(FList[Index]);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveList.GetCount : Integer;\nbegin\n Result := FList.Count;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveList.GetEnumerator: TAbArchiveListEnumerator;\nbegin\n Result := TAbArchiveListEnumerator.Create(Self);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchiveList.IsActiveDupe(const FN : string) : Boolean;\nvar\n Look : TAbArchiveItem;\n I : Integer;\nbegin\n if FOwnsItems then begin\n Look := HashTable[GenerateHash(FN)];\n while Look <> nil do begin\n if (CompareText(Look.FileName, FN) = 0) and\n (Look.Action <> aaDelete) then begin\n Result := True;\n Exit;\n end;\n Look := Look.NextItem;\n end;\n end\n else begin\n for I := 0 to Count - 1 do\n if (CompareText(Items[I].FileName, FN) = 0) and\n (Items[I].Action <> aaDelete) then begin\n Result := True;\n Exit;\n end;\n end;\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveList.Put(Index : Integer; Item : TAbArchiveItem);\nvar\n H : LongInt;\n Look : TAbArchiveItem;\n Last : ^TAbArchiveItem;\n FN : string;\nbegin\n if FOwnsItems then begin\n FN := TAbArchiveItem(FList[Index]).FileName;\n Last := @HashTable[GenerateHash(FN)];\n Look := Last^;\n { Delete old index }\n while Look <> nil do begin\n if CompareText(Look.FileName, FN) = 0 then begin\n Last^ := Look.NextItem;\n Break;\n end;\n Last := @Look.NextItem;\n Look := Last^;\n end;\n { Free old instance }\n TObject(FList[Index]).Free;\n { Add new index }\n H := GenerateHash(Item.FileName);\n Item.NextItem := HashTable[H];\n HashTable[H] := Item;\n end;\n { Replace pointer }\n FList[Index] := Item;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchiveList.UpdateHash(aItem: TAbArchiveItem;\n const aOldFileName: string);\nvar\n H : LongInt;\n Last : ^TAbArchiveItem;\n Look : TAbArchiveItem;\nbegin\n if FOwnsItems then begin\n { Remove from old hash position }\n Last := @HashTable[GenerateHash(aOldFileName)];\n Look := Last^;\n while Look <> nil do begin\n if Look = aItem then begin\n Last^ := Look.NextItem;\n Break\n end;\n Last := @Look.NextItem;\n Look := Last^\n end;\n { Add to new hash position }\n H := GenerateHash(aItem.FileName);\n aItem.NextItem := HashTable[H];\n HashTable[H] := aItem\n end;\nend;\n\n\n{ TAbArchive implementation ================================================ }\n{ TAbArchive }\nconstructor TAbArchive.CreateInit;\nbegin\n inherited Create;\n FIsDirty := False;\n FAutoSave := False;\n FItemList := TAbArchiveList.Create(True);\n StoreOptions := [];\n ExtractOptions := [];\n FStatus := asIdle;\n FOnProgress := DoProgress;\n BaseDirectory := ExtractFilePath(ParamStr(0));\nend;\n{ -------------------------------------------------------------------------- }\nconstructor TAbArchive.Create(const FileName : string; Mode : Word);\n {create an archive by opening a filestream on filename with the given mode}\nbegin\n FOwnsStream := True;\n CreateFromStream(TFileStream.Create(FileName, Mode), FileName);\n FMode := Mode;\nend;\n{ -------------------------------------------------------------------------- }\nconstructor TAbArchive.CreateFromStream(aStream : TStream; const aArchiveName : string);\n {create an archive based on an existing stream}\nbegin\n CreateInit;\n FArchiveName := aArchiveName;\n FStream := aStream;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbArchive.Destroy;\nbegin\n FItemList.Free;\n if FOwnsStream then\n FStream.Free;\n FLogStream.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Add(aItem : TAbArchiveItem);\nvar\n Confirm, ItemAdded : Boolean;\nbegin\n ItemAdded := False;\n try\n CheckValid;\n if FItemList.IsActiveDupe(aItem.FileName) then begin\n if (soFreshen in StoreOptions) then\n Freshen(aItem)\n else if (soReplace in StoreOptions) then\n Replace(aItem)\n else\n DoProcessItemFailure(aItem, ptAdd, ecAbbrevia, AbDuplicateName);\n Exit;\n end;\n DoConfirmProcessItem(aItem, ptAdd, Confirm);\n if not Confirm then\n Exit;\n aItem.Action := aaAdd;\n FItemList.Add(aItem);\n ItemAdded := True;\n FIsDirty := True;\n if AutoSave then\n Save;\n finally\n if not ItemAdded then\n aItem.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.AddFiles(const FileMask : string; SearchAttr : Integer);\n {Add files to the archive where the disk filespec matches}\nbegin\n AddFilesEx(FileMask, '', SearchAttr);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.AddFilesEx(const FileMask, ExclusionMask : string;\n SearchAttr : Integer);\n {Add files matching Filemask except those matching ExclusionMask}\nvar\n PathType : TAbPathType;\n IsWild : Boolean;\n SaveDir : string;\n Mask : string;\n MaskF : string;\n\n procedure CreateItems(Wild, Recursing : Boolean);\n var\n i : Integer;\n Files : TStrings;\n FilterList : TStringList;\n Item : TAbArchiveItem;\n begin\n FilterList := TStringList.Create;\n try\n if (MaskF <> '') then\n AbFindFilesEx(MaskF, SearchAttr, FilterList, Recursing);\n\n Files := TStringList.Create;\n try\n\n AbFindFilesEx(Mask, SearchAttr, Files, Recursing);\n if (Files.Count > 0) then\n for i := 0 to pred(Files.Count) do\n if FilterList.IndexOf(Files[i]) < 0 then\n if not Wild then begin\n if (Files[i] <> FArchiveName) then begin\n Item := CreateItem(Files[i]);\n Add(Item);\n end;\n end else begin\n if (AbAddBackSlash(FBaseDirectory) + Files[i]) <> FArchiveName\n then begin\n Item := CreateItem(Files[i]);\n Add(Item);\n end;\n end;\n finally\n Files.Free;\n end;\n\n finally\n FilterList.Free;\n end;\n end;\n\nbegin\n if not SupportsEmptyFolders then\n SearchAttr := SearchAttr and not faDirectory;\n\n CheckValid;\n IsWild := (Pos('*', FileMask) > 0) or (Pos('?', FileMask) > 0);\n PathType := AbGetPathType(FileMask);\n\n Mask := FileMask;\n AbUnfixName(Mask);\n MaskF := ExclusionMask;\n AbUnfixName(MaskF);\n\n case PathType of\n ptNone, ptRelative :\n begin\n GetDir(0, SaveDir);\n if BaseDirectory <> '' then\n ChDir(BaseDirectory);\n try\n CreateItems(IsWild, soRecurse in StoreOptions);\n finally\n if BaseDirectory <> '' then\n ChDir(SaveDir);\n end;\n end;\n ptAbsolute :\n begin\n CreateItems(IsWild, soRecurse in StoreOptions);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.AddFromStream(const NewName : string; aStream : TStream);\n {Add an item to the archive directly from a TStream descendant}\nvar\n Confirm : Boolean;\n Item : TAbArchiveItem;\n PT : TAbProcessType; \nbegin\n Item := CreateItem(NewName);\n CheckValid;\n\n PT := ptAdd;\n if FItemList.IsActiveDupe(NewName) then begin\n if ((soFreshen in StoreOptions) or (soReplace in StoreOptions)) then begin\n Item.Free;\n Item := FItemList[FItemList.Find(NewName)];\n PT := ptReplace;\n end else begin\n DoProcessItemFailure(Item, ptAdd, ecAbbrevia, AbDuplicateName);\n Item.Free;\n Exit;\n end;\n end;\n DoConfirmProcessItem(Item, PT, Confirm);\n\n if not Confirm then\n Exit;\n\n FInStream := aStream;\n Item.Action := aaStreamAdd;\n if (PT = ptAdd) then\n FItemList.Add(Item);\n FIsDirty := True;\n Save;\n FInStream := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.CheckValid;\nbegin\n if Status = asInvalid then\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ClearTags;\n {Clear all tags from the archive}\nvar\n i : Integer;\nbegin\n if Count > 0 then\n for i := 0 to pred(Count) do\n TAbArchiveItem(FItemList[i]).Tagged := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.ConfirmPath(Item : TAbArchiveItem; const NewName : string;\n out UseName : string) : Boolean;\nvar\n Path : string;\nbegin\n if Item.IsDirectory and not (ExtractOptions >= [eoRestorePath, eoCreateDirs]) then begin\n Result := False;\n Exit;\n end;\n if (NewName = '') then begin\n UseName := Item.FileName;\n AbUnfixName(UseName);\n if Item.IsDirectory then\n UseName := ExcludeTrailingPathDelimiter(UseName);\n if (not (eoRestorePath in ExtractOptions)) then\n UseName := ExtractFileName(UseName);\n end\n else\n UseName := NewName;\n if (AbGetPathType(UseName) <> ptAbsolute) then\n UseName := AbAddBackSlash(BaseDirectory) + UseName;\n\n Path := ExtractFileDir(UseName);\n if (Path <> '') and not DirectoryExists(Path) then\n if (eoCreateDirs in ExtractOptions) then\n AbCreateDirectory(Path)\n else\n raise EAbNoSuchDirectory.Create;\n\n Result := True;\n if not Item.IsDirectory and FileExists(UseName) then\n DoConfirmOverwrite(UseName, Result);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Delete(aItem : TAbArchiveItem);\n {delete an item from the archive}\nvar\n Index : Integer;\nbegin\n CheckValid;\n Index := FindItem(aItem);\n if Index <> -1 then\n DeleteAt(Index);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DeleteAt(Index : Integer);\n {delete the item at the index from the archive}\nvar\n Confirm : Boolean;\nbegin\n CheckValid;\n SaveIfNeeded(FItemList[Index]);\n DoConfirmProcessItem(FItemList[Index], ptDelete, Confirm);\n if not Confirm then\n Exit;\n\n TAbArchiveItem(FItemList[Index]).Action := aaDelete;\n FIsDirty := True;\n if AutoSave then\n Save;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DeleteFiles(const FileMask : string);\n {delete all files from the archive that match the file mask}\nbegin\n DeleteFilesEx(FileMask, '');\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DeleteFilesEx(const FileMask, ExclusionMask : string);\n {Delete files matching Filemask except those matching ExclusionMask}\nvar\n i : Integer;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := pred(Count) downto 0 do begin\n with TAbArchiveItem(FItemList[i]) do\n if MatchesStoredNameEx(FileMask) then\n if not MatchesStoredNameEx(ExclusionMask) then\n DeleteAt(i);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DeleteTaggedItems;\n {delete all tagged items from the archive}\nvar\n i : Integer;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := pred(Count) downto 0 do begin\n with TAbArchiveItem(FItemList[i]) do\n if Tagged then\n DeleteAt(i);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoProcessItemFailure(Item : TAbArchiveItem;\n ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;\n ErrorCode : Integer);\nbegin\n if Assigned(FOnProcessItemFailure) then\n FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoArchiveSaveProgress(Progress : Byte; var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FOnArchiveSaveProgress) then\n FOnArchiveSaveProgress(Self, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoArchiveProgress(Progress : Byte; var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FOnArchiveProgress) then\n FOnArchiveProgress(Self, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoArchiveItemProgress(Item : TAbArchiveItem;\n Progress : Byte; var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FOnArchiveItemProgress) then\n FOnArchiveItemProgress(Self, Item, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoConfirmOverwrite(var FileName : string; var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmOverwrite) then\n FOnConfirmOverwrite(FileName, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoConfirmProcessItem(Item : TAbArchiveItem;\n const ProcessType : TAbProcessType; var Confirm : Boolean);\nconst\n ProcessTypeToLogType : array[TAbProcessType] of TAbLogType =\n (ltAdd, ltDelete, ltExtract, ltFreshen, ltMove, ltReplace, ltFoundUnhandled);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmProcessItem) then\n FOnConfirmProcessItem(Self, Item, ProcessType, Confirm);\n if (Confirm and FLogging) then\n MakeLogEntry(Item.Filename, ProcessTypeToLogType[ProcessType]);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoConfirmSave(var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmSave) then\n FOnConfirmSave(Self, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoDeflateProgress(aPercentDone: integer);\nvar\n Abort : Boolean;\nbegin\n DoProgress(aPercentDone, Abort);\n if Abort then\n raise EAbAbortProgress.Create(AbUserAbortS);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoInflateProgress(aPercentDone: integer);\nvar\n Abort : Boolean;\nbegin\n DoProgress(aPercentDone, Abort);\n if Abort then\n raise EAbAbortProgress.Create(AbUserAbortS);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoLoad;\nbegin\n if Assigned(FOnLoad) then\n FOnLoad(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoProgress(Progress : Byte; var Abort : Boolean);\nbegin\n Abort := False; \n DoArchiveItemProgress(FCurrentItem, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoSave;\nbegin\n if Assigned(FOnSave) then\n FOnSave(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Extract(aItem : TAbArchiveItem; const NewName : string);\n {extract an item from the archive}\nvar\n Index : Integer;\nbegin\n CheckValid;\n Index := FindItem(aItem);\n if Index <> -1 then\n ExtractAt(Index, NewName);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ExtractAt(Index : Integer; const NewName : string);\n {extract an item from the archive at Index}\nvar\n Confirm : Boolean;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer;\n UseName : string;\nbegin\n CheckValid;\n SaveIfNeeded(FItemList[Index]);\n DoConfirmProcessItem(FItemList[Index], ptExtract, Confirm);\n if not Confirm then\n Exit;\n\n if not ConfirmPath(FItemList[Index], NewName, UseName) then\n Exit;\n\n try\n FCurrentItem := FItemList[Index];\n ExtractItemAt(Index, UseName);\n except\n on E : Exception do begin\n AbConvertException(E, ErrorClass, ErrorCode);\n DoProcessItemFailure(FItemList[Index], ptExtract, ErrorClass, ErrorCode);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ExtractToStream(const aFileName : string;\n aStream : TStream);\n {extract an item from the archive at Index directly to a stream}\nvar\n Confirm : Boolean;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer;\n Index : Integer;\nbegin\n CheckValid;\n Index := FindFile(aFileName);\n if (Index = -1) then\n Exit;\n\n SaveIfNeeded(FItemList[Index]);\n\n DoConfirmProcessItem(FItemList[Index], ptExtract, Confirm);\n if not Confirm then\n Exit;\n FCurrentItem := FItemList[Index];\n try\n ExtractItemToStreamAt(Index, aStream);\n except\n on E : Exception do begin\n AbConvertException(E, ErrorClass, ErrorCode);\n DoProcessItemFailure(FItemList[Index], ptExtract, ErrorClass, ErrorCode);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ExtractFiles(const FileMask : string);\n {extract all files from the archive that match the mask}\nbegin\n ExtractFilesEx(FileMask, '');\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ExtractFilesEx(const FileMask, ExclusionMask : string);\n {Extract files matching Filemask except those matching ExclusionMask}\nvar\n i : Integer;\n Abort : Boolean;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := 0 to pred(Count) do begin\n with TAbArchiveItem(FItemList[i]) do\n if MatchesStoredNameEx(FileMask) and\n not MatchesStoredNameEx(ExclusionMask) and\n ((eoCreateDirs in ExtractOptions) or not IsDirectory) then\n ExtractAt(i, '');\n DoArchiveProgress(AbPercentage(succ(i), Count), Abort);\n if Abort then\n raise EAbUserAbort.Create;\n end;\n DoArchiveProgress(100, Abort);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ExtractTaggedItems;\n {extract all tagged items from the archive}\nvar\n i : Integer;\n Abort : Boolean;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := 0 to pred(Count) do begin\n with TAbArchiveItem(FItemList[i]) do\n if Tagged then\n ExtractAt(i, '');\n DoArchiveProgress(AbPercentage(succ(i), Count), Abort);\n if Abort then\n raise EAbUserAbort.Create;\n end;\n DoArchiveProgress(100, Abort);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.TestTaggedItems;\n {test all tagged items in the archive}\nvar\n i : Integer;\n Abort : Boolean;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := 0 to pred(Count) do begin\n with TAbArchiveItem(FItemList[i]) do\n if Tagged then begin\n FCurrentItem := FItemList[i];\n TestItemAt(i);\n end;\n DoArchiveProgress(AbPercentage(succ(i), Count), Abort);\n if Abort then\n raise EAbUserAbort.Create;\n end;\n DoArchiveProgress(100, Abort);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.FindFile(const aFileName : string): Integer;\n {find the index of the specified file}\nbegin\n Result := FItemList.Find(aFileName);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.FindItem(aItem : TAbArchiveItem): Integer;\n {find the index of the specified item}\nbegin\n Result := FItemList.Find(aItem.FileName);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.FixName(const Value : string) : string;\nvar\n lValue: string;\nbegin\n lValue := Value;\n {$IFDEF MSWINDOWS}\n if DOSMode then begin\n {Add the base directory to the filename before converting }\n {the file spec to the short filespec format. }\n if BaseDirectory <> '' then begin\n {Does the filename contain a drive or a leading backslash? }\n if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then\n {If not, add the BaseDirectory to the filename.}\n lValue := AbAddBackSlash(BaseDirectory) + lValue;\n end;\n lValue := AbGetShortFileSpec(lValue);\n end;\n {$ENDIF}\n\n {strip drive stuff}\n if soStripDrive in StoreOptions then\n AbStripDrive(lValue);\n\n {check for a leading backslash}\n if lValue[1] = AbPathDelim then\n System.Delete(lValue, 1, 1);\n\n if soStripPath in StoreOptions then begin\n lValue := ExtractFileName(lValue);\n end;\n\n if soRemoveDots in StoreOptions then\n AbStripDots(lValue);\n\n Result := lValue;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Freshen(aItem : TAbArchiveItem);\n {freshen the item}\nvar\n Index : Integer;\nbegin\n CheckValid;\n Index := FindItem(aItem);\n if Index <> -1 then begin\n {point existing item at the new file}\n if AbGetPathType(aItem.DiskFileName) = ptAbsolute then\n FItemList[Index].DiskFileName := aItem.DiskFileName;\n FreshenAt(Index);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.FreshenAt(Index : Integer);\n {freshen item at index}\nvar\n Confirm : Boolean;\n FR : Boolean;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer;\nbegin\n CheckValid;\n SaveIfNeeded(FItemList[Index]);\n\n GetFreshenTarget(FItemList[Index]);\n FR := False;\n try\n FR := FreshenRequired(FItemList[Index]);\n except\n on E : Exception do begin\n AbConvertException(E, ErrorClass, ErrorCode);\n DoProcessItemFailure(FItemList[Index], ptFreshen, ErrorClass, ErrorCode);\n end;\n end;\n if not FR then\n Exit;\n DoConfirmProcessItem(FItemList[Index], ptFreshen, Confirm);\n if not Confirm then\n Exit;\n\n TAbArchiveItem(FItemList[Index]).Action := aaFreshen;\n FIsDirty := True;\n if AutoSave then\n Save;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.FreshenFiles(const FileMask : string);\n {freshen all items that match the file mask}\nbegin\n FreshenFilesEx(FileMask, '');\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.FreshenFilesEx(const FileMask, ExclusionMask : string);\n {freshen all items that match the file mask}\nvar\n i : Integer;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := pred(Count) downto 0 do begin\n with TAbArchiveItem(FItemList[i]) do\n if MatchesStoredNameEx(FileMask) then\n if not MatchesStoredNameEx(ExclusionMask) then\n FreshenAt(i);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.FreshenRequired(Item : TAbArchiveItem) : Boolean;\nvar\n FS : TFileStream;\n DateTime : LongInt;\n FileTime : Word;\n FileDate : Word;\n Matched : Boolean;\n SaveDir : string;\nbegin\n GetDir(0, SaveDir);\n if BaseDirectory <> '' then\n ChDir(BaseDirectory);\n try\n FS := TFileStream.Create(Item.DiskFileName,\n fmOpenRead or fmShareDenyWrite);\n try\n DateTime := FileGetDate(FS.Handle);\n FileTime := LongRec(DateTime).Lo;\n FileDate := LongRec(DateTime).Hi;\n Matched := (Item.LastModFileDate = FileDate) and\n (Item.LastModFileTime = FileTime) and\n (Item.UncompressedSize = FS.Size);\n Result := not Matched;\n finally\n FS.Free;\n end;\n finally\n if BaseDirectory <> '' then\n ChDir(SaveDir);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.FreshenTaggedItems;\n {freshen all tagged items}\nvar\n i : Integer;\nbegin\n CheckValid;\n if Count > 0 then begin\n for i := pred(Count) downto 0 do begin\n with TAbArchiveItem(FItemList[i]) do\n if Tagged then\n FreshenAt(i);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.GetFreshenTarget(Item : TAbArchiveItem);\nvar\n PathType : TAbPathType;\n Files : TStrings;\n SaveDir : string;\n DName : string;\nbegin\n PathType := AbGetPathType(Item.DiskFileName);\n if (soRecurse in StoreOptions) and (PathType = ptNone) then begin\n GetDir(0, SaveDir);\n if BaseDirectory <> '' then\n ChDir(BaseDirectory);\n try\n Files := TStringList.Create;\n try\n // even if archive supports empty folder we don't have to\n // freshen it because there is no data, although, the timestamp\n // can be update since the folder was added\n AbFindFiles(Item.FileName, faAnyFile and not faDirectory, Files,\n True);\n if Files.Count > 0 then begin\n DName := AbAddBackSlash(BaseDirectory) + Files[0];\n AbUnfixName(DName);\n Item.DiskFileName := DName;\n end\n else\n Item.DiskFileName := '';\n finally\n Files.Free;\n end;\n finally\n if BaseDirectory <> '' then\n ChDir(SaveDir);\n end;\n end\n else begin\n if (BaseDirectory <> '') then\n DName := AbAddBackSlash(BaseDirectory) + Item.FileName\n else\n if AbGetPathType(Item.DiskFileName) = ptAbsolute then\n DName := Item.DiskFileName\n else\n DName := Item.FileName;\n AbUnfixName(DName);\n Item.DiskFileName := DName;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.GetSpanningThreshold : Int64;\nbegin\n Result := FSpanningThreshold;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.GetSupportsEmptyFolders : Boolean;\nbegin\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbArchive.GetItemCount : Integer;\nbegin\n if Assigned(FItemList) then\n Result := FItemList.Count\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Load;\n {load the archive}\nbegin\n try\n LoadArchive;\n FStatus := asIdle;\n finally\n DoLoad;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.MakeLogEntry(const FN: string; LT : TAbLogType);\nconst\n LogTypeRes : array[TAbLogType] of string =\n (AbLtAddS, AbLtDeleteS, AbLtExtractS, AbLtFreshenS, AbLtMoveS, AbLtReplaceS,\n AbLtStartS, AbUnhandledEntityS);\nvar\n Buf : string;\nbegin\n if Assigned(FLogStream) then begin\n Buf := FN + LogTypeRes[LT] + DateTimeToStr(Now) + sLineBreak;\n FLogStream.Write(Buf[1], Length(Buf) * SizeOf(Char));\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Move(aItem : TAbArchiveItem; const NewStoredPath : string);\nvar\n Confirm : Boolean;\n Found : Boolean;\n i : Integer;\n FixedPath, OldFileName: string;\nbegin\n CheckValid;\n FixedPath := FixName(NewStoredPath);\n Found := False;\n if Count > 0 then\n for i := 0 to pred(Count) do\n if (ItemList[i] <> aItem) and SameText(FixedPath, ItemList[i].FileName) and\n (ItemList[i].Action <> aaDelete) then begin\n Found := True;\n Break;\n end;\n if Found then begin\n DoProcessItemFailure(aItem, ptMove, ecAbbrevia, AbDuplicateName);\n {even if something gets done in the AddItemFailure, we don't\n want to continue...}\n Exit;\n end;\n\n SaveIfNeeded(aItem);\n\n DoConfirmProcessItem(aItem, ptMove, Confirm);\n if not Confirm then\n Exit;\n\n OldFileName := aItem.FileName;\n aItem.FileName := FixedPath;\n aItem.Action := aaMove;\n ItemList.UpdateHash(aItem, OldFileName);\n\n FIsDirty := True;\n if AutoSave then\n Save;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Replace(aItem : TAbArchiveItem);\n {replace the item}\nvar\n Index : Integer;\nbegin\n CheckValid;\n Index := FindItem(aItem);\n if Index <> -1 then begin\n {point existing item at the new file}\n if AbGetPathType(aItem.DiskFileName) = ptAbsolute then\n FItemList[Index].DiskFileName := aItem.DiskFileName;\n ReplaceAt(Index);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.ReplaceAt(Index : Integer);\n {replace item at Index}\nvar\n Confirm : Boolean;\nbegin\n CheckValid;\n SaveIfNeeded(FItemList[Index]);\n\n GetFreshenTarget(FItemList[Index]);\n DoConfirmProcessItem(FItemList[Index], ptReplace, Confirm);\n if not Confirm then\n Exit;\n\n TAbArchiveItem(FItemList[Index]).Action := aaReplace;\n FIsDirty := True;\n if AutoSave then\n Save;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.Save;\n {save the archive}\nvar\n Confirm : Boolean;\nbegin\n if Status = asInvalid then\n Exit;\n if (not FIsDirty) and (Count > 0) then\n Exit;\n\n DoConfirmSave(Confirm);\n if not Confirm then\n Exit;\n\n SaveArchive;\n FIsDirty := False;\n DoSave;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.SaveIfNeeded(aItem : TAbArchiveItem);\nbegin\n if (aItem.Action <> aaNone) then\n Save;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.SetBaseDirectory(Value : string);\nbegin\n if (Value <> '') then\n if Value[Length(Value)] = AbPathDelim then\n if (Length(Value) > 1) and (Value[Length(Value) - 1] <> ':') then\n System.Delete(Value, Length(Value), 1);\n if (Length(Value) = 0) or DirectoryExists(Value) then\n FBaseDirectory := Value\n else\n raise EAbNoSuchDirectory.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.SetSpanningThreshold( Value : Int64 );\nbegin\n FSpanningThreshold := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.SetLogFile(const Value : string);\nbegin\n FLogFile := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.SetLogging(Value : Boolean);\nbegin\n FLogging := Value;\n if Assigned(FLogStream) then begin\n FLogStream.Free;\n FLogStream := nil;\n end;\n if FLogging and (FLogFile <> '') then begin\n try\n FLogStream := TFileStream.Create(FLogFile, fmCreate or fmOpenWrite);\n MakeLogEntry(FArchiveName, ltStart);\n except\n raise EAbException.Create(AbLogCreateErrorS);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.TagItems(const FileMask : string);\n {tag all items that match the mask}\nvar\n i : Integer;\nbegin\n if Count > 0 then\n for i := 0 to pred(Count) do\n with TAbArchiveItem(FItemList[i]) do begin\n if MatchesStoredNameEx(FileMask) then \n Tagged := True;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.UnTagItems(const FileMask : string);\n {clear tags for all items that match the mask}\nvar\n i : Integer;\nbegin\n if Count > 0 then\n for i := 0 to pred(Count) do\n with TAbArchiveItem(FItemList[i]) do begin\n if MatchesStoredNameEx(FileMask) then\n Tagged := False;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbArchive.DoSpanningMediaRequest(Sender: TObject;\n ImageNumber: Integer; var ImageName: string; var Abort: Boolean);\nbegin\n raise EAbSpanningNotSupported.Create;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbExtraField implementation ============================================= }\nprocedure TAbExtraField.Assign(aSource : TAbExtraField);\nbegin\n SetBuffer(aSource.Buffer);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.Changed;\nbegin\n // No-op\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.Clear;\nbegin\n FBuffer := nil;\n Changed;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.CloneFrom(aSource : TAbExtraField; aID : Word);\nvar\n Data : Pointer;\n DataSize : Word;\nbegin\n if aSource.Get(aID, Data, DataSize) then\n Put(aID, Data, DataSize)\n else Delete(aID);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.Delete(aID : Word);\nvar\n SubField : PAbExtraSubField;\nbegin\n if FindField(aID, SubField) then begin\n DeleteField(SubField);\n Changed;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.DeleteField(aSubField : PAbExtraSubField);\nvar\n Len, Offset : Integer;\nbegin\n Len := SizeOf(TAbExtraSubField) + aSubField.Len;\n Offset := PtrInt(aSubField) - PtrInt(Pointer(FBuffer));\n if Offset + Len < Length(FBuffer) then\n Move(FBuffer[Offset + Len], aSubField^, Length(FBuffer) - Offset - Len);\n SetLength(FBuffer, Length(FBuffer) - Len);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.FindField(aID : Word;\n out aSubField : PAbExtraSubField) : Boolean;\nbegin\n Result := False;\n aSubField := nil;\n while FindNext(aSubField) do\n if aSubField.ID = aID then begin\n Result := True;\n Break;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.FindNext(var aCurField : PAbExtraSubField) : Boolean;\nvar\n BytesLeft : Integer;\nbegin\n if aCurField = nil then begin\n aCurField := PAbExtraSubField(FBuffer);\n BytesLeft := Length(FBuffer);\n end\n else begin\n BytesLeft := Length(FBuffer) -\n Integer(PtrInt(aCurField) - PtrInt(Pointer(FBuffer))) -\n SizeOf(TAbExtraSubField) - aCurField.Len;\n aCurField := Pointer(PtrInt(aCurField) + aCurField.Len + SizeOf(TAbExtraSubField));\n end;\n Result := (BytesLeft >= SizeOf(TAbExtraSubField));\n if Result and (BytesLeft < SizeOf(TAbExtraSubField) + aCurField.Len) then\n aCurField.Len := BytesLeft - SizeOf(TAbExtraSubField);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.Get(aID : Word; out aData : Pointer;\n out aDataSize : Word) : Boolean;\nvar\n SubField : PAbExtraSubField;\nbegin\n Result := FindField(aID, SubField);\n if Result then begin\n aData := @SubField.Data;\n aDataSize := SubField.Len;\n end\n else begin\n aData := nil;\n aDataSize := 0;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.GetCount : Integer;\nvar\n SubField : PAbExtraSubField;\nbegin\n Result := 0;\n SubField := nil;\n while FindNext(SubField) do\n Inc(Result);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.GetID(aIndex : Integer): Word;\nvar\n i: Integer;\n SubField : PAbExtraSubField;\nbegin\n i := 0;\n SubField := nil;\n while FindNext(SubField) do\n if i = aIndex then begin\n Result := SubField.ID;\n Exit;\n end\n else\n Inc(i);\n raise EListError.CreateFmt(SListIndexError, [aIndex]);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.GetStream(aID : Word; out aStream : TStream): Boolean;\nvar\n Data: Pointer;\n DataSize: Word;\nbegin\n Result := Get(aID, Data, DataSize);\n if Result then begin\n aStream := TMemoryStream.Create;\n aStream.WriteBuffer(Data^, DataSize);\n aStream.Position := 0;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbExtraField.Has(aID : Word): Boolean;\nvar\n SubField : PAbExtraSubField;\nbegin\n Result := FindField(aID, SubField);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.LoadFromStream(aStream : TStream; aSize : Word);\nbegin\n SetLength(FBuffer, aSize);\n if aSize > 0 then\n aStream.ReadBuffer( FBuffer[0], aSize);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.Put(aID : Word; const aData; aDataSize : Word);\nvar\n Offset : Cardinal;\n SubField : PAbExtraSubField;\nbegin\n if FindField(aID, SubField) then begin\n if SubField.Len = aDataSize then begin\n Move(aData, SubField.Data, aDataSize);\n Changed;\n Exit;\n end\n else DeleteField(SubField);\n end;\n Offset := Length(FBuffer);\n SetLength(FBuffer, Length(FBuffer) + SizeOf(TAbExtraSubField) + aDataSize);\n SubField := PAbExtraSubField(@FBuffer[Offset]);\n SubField.ID := aID;\n SubField.Len := aDataSize;\n Move(aData, SubField.Data, aDataSize);\n Changed;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExtraField.SetBuffer(const aValue : TByteDynArray);\nbegin\n SetLength(FBuffer, Length(aValue));\n if Length(FBuffer) > 0 then\n Move(aValue[0], FBuffer[0], Length(FBuffer));\n Changed;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ ========================================================================== }\n{ TAbArchiveStreamHelper }\n\nconstructor TAbArchiveStreamHelper.Create(AStream: TStream);\nbegin\n if Assigned(AStream) then\n FStream := AStream\n else\n raise Exception.Create('nil stream');\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBase.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbBase.pas *}\n{*********************************************************}\n{* ABBREVIA: Base component class *}\n{*********************************************************}\n\nunit AbBase;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes;\n\ntype\n TAbBaseComponent = class(TComponent)\n protected {methods}\n function GetVersion : string;\n procedure SetVersion(const Value : string);\n\n protected {properties}\n property Version : string\n read GetVersion\n write SetVersion\n stored False;\n end;\n\nimplementation\n\nuses\n AbConst;\n\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseComponent.GetVersion : string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseComponent.SetVersion(const Value : string);\nbegin\n {NOP}\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBitBkt.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbBitBkt.pas *}\n{*********************************************************}\n{* ABBREVIA: Bit bucket memory stream class *}\n{*********************************************************}\n\nunit AbBitBkt;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbUtils;\n\ntype\n TAbBitBucketStream = class(TStream)\n private\n FBuffer : {$IFDEF UNICODE}PByte{$ELSE}PAnsiChar{$ENDIF};\n FBufSize : longint;\n FBufPosn : longint;\n FPosn : Int64;\n FSize : Int64;\n FTail : longint;\n protected\n public\n constructor Create(aBufSize : cardinal);\n destructor Destroy; override;\n function Read(var Buffer; Count : Longint) : Longint; override;\n function Write(const Buffer; Count : Longint) : Longint; override;\n function Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; override;\n\n procedure ForceSize(aSize : Int64);\n end;\n\nimplementation\n\nuses\n Math, SysUtils, AbExcept;\n\n{Notes: The buffer is a circular queue without a head pointer; FTail\n is where data is next going to be written and it wraps\n indescriminately. The buffer can never be empty--it is always\n full (initially it is full of binary zeros.\n The class is designed to act as a bit bucket for the test\n feature of Abbrevia's zip code; it is not intended as a\n complete class with many possible applications. It is designed\n to be written to in a steady progression with some reading\n back in the recently written stream (the buffer size details\n how far back the Seek method will work). Seeking outside this\n buffer will result in exceptions being generated.\n For testing deflated files, the buffer size should be 32KB,\n for imploded files, either 8KB or 4KB. The Create constructor\n limits the buffer size to these values.}\n\n{===TAbBitBucketStream===============================================}\nconstructor TAbBitBucketStream.Create(aBufSize : cardinal);\nbegin\n inherited Create;\n if (aBufSize <> 4096) and\n (aBufSize <> 8192) and\n (aBufSize <> 32768) then\n FBufSize := 32768\n else\n FBufSize := aBufSize;\n {add a 1KB leeway}\n inc(FBufSize, 1024);\n GetMem(FBuffer, FBufSize);\nend;\n{--------}\ndestructor TAbBitBucketStream.Destroy;\nbegin\n if (FBuffer <> nil) then\n FreeMem(FBuffer, FBufSize);\n inherited Destroy;\nend;\n{--------}\nprocedure TAbBitBucketStream.ForceSize(aSize : Int64);\nbegin\n FSize := aSize;\nend;\n{--------}\nfunction TAbBitBucketStream.Read(var Buffer; Count : Longint) : Longint;\nvar\n Chunk2Size : longint;\n Chunk1Size : longint;\n OutBuffer : PByte;\nbegin\n OutBuffer := @Buffer;\n {we cannot read more bytes than there is buffer}\n if (Count > FBufSize) then\n raise EAbBBSReadTooManyBytes.Create(Count);\n {calculate the size of the chunks}\n if (FBufPosn <= FTail) then begin\n Chunk1Size := FTail - FBufPosn;\n if (Chunk1Size > Count) then\n Chunk1Size := Count;\n Chunk2Size := 0;\n end\n else begin\n Chunk1Size := FBufSize - FBufPosn;\n if (Chunk1Size > Count) then begin\n Chunk1Size := Count;\n Chunk2Size := 0;\n end\n else begin\n Chunk2Size := FTail;\n if (Chunk2Size > (Count - Chunk1Size)) then\n Chunk2Size := Count - Chunk1Size;\n end\n end;\n {we cannot read more bytes than there are available}\n if (Count > (Chunk1Size + Chunk2Size)) then\n raise EAbBBSReadTooManyBytes.Create(Count);\n {perform the read}\n if (Chunk1Size > 0) then begin\n Move(FBuffer[FBufPosn], OutBuffer^, Chunk1Size);\n inc(FBufPosn, Chunk1Size);\n inc(FPosn, Chunk1Size);\n end;\n if (Chunk2Size > 0) then begin\n {we've wrapped}\n Move(FBuffer[0], PByte(PtrInt(OutBuffer) + PtrInt(Chunk1Size))^, Chunk2Size);\n FBufPosn := Chunk2Size;\n inc(FPosn, Chunk2Size);\n end;\n Result := Count;\nend;\n{--------}\nfunction TAbBitBucketStream.Write(const Buffer; Count : Longint) : Longint;\nvar\n Chunk2Size : longint;\n Chunk1Size : longint;\n InBuffer : PByte;\n Overage : longint;\nbegin\n Result := Count;\n InBuffer := @Buffer;\n {we cannot write more bytes than there is buffer}\n while Count > FBufSize do begin\n Overage := Min(FBufSize, Count - FBufSize);\n Write(InBuffer^, Overage);\n Inc(PtrInt(InBuffer), Overage);\n Dec(Count, Overage);\n end;\n {calculate the size of the chunks}\n Chunk1Size := FBufSize - FTail;\n if (Chunk1Size > Count) then begin\n Chunk1Size := Count;\n Chunk2Size := 0;\n end\n else begin\n Chunk2Size := Count - Chunk1Size;\n end;\n {write the first chunk}\n if (Chunk1Size > 0) then begin\n Move(InBuffer^, FBuffer[FTail], Chunk1Size);\n inc(FTail, Chunk1Size);\n end;\n {if the second chunk size is not zero, write the second chunk; note\n that we have wrapped}\n if (Chunk2Size > 0) then begin\n Move(PByte(PtrInt(InBuffer) + PtrInt(Chunk1Size))^, FBuffer[0], Chunk2Size);\n FTail := Chunk2Size;\n end;\n {the stream size and position have changed}\n inc(FSize, Count);\n FPosn := FSize;\n FBufPosn := FTail;\nend;\n{--------}\nfunction TAbBitBucketStream.Seek(const Offset : Int64; Origin : TSeekOrigin): Int64;\nvar\n Posn : Int64;\n BytesBack : longint;\nbegin\n {calculate the new position}\n case Origin of\n soBeginning :\n Posn := Offset;\n soCurrent :\n Posn := FPosn + Offset;\n soEnd :\n if (Offset = 0) then begin\n {special case: position at end of stream}\n FBufPosn := FTail;\n FPosn := FSize;\n Result := FSize;\n Exit;\n end\n else begin\n Posn := FSize + Offset;\n end;\n else\n raise EAbBBSInvalidOrigin.Create;\n end;\n {calculate whether the new position is within the buffer; if not,\n raise exception}\n if (Posn > FSize) or\n (Posn <= (FSize - FBufSize)) then\n raise EAbBBSSeekOutsideBuffer.Create;\n {set the internal fields for the new position}\n FPosn := Posn;\n BytesBack := FSize - Posn;\n if (BytesBack <= FTail) then\n FBufPosn := FTail - BytesBack\n else\n FBufPosn := longint(FTail) + FBufSize - BytesBack;\n {return the new position}\n Result := Posn;\nend;\n{====================================================================}\n\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBrowse.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbBrowse.pas *}\n{*********************************************************}\n{* ABBREVIA: Base Browser Component *}\n{*********************************************************}\n\nunit AbBrowse;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbBase,\n AbUtils,\n AbArcTyp;\n\ntype\n IAbProgressMeter = interface\n ['{4B766704-FD20-40BF-BA40-2EC2DD77B178}']\n procedure DoProgress(Progress : Byte);\n procedure Reset;\n end;\n\n TAbBaseBrowser = class(TAbBaseComponent)\n public\n FArchive : TAbArchive;\n protected {private}\n FSpanningThreshold : Longint;\n FItemProgressMeter : IAbProgressMeter;\n FArchiveProgressMeter : IAbProgressMeter;\n FBaseDirectory : string;\n FFileName : string;\n FLogFile : string;\n FLogging : Boolean;\n FOnArchiveProgress : TAbArchiveProgressEvent;\n FOnArchiveItemProgress : TAbArchiveItemProgressEvent;\n FOnChange : TNotifyEvent;\n FOnConfirmProcessItem : TAbArchiveItemConfirmEvent;\n FOnLoad : TAbArchiveEvent;\n FOnProcessItemFailure : TAbArchiveItemFailureEvent;\n FOnRequestImage : TAbRequestImageEvent;\n FTempDirectory : string;\n\n { detected compression type }\n FArchiveType : TAbArchiveType;\n FForceType : Boolean;\n\n protected {private methods}\n function GetCount : Integer;\n function GetItem(Value : Longint) : TAbArchiveItem;\n function GetSpanned : Boolean;\n function GetStatus : TAbArchiveStatus;\n procedure ResetMeters; virtual;\n procedure SetArchiveProgressMeter(const Value: IAbProgressMeter);\n procedure SetCompressionType(const Value: TAbArchiveType);\n procedure SetBaseDirectory(const Value : string);\n procedure SetItemProgressMeter(const Value: IAbProgressMeter);\n procedure SetSpanningThreshold(Value : Longint);\n procedure SetLogFile(const Value : string);\n procedure SetLogging(Value : Boolean);\n procedure SetTempDirectory(const Value : string);\n\n procedure Loaded; override;\n procedure Notification(Component: TComponent;\n Operation: TOperation); override;\n\n protected {virtual methods}\n procedure DoArchiveItemProgress(Sender : TObject;\n Item : TAbArchiveItem;\n Progress : Byte;\n var Abort : Boolean); virtual;\n procedure DoArchiveProgress(Sender : TObject;\n Progress : Byte;\n var Abort : Boolean); virtual;\n procedure DoChange; virtual;\n procedure DoConfirmProcessItem(Sender : TObject;\n Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n var Confirm : Boolean); virtual;\n procedure DoLoad(Sender : TObject); virtual;\n procedure DoProcessItemFailure(Sender : TObject;\n Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer); virtual;\n procedure SetOnRequestImage(Value : TAbRequestImageEvent); virtual;\n procedure InitArchive; virtual;\n\n {This method must be defined in descendent classes}\n procedure SetFileName(const aFileName : string); virtual; abstract;\n\n\n protected {properties}\n property Archive : TAbArchive\n read FArchive;\n property ArchiveProgressMeter : IAbProgressMeter\n read FArchiveProgressMeter\n write SetArchiveProgressMeter;\n property BaseDirectory : string\n read FBaseDirectory\n write SetBaseDirectory;\n property FileName : string\n read FFileName\n write SetFileName;\n property SpanningThreshold : Longint\n read FSpanningThreshold\n write SetSpanningThreshold\n default 0;\n property ItemProgressMeter : IAbProgressMeter\n read FItemProgressMeter\n write SetItemProgressMeter;\n property LogFile : string\n read FLogFile\n write SetLogFile;\n property Logging : Boolean\n read FLogging\n write SetLogging\n default False;\n property Spanned : Boolean\n read GetSpanned;\n property TempDirectory : string\n read FTempDirectory\n write SetTempDirectory;\n\n\n\n protected {events}\n property OnArchiveProgress : TAbArchiveProgressEvent\n read FOnArchiveProgress\n write FOnArchiveProgress;\n property OnArchiveItemProgress : TAbArchiveItemProgressEvent\n read FOnArchiveItemProgress\n write FOnArchiveItemProgress;\n property OnConfirmProcessItem : TAbArchiveItemConfirmEvent\n read FOnConfirmProcessItem\n write FOnConfirmProcessItem;\n property OnProcessItemFailure : TAbArchiveItemFailureEvent\n read FOnProcessItemFailure\n write FOnProcessItemFailure;\n property OnRequestImage : TAbRequestImageEvent\n read FOnRequestImage\n write SetOnRequestImage;\n\n public {methods}\n constructor Create(AOwner : TComponent); override;\n destructor Destroy; override;\n\n procedure ClearTags;\n {Clear all tags from the archive}\n function FindItem(aItem : TAbArchiveItem) : Integer;\n function FindFile(const aFileName : string) : Integer;\n procedure TagItems(const FileMask : string);\n {tag all items that match the mask}\n procedure UnTagItems(const FileMask : string);\n {clear tags for all items that match the mask}\n procedure CloseArchive;\n {closes the archive by setting FileName to ''}\n procedure OpenArchive(const aFileName : string);\n {opens the archive}\n\n public {properties}\n property Count : Integer\n read GetCount;\n property Items[Index : Integer] : TAbArchiveItem\n read GetItem; default;\n property Status : TAbArchiveStatus\n read GetStatus;\n\n property ArchiveType : TAbArchiveType\n read FArchiveType\n write SetCompressionType\n default atUnknown;\n\n property ForceType : Boolean\n read FForceType\n write FForceType\n default False;\n\n public {events}\n property OnChange : TNotifyEvent\n read FOnChange\n write FOnChange;\n property OnLoad : TAbArchiveEvent\n read FOnLoad\n write FOnLoad;\n end;\n\nfunction AbDetermineArcType(const FN : string; AssertType : TAbArchiveType) : TAbArchiveType; overload;\nfunction AbDetermineArcType(aStream: TStream) : TAbArchiveType; overload;\n\nimplementation\n\nuses\n SysUtils,\n AbExcept,\n{$IFDEF MSWINDOWS}\n AbCabTyp,\n{$ENDIF}\n AbZipTyp,\n AbTarTyp,\n AbGzTyp,\n AbBzip2Typ;\n\n{ TAbBaseBrowser implementation ======================================= }\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbBaseBrowser.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\n FLogFile := '';\n FLogging := False;\n FSpanningThreshold := 0;\n\n FArchiveType := atUnknown;\n FForceType := False;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbBaseBrowser.Destroy;\nbegin\n FArchive.Free;\n FArchive := nil;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.ClearTags;\n {Clear all tags from the archive}\nbegin\n if Assigned(FArchive) then\n FArchive.ClearTags\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.CloseArchive;\n {closes the archive by setting FileName to ''}\nbegin\n if FFileName <> '' then\n FileName := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.DoArchiveItemProgress(Sender : TObject;\n Item : TAbArchiveItem;\n Progress : Byte;\n var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FItemProgressMeter) then\n FItemProgressMeter.DoProgress(Progress);\n if Assigned(FOnArchiveItemProgress) then\n FOnArchiveItemProgress(Self, Item, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.DoArchiveProgress(Sender : TObject;\n Progress : Byte;\n var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FArchiveProgressMeter) then\n FArchiveProgressMeter.DoProgress(Progress);\n if Assigned(FOnArchiveProgress) then\n FOnArchiveProgress(Self, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.DoChange; \nbegin\n if Assigned(FOnChange) then begin\n FOnChange(Self);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.DoConfirmProcessItem(Sender : TObject;\n Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FItemProgressMeter) then\n FItemProgressMeter.Reset;\n if Assigned(FOnConfirmProcessItem) then\n FOnConfirmProcessItem(Self, Item, ProcessType, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.DoLoad(Sender : TObject);\nbegin\n if Assigned(FOnLoad) then\n FOnLoad(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.DoProcessItemFailure(Sender : TObject;\n Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer);\nbegin\n if Assigned(FOnProcessItemFailure) then\n FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseBrowser.FindItem(aItem : TAbArchiveItem) : Integer;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.FindItem(aItem)\n else\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseBrowser.FindFile(const aFileName : string) : Integer;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.FindFile(aFileName)\n else\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseBrowser.GetSpanned : Boolean;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.Spanned\n else\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseBrowser.GetStatus : TAbArchiveStatus;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.Status\n else\n Result := asInvalid;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseBrowser.GetCount : Integer;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.Count\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseBrowser.GetItem(Value : Longint) : TAbArchiveItem;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.ItemList[Value]\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.InitArchive;\nbegin\n ResetMeters;\n if Assigned(FArchive) then begin\n {properties}\n FArchive.SpanningThreshold := FSpanningThreshold;\n FArchive.LogFile := FLogFile;\n FArchive.Logging := FLogging;\n FArchive.TempDirectory := FTempDirectory;\n SetBaseDirectory(FBaseDirectory);\n {events}\n FArchive.OnArchiveProgress := DoArchiveProgress;\n FArchive.OnArchiveItemProgress := DoArchiveItemProgress;\n FArchive.OnConfirmProcessItem := DoConfirmProcessItem;\n FArchive.OnLoad := DoLoad;\n FArchive.OnProcessItemFailure := DoProcessItemFailure;\n FArchive.OnRequestImage := FOnRequestImage;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.Loaded;\nbegin\n inherited Loaded;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.Notification(Component: TComponent;\n Operation: TOperation);\nbegin\n inherited Notification(Component, Operation);\n if (Operation = opRemove) then begin\n if Assigned(ItemProgressMeter) and Component.IsImplementorOf(ItemProgressMeter) then\n ItemProgressMeter := nil;\n if Assigned(ArchiveProgressMeter) and Component.IsImplementorOf(ArchiveProgressMeter) then\n ArchiveProgressMeter := nil;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.OpenArchive(const aFileName : string);\n {opens the archive}\nbegin\n FileName := AFileName;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.ResetMeters;\nbegin\n if Assigned(FArchiveProgressMeter) then\n FArchiveProgressMeter.Reset;\n if Assigned(FItemProgressMeter) then\n FItemProgressMeter.Reset;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetBaseDirectory(const Value : string);\nbegin\n if Assigned(FArchive) then begin\n FArchive.BaseDirectory := Value;\n FBaseDirectory := FArchive.BaseDirectory;\n end else\n FBaseDirectory := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetSpanningThreshold(Value : Longint);\nbegin\n FSpanningThreshold := Value;\n if Assigned(FArchive) then\n FArchive.SpanningThreshold := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetLogFile(const Value : string);\nbegin\n FLogFile := Value;\n if (csDesigning in ComponentState) then\n Exit;\n if Assigned(FArchive) then\n FArchive.LogFile := Value;\n SetLogging(Value <> '');\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetLogging(Value : Boolean);\nbegin\n FLogging := Value;\n if (csDesigning in ComponentState) then\n Exit;\n if Assigned(FArchive) then\n FArchive.Logging:= Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetOnRequestImage(Value : TAbRequestImageEvent);\nbegin\n FOnRequestImage := Value;\n if Assigned(FArchive) then\n FArchive.OnRequestImage := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetTempDirectory(const Value : string);\nbegin\n FTempDirectory := Value;\n if Assigned(FArchive) then\n FArchive.TempDirectory := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.TagItems(const FileMask : string);\n {tag all items that match the mask}\nbegin\n if Assigned(FArchive) then\n FArchive.TagItems(FileMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.UnTagItems(const FileMask : string);\n {clear tags for all items that match the mask}\nbegin\n if Assigned(FArchive) then\n FArchive.UnTagItems(FileMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetCompressionType(const Value: TAbArchiveType);\nbegin\n if not Assigned(FArchive) or (Status <> asInvalid) then\n FArchiveType := Value\n else\n raise EAbArchiveBusy.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetArchiveProgressMeter(const Value: IAbProgressMeter);\nbegin\n ReferenceInterface(FArchiveProgressMeter, opRemove);\n FArchiveProgressMeter := Value;\n ReferenceInterface(FArchiveProgressMeter, opInsert);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseBrowser.SetItemProgressMeter(const Value: IAbProgressMeter);\nbegin\n ReferenceInterface(FItemProgressMeter, opRemove);\n FItemProgressMeter := Value;\n ReferenceInterface(FItemProgressMeter, opInsert);\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbDetermineArcType(const FN : string; AssertType : TAbArchiveType) : TAbArchiveType;\nvar\n Ext : string;\n FS : TFileStream;\nbegin\n Result := AssertType;\n if Result = atUnknown then begin\n { Guess archive type based on it's extension }\n Ext := UpperCase(ExtractFileExt(FN));\n if (Ext = '.ZIP') or (Ext = '.JAR') then\n Result := atZip;\n if (Ext = '.EXE') then\n Result := atSelfExtZip;\n if (Ext = '.TAR') then\n Result := atTar;\n if (Ext = '.GZ') then\n Result := atGzip;\n if (Ext = '.TGZ') then\n Result := atGzippedTar;\n if (Ext = '.CAB') then\n Result := atCab;\n if (Ext = '.BZ2') then\n Result := atBzip2;\n if (Ext = '.TBZ') then\n Result := atBzippedTar;\n end;\n {$IFNDEF MSWINDOWS}\n if Result = atCab then\n Result := atUnknown;\n {$ENDIF}\n if FileExists(FN) and (AbFileGetSize(FN) > 0) then begin\n { If the file doesn't exist (or is empty) presume to make one, otherwise\n guess or verify the contents }\n FS := TFileStream.Create(FN, fmOpenRead or fmShareDenyNone);\n try\n if Result = atUnknown then\n Result := AbDetermineArcType(FS)\n else begin\n case Result of\n atZip : begin\n Result := VerifyZip(FS);\n end;\n atSelfExtZip : begin\n Result := VerifySelfExtracting(FS);\n end;\n atTar : begin\n Result := VerifyTar(FS);\n end;\n atGzip, atGzippedTar: begin\n Result := VerifyGzip(FS);\n end;\n {$IFDEF MSWINDOWS}\n atCab : begin\n Result := VerifyCab(FS);\n end;\n {$ENDIF}\n atBzip2, atBzippedTar: begin\n Result := VerifyBzip2(FS);\n end;\n end;\n end;\n finally\n FS.Free;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbDetermineArcType(aStream: TStream): TAbArchiveType;\nbegin\n { VerifyZip returns true for self-extracting zips too, so test those first }\n Result := VerifySelfExtracting(aStream);\n if Result = atUnknown then\n Result := VerifyZip(aStream);\n if Result = atUnknown then\n Result := VerifyTar(aStream);\n if Result = atUnknown then\n Result := VerifyGzip(aStream);\n if Result = atUnknown then\n Result := VerifyBzip2(aStream);\n {$IFDEF MSWINDOWS}\n if Result = atUnknown then\n Result := VerifyCab(aStream);\n {$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\n\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBseCLX.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbBaseCLX.pas *}\n{*********************************************************}\n{* ABBREVIA: Base component class (CLX) *}\n{*********************************************************}\n\nunit AbBseCLX;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n {$IFNDEF BuildingStub}\n QControls,\n {$ENDIF BuildingStub}\n AbConst,\n AbBase;\n\n\n{$IFNDEF BuildingStub}\ntype\n TAbBaseWinControl = class(TWidgetControl);\n{$ENDIF BuildingStub}\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBseVCL.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbBaseVCL.pas *}\n{*********************************************************}\n{* ABBREVIA: Base component class (VCL) *}\n{*********************************************************}\n\nunit AbBseVCL;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes\n {$IFNDEF BuildingStub}\n , Controls\n {$ENDIF BuildingStub}\n ;\n\n\n{$IFNDEF BuildingStub}\ntype\n TAbBaseWinControl = class(TWinControl);\n{$ENDIF BuildingStub}\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBzip2.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * This program, \"bzip2\", the associated library \"libbzip2\", and all\n * documentation, are copyright (C) 1996-2007 Julian R Seward. All\n * rights reserved.\n *\n * Redistribution and use in source and binary forms, with or without\n * modification, are permitted provided that the following conditions\n * are met:\n *\n * 1. Redistributions of source code must retain the above copyright\n * notice, this list of conditions and the following disclaimer.\n *\n * 2. The origin of this software must not be misrepresented; you must\n * not claim that you wrote the original software. If you use this\n * software in a product, an acknowledgment in the product\n * documentation would be appreciated but is not required.\n *\n * 3. Altered source versions must be plainly marked as such, and must\n * not be misrepresented as being the original software.\n *\n * 4. The name of the author may not be used to endorse or promote\n * products derived from this software without specific prior written\n * permission.\n *\n * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS\n * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\n * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\n * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY\n * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\n * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE\n * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS\n * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,\n * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING\n * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\n * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n *\n * Julian Seward, jseward@bzip.org\n * bzip2/libbzip2 version 1.0.5 of 10 December 2007\n *\n * Pascal wrapper created by Edison Mera, version 1.04\n * http://edisonlife.homelinux.com/\n *\n * Dynamic and runtime linking and Win64/OS X/Linux support by Craig Peterson\n * http://tpabbrevia.sourceforge.net/\n * ***** END LICENSE BLOCK ***** *)\n\nunit AbBzip2;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils, Classes;\n\ntype\n TAlloc = function(opaque: Pointer; Items, Size: Integer): Pointer; cdecl;\n TFree = procedure(opaque, Block: Pointer); cdecl;\n\n // Internal structure. Ignore.\n TBZStreamRec = record\n next_in: PByte; // next input byte\n avail_in: Integer; // number of bytes available at next_in\n total_in_lo32: Integer; // total nb of input bytes read so far\n total_in_hi32: Integer;\n\n next_out: PByte; // next output byte should be put here\n avail_out: Integer; // remaining free space at next_out\n total_out_lo32: Integer; // total nb of bytes output so far\n total_out_hi32: Integer;\n\n state: Pointer;\n\n bzalloc: TAlloc; // used to allocate the internal state\n bzfree: TFree; // used to free the internal state\n opaque: Pointer;\n end;\n\n // Abstract ancestor class\n TCustomBZip2Stream = class(TStream)\n private\n FStrm: TStream;\n FStrmPos: Int64;\n FOnProgress: TNotifyEvent;\n FBZRec: TBZStreamRec;\n FBuffer: array[Word] of Byte;\n protected\n procedure Progress(Sender: TObject); dynamic;\n property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;\n constructor Create(Strm: TStream);\n end;\n\n{ TBZCompressionStream compresses data on the fly as data is written to it, and\n stores the compressed data to another stream.\n\n TBZCompressionStream is write-only and strictly sequential. Reading from the\n stream will raise an exception. Using Seek to move the stream pointer\n will raise an exception.\n\n Output data is cached internally, written to the output stream only when\n the internal output buffer is full. All pending output data is flushed\n when the stream is destroyed.\n\n The Position property returns the number of uncompressed bytes of\n data that have been written to the stream so far.\n\n CompressionRate returns the on-the-fly percentage by which the original\n data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100\n If raw data size = 100 and compressed data size = 25, the CompressionRate\n is 75%\n\n The OnProgress event is called each time the output buffer is filled and\n written to the output stream. This is useful for updating a progress\n indicator when you are writing a large chunk of data to the compression\n stream in a single call.}\n\n\n TBlockSize100k = (bs1, bs2, bs3, bs4, bs5, bs6, bs7, bs8, bs9);\n\n TBZCompressionStream = class(TCustomBZip2Stream)\n private\n function GetCompressionRate: Single;\n public\n constructor Create(BlockSize100k: TBlockSize100k; Dest: TStream);\n destructor Destroy; override;\n function Read(var Buffer; Count: Longint): Longint; override;\n function Write(const Buffer; Count: Longint): Longint; override;\n function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;\n property CompressionRate: Single read GetCompressionRate;\n property OnProgress;\n end;\n\n{ TDecompressionStream decompresses data on the fly as data is read from it.\n\n Compressed data comes from a separate source stream. TDecompressionStream\n is read-only and unidirectional; you can seek forward in the stream, but not\n backwards. The special case of setting the stream position to zero is\n allowed. Seeking forward decompresses data until the requested position in\n the uncompressed data has been reached. Seeking backwards, seeking relative\n to the end of the stream, requesting the size of the stream, and writing to\n the stream will raise an exception.\n\n The Position property returns the number of bytes of uncompressed data that\n have been read from the stream so far.\n\n The OnProgress event is called each time the internal input buffer of\n compressed data is exhausted and the next block is read from the input stream.\n This is useful for updating a progress indicator when you are reading a\n large chunk of data from the decompression stream in a single call.}\n\n TBZDecompressionStream = class(TCustomBZip2Stream)\n public\n constructor Create(Source: TStream);\n destructor Destroy; override;\n function Read(var Buffer; Count: Longint): Longint; override;\n function Write(const Buffer; Count: Longint): Longint; override;\n function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;\n property OnProgress;\n end;\n\n{ CompressBuf compresses data, buffer to buffer, in one call.\n In: InBuf = ptr to compressed data\n InBytes = number of bytes in InBuf\n Out: OutBuf = ptr to newly allocated buffer containing decompressed data\n OutBytes = number of bytes in OutBuf }\nprocedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;\n out OutBuf: Pointer; out OutBytes: Integer);\n\n\n{ DecompressBuf decompresses data, buffer to buffer, in one call.\n In: InBuf = ptr to compressed data\n InBytes = number of bytes in InBuf\n OutEstimate = zero, or est. size of the decompressed data\n Out: OutBuf = ptr to newly allocated buffer containing decompressed data\n OutBytes = number of bytes in OutBuf }\nprocedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;\n OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);\n\n\ntype\n EBZip2Error = class(Exception);\n EBZCompressionError = class(EBZip2Error);\n EBZDecompressionError = class(EBZip2Error);\n\nimplementation\n\n// Compile for Win64 using MSVC\n// \\bin\\x86_amd64\\cl.exe -c -nologo -GS- -Z7 -wd4086 -Gs32768\n// -DBZ_NO_STDIO blocksort.c huffman.c compress.c decompress.c bzlib.c\n\nuses\n{$IFDEF Bzip2Runtime}\n{$IF DEFINED(FPC)}\n dynlibs,\n{$ELSEIF DEFINED(MSWINDOWS)}\n Windows,\n{$IFEND}\n{$ENDIF}\n AbUtils;\n\n{$IFDEF Bzip2Static}\n{$IF DEFINED(WIN32)}\n {$L Win32\\blocksort.obj}\n {$L Win32\\huffman.obj}\n {$L Win32\\compress.obj}\n {$L Win32\\decompress.obj}\n {$L Win32\\bzlib.obj}\n{$ELSEIF DEFINED(WIN64)}\n {$L Win64\\blocksort.obj}\n {$L Win64\\huffman.obj}\n {$L Win64\\compress.obj}\n {$L Win64\\decompress.obj}\n {$L Win64\\bzlib.obj}\n{$IFEND}\n\nprocedure BZ2_hbMakeCodeLengths; external;\nprocedure BZ2_blockSort; external;\nprocedure BZ2_hbCreateDecodeTables; external;\nprocedure BZ2_hbAssignCodes; external;\nprocedure BZ2_compressBlock; external;\nprocedure BZ2_decompress; external;\n{$ENDIF}\n\ntype\n TLargeInteger = record\n case Integer of\n 0: (\n LowPart: LongWord;\n HighPart: LongWord);\n 1: (\n QuadPart: Int64);\n end;\n\nconst\n BZ_RUN = 0;\n BZ_FLUSH = 1;\n BZ_FINISH = 2;\n BZ_OK = 0;\n BZ_RUN_OK = 1;\n BZ_FLUSH_OK = 2;\n BZ_FINISH_OK = 3;\n BZ_STREAM_END = 4;\n BZ_SEQUENCE_ERROR = (-1);\n BZ_PARAM_ERROR = (-2);\n BZ_MEM_ERROR = (-3);\n BZ_DATA_ERROR = (-4);\n BZ_DATA_ERROR_MAGIC = (-5);\n BZ_IO_ERROR = (-6);\n BZ_UNEXPECTED_EOF = (-7);\n BZ_OUTBUFF_FULL = (-8);\n\n BZ_BLOCK_SIZE_100K = 9;\n\n{$IFDEF Bzip2Static}\n BZ2_rNums: array[0..511] of Longint = (\n 619, 720, 127, 481, 931, 816, 813, 233, 566, 247,\n 985, 724, 205, 454, 863, 491, 741, 242, 949, 214,\n 733, 859, 335, 708, 621, 574, 73, 654, 730, 472,\n 419, 436, 278, 496, 867, 210, 399, 680, 480, 51,\n 878, 465, 811, 169, 869, 675, 611, 697, 867, 561,\n 862, 687, 507, 283, 482, 129, 807, 591, 733, 623,\n 150, 238, 59, 379, 684, 877, 625, 169, 643, 105,\n 170, 607, 520, 932, 727, 476, 693, 425, 174, 647,\n 73, 122, 335, 530, 442, 853, 695, 249, 445, 515,\n 909, 545, 703, 919, 874, 474, 882, 500, 594, 612,\n 641, 801, 220, 162, 819, 984, 589, 513, 495, 799,\n 161, 604, 958, 533, 221, 400, 386, 867, 600, 782,\n 382, 596, 414, 171, 516, 375, 682, 485, 911, 276,\n 98, 553, 163, 354, 666, 933, 424, 341, 533, 870,\n 227, 730, 475, 186, 263, 647, 537, 686, 600, 224,\n 469, 68, 770, 919, 190, 373, 294, 822, 808, 206,\n 184, 943, 795, 384, 383, 461, 404, 758, 839, 887,\n 715, 67, 618, 276, 204, 918, 873, 777, 604, 560,\n 951, 160, 578, 722, 79, 804, 96, 409, 713, 940,\n 652, 934, 970, 447, 318, 353, 859, 672, 112, 785,\n 645, 863, 803, 350, 139, 93, 354, 99, 820, 908,\n 609, 772, 154, 274, 580, 184, 79, 626, 630, 742,\n 653, 282, 762, 623, 680, 81, 927, 626, 789, 125,\n 411, 521, 938, 300, 821, 78, 343, 175, 128, 250,\n 170, 774, 972, 275, 999, 639, 495, 78, 352, 126,\n 857, 956, 358, 619, 580, 124, 737, 594, 701, 612,\n 669, 112, 134, 694, 363, 992, 809, 743, 168, 974,\n 944, 375, 748, 52, 600, 747, 642, 182, 862, 81,\n 344, 805, 988, 739, 511, 655, 814, 334, 249, 515,\n 897, 955, 664, 981, 649, 113, 974, 459, 893, 228,\n 433, 837, 553, 268, 926, 240, 102, 654, 459, 51,\n 686, 754, 806, 760, 493, 403, 415, 394, 687, 700,\n 946, 670, 656, 610, 738, 392, 760, 799, 887, 653,\n 978, 321, 576, 617, 626, 502, 894, 679, 243, 440,\n 680, 879, 194, 572, 640, 724, 926, 56, 204, 700,\n 707, 151, 457, 449, 797, 195, 791, 558, 945, 679,\n 297, 59, 87, 824, 713, 663, 412, 693, 342, 606,\n 134, 108, 571, 364, 631, 212, 174, 643, 304, 329,\n 343, 97, 430, 751, 497, 314, 983, 374, 822, 928,\n 140, 206, 73, 263, 980, 736, 876, 478, 430, 305,\n 170, 514, 364, 692, 829, 82, 855, 953, 676, 246,\n 369, 970, 294, 750, 807, 827, 150, 790, 288, 923,\n 804, 378, 215, 828, 592, 281, 565, 555, 710, 82,\n 896, 831, 547, 261, 524, 462, 293, 465, 502, 56,\n 661, 821, 976, 991, 658, 869, 905, 758, 745, 193,\n 768, 550, 608, 933, 378, 286, 215, 979, 792, 961,\n 61, 688, 793, 644, 986, 403, 106, 366, 905, 644,\n 372, 567, 466, 434, 645, 210, 389, 550, 919, 135,\n 780, 773, 635, 389, 707, 100, 626, 958, 165, 504,\n 920, 176, 193, 713, 857, 265, 203, 50, 668, 108,\n 645, 990, 626, 197, 510, 357, 358, 850, 858, 364,\n 936, 638\n );\n\n BZ2_crc32Table: array[0..255] of Longint = (\n $00000000, $04C11DB7, $09823B6E, $0D4326D9,\n $130476DC, $17C56B6B, $1A864DB2, $1E475005,\n $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61,\n $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD,\n $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9,\n $5F15ADAC, $5BD4B01B, $569796C2, $52568B75,\n $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011,\n $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD,\n -$67DC4920, -$631D54A9, -$6E5E7272, -$6A9F6FC7,\n -$74D83FC4, -$70192275, -$7D5A04AE, -$799B191B,\n -$41D4A4A8, -$4515B911, -$48569FCA, -$4C97827F,\n -$52D0D27C, -$5611CFCD, -$5B52E916, -$5F93F4A3,\n -$2BCD9270, -$2F0C8FD9, -$224FA902, -$268EB4B7,\n -$38C9E4B4, -$3C08F905, -$314BDFDE, -$358AC26B,\n -$0DC57FD8, -$09046261, -$044744BA, -$0086590F,\n -$1EC1090C, -$1A0014BD, -$17433266, -$13822FD3,\n $34867077, $30476DC0, $3D044B19, $39C556AE,\n $278206AB, $23431B1C, $2E003DC5, $2AC12072,\n $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16,\n $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA,\n $7897AB07, $7C56B6B0, $71159069, $75D48DDE,\n $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02,\n $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066,\n $4D9B3063, $495A2DD4, $44190B0D, $40D816BA,\n -$535A3969, -$579B24E0, -$5AD80207, -$5E191FB2,\n -$405E4FB5, -$449F5204, -$49DC74DB, -$4D1D696E,\n -$7552D4D1, -$7193C968, -$7CD0EFBF, -$7811F20A,\n -$6656A20D, -$6297BFBC, -$6FD49963, -$6B1584D6,\n -$1F4BE219, -$1B8AFFB0, -$16C9D977, -$1208C4C2,\n -$0C4F94C5, -$088E8974, -$05CDAFAB, -$010CB21E,\n -$39430FA1, -$3D821218, -$30C134CF, -$3400297A,\n -$2A47797D, -$2E8664CC, -$23C54213, -$27045FA6,\n $690CE0EE, $6DCDFD59, $608EDB80, $644FC637,\n $7A089632, $7EC98B85, $738AAD5C, $774BB0EB,\n $4F040D56, $4BC510E1, $46863638, $42472B8F,\n $5C007B8A, $58C1663D, $558240E4, $51435D53,\n $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47,\n $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B,\n $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF,\n $1011A0FA, $14D0BD4D, $19939B94, $1D528623,\n -$0ED0A9F2, -$0A11B447, -$075292A0, -$03938F29,\n -$1DD4DF2E, -$1915C29B, -$1456E444, -$1097F9F5,\n -$28D8444A, -$2C1959FF, -$215A7F28, -$259B6291,\n -$3BDC3296, -$3F1D2F23, -$325E09FC, -$369F144D,\n -$42C17282, -$46006F37, -$4B4349F0, -$4F825459,\n -$51C5045E, -$550419EB, -$58473F34, -$5C862285,\n -$64C99F3A, -$6008828F, -$6D4BA458, -$698AB9E1,\n -$77CDE9E6, -$730CF453, -$7E4FD28C, -$7A8ECF3D,\n $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640,\n $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C,\n $7B827D21, $7F436096, $7200464F, $76C15BF8,\n $68860BFD, $6C47164A, $61043093, $65C52D24,\n $119B4BE9, $155A565E, $18197087, $1CD86D30,\n $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC,\n $3793A651, $3352BBE6, $3E119D3F, $3AD08088,\n $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654,\n -$3A56D987, -$3E97C432, -$33D4E2E9, -$3715FF60,\n -$2952AF5B, -$2D93B2EE, -$20D09435, -$24118984,\n -$1C5E343F, -$189F298A, -$15DC0F51, -$111D12E8,\n -$0F5A42E3, -$0B9B5F56, -$06D8798D, -$0219643C,\n -$764702F7, -$72861F42, -$7FC53999, -$7B042430,\n -$6543742B, -$6182699E, -$6CC14F45, -$680052F4,\n -$504FEF4F, -$548EF2FA, -$59CDD421, -$5D0CC998,\n -$434B9993, -$478A8426, -$4AC9A2FD, -$4E08BF4C\n );\n\nprocedure bz_internal_error(errcode: Integer); cdecl;\nbegin\n raise EBZip2Error.CreateFmt('Compression Error %d', [errcode]);\nend; { _bz_internal_error }\n\nfunction malloc(size: Integer): Pointer; cdecl;\nbegin\n GetMem(Result, Size);\nend; { _malloc }\n\nprocedure free(block: Pointer); cdecl;\nbegin\n FreeMem(block);\nend; { _free }\n{$ENDIF}\n\nconst\n libbz2 = {$IF DEFINED(MSWINDOWS)}'libbz2.dll'\n {$ELSEIF DEFINED(DARWIN)}'libbz2.dylib'\n {$ELSE}'libbz2.so.1'{$IFEND};\n\n{$IFDEF Bzip2Runtime}\nvar\n hBzip2: HMODULE;\n // deflate compresses data\n BZ2_bzCompressInit: function(var strm: TBZStreamRec; blockSize100k: Integer;\n verbosity: Integer; workFactor: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n BZ2_bzCompress: function(var strm: TBZStreamRec; action: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n BZ2_bzCompressEnd: function (var strm: TBZStreamRec): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n BZ2_bzBuffToBuffCompress: function(dest: Pointer; var destLen: Integer;\n source: Pointer; sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n // inflate decompresses data\n BZ2_bzDecompressInit: function(var strm: TBZStreamRec; verbosity: Integer;\n small: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n BZ2_bzDecompress: function(var strm: TBZStreamRec): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n BZ2_bzDecompressEnd: function(var strm: TBZStreamRec): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n BZ2_bzBuffToBuffDecompress: function(dest: Pointer; var destLen: Integer;\n source: Pointer; sourceLen, small, verbosity: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}\n{$ELSE}\n// deflate compresses data\nfunction BZ2_bzCompressInit(var strm: TBZStreamRec; blockSize100k: Integer;\n verbosity: Integer; workFactor: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzCompressInit'{$ENDIF};\n\nfunction BZ2_bzCompress(var strm: TBZStreamRec; action: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzCompress'{$ENDIF};\n\nfunction BZ2_bzCompressEnd(var strm: TBZStreamRec): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzCompressEnd'{$ENDIF};\n\nfunction BZ2_bzBuffToBuffCompress(dest: Pointer; var destLen: Integer; source: Pointer;\n sourceLen, blockSize100k, verbosity, workFactor: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzBuffToBuffCompress'{$ENDIF};\n\n// inflate decompresses data\nfunction BZ2_bzDecompressInit(var strm: TBZStreamRec; verbosity: Integer;\n small: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzDecompressInit'{$ENDIF};\n\nfunction BZ2_bzDecompress(var strm: TBZStreamRec): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzDecompress'{$ENDIF};\n\nfunction BZ2_bzDecompressEnd(var strm: TBZStreamRec): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzDecompressEnd'{$ENDIF};\n\nfunction BZ2_bzBuffToBuffDecompress(dest: Pointer; var destLen: Integer; source: Pointer;\n sourceLen, small, verbosity: Integer): Integer;\n {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} external {$IFDEF Bzip2Dynamic}libbz2{$ENDIF}\n {$IFDEF DARWIN}name '_BZ2_bzBuffToBuffDecompress'{$ENDIF};\n{$ENDIF}\n\nprocedure LoadBzip2DLL;\nbegin\n {$IFDEF Bzip2Runtime}\n if hBzip2 <> 0 then\n Exit;\n hBzip2 := LoadLibrary(libbz2);\n if hBzip2 = 0 then\n raise EBZip2Error.Create('Bzip2 shared library not found');\n @BZ2_bzCompressInit := GetProcAddress(hBzip2, 'BZ2_bzCompressInit');\n @BZ2_bzCompress := GetProcAddress(hBzip2, 'BZ2_bzCompress');\n @BZ2_bzCompressEnd := GetProcAddress(hBzip2, 'BZ2_bzCompressEnd');\n @BZ2_bzBuffToBuffCompress := GetProcAddress(hBzip2, 'BZ2_bzBuffToBuffCompress');\n @BZ2_bzDecompressInit := GetProcAddress(hBzip2, 'BZ2_bzDecompressInit');\n @BZ2_bzDecompress := GetProcAddress(hBzip2, 'BZ2_bzDecompress');\n @BZ2_bzDecompressEnd := GetProcAddress(hBzip2, 'BZ2_bzDecompressEnd');\n @BZ2_bzBuffToBuffDecompress := GetProcAddress(hBzip2, 'BZ2_bzBuffToBuffDecompress');\n {$ENDIF}\nend;\n\nfunction bzip2AllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;\nbegin\n GetMem(Result, Items * Size);\nend; { bzip2AllocMem }\n\nprocedure bzip2FreeMem(AppData, Block: Pointer); cdecl;\nbegin\n FreeMem(Block);\nend; { bzip2FreeMem }\n\nfunction CCheck(code: Integer): Integer;\nbegin\n Result := code;\n if code < 0 then\n raise EBZCompressionError.CreateFmt('error %d', [code]); //!!\nend; { CCheck }\n\nfunction DCheck(code: Integer): Integer;\nbegin\n Result := code;\n if code < 0 then\n raise EBZDecompressionError.CreateFmt('error %d', [code]); //!!\nend; { DCheck }\n\nprocedure BZCompressBuf(const InBuf: Pointer; InBytes: Integer;\n out OutBuf: Pointer; out OutBytes: Integer);\nvar\n strm: TBZStreamRec;\n P: Pointer;\nbegin\n LoadBzip2DLL;\n FillChar(strm, sizeof(strm), 0);\n strm.bzalloc := bzip2AllocMem;\n strm.bzfree := bzip2FreeMem;\n OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;\n GetMem(OutBuf, OutBytes);\n try\n strm.next_in := InBuf;\n strm.avail_in := InBytes;\n strm.next_out := OutBuf;\n strm.avail_out := OutBytes;\n CCheck(BZ2_bzCompressInit(strm, 9, 0, 0));\n try\n while CCheck(BZ2_bzCompress(strm, BZ_FINISH)) <> BZ_STREAM_END do\n begin\n P := OutBuf;\n Inc(OutBytes, 256);\n ReallocMem(OutBuf, OutBytes);\n strm.next_out := PByte(PtrInt(OutBuf)\n + (PtrInt(strm.next_out) - PtrInt(P)));\n strm.avail_out := 256;\n end;\n finally\n CCheck(BZ2_bzCompressEnd(strm));\n end;\n ReallocMem(OutBuf, strm.total_out_lo32);\n OutBytes := strm.total_out_lo32;\n except\n FreeMem(OutBuf);\n raise\n end;\nend;\n\nprocedure BZDecompressBuf(const InBuf: Pointer; InBytes: Integer;\n OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);\nvar\n strm: TBZStreamRec;\n P: Pointer;\n BufInc: Integer;\nbegin\n LoadBzip2DLL;\n FillChar(strm, sizeof(strm), 0);\n strm.bzalloc := bzip2AllocMem;\n strm.bzfree := bzip2FreeMem;\n BufInc := (InBytes + 255) and not 255;\n if OutEstimate = 0 then\n OutBytes := BufInc\n else\n OutBytes := OutEstimate;\n GetMem(OutBuf, OutBytes);\n try\n strm.next_in := InBuf;\n strm.avail_in := InBytes;\n strm.next_out := OutBuf;\n strm.avail_out := OutBytes;\n DCheck(BZ2_bzDecompressInit(strm, 0, 0));\n try\n while DCheck(BZ2_bzDecompress(strm)) <> BZ_STREAM_END do\n begin\n P := OutBuf;\n Inc(OutBytes, BufInc);\n ReallocMem(OutBuf, OutBytes);\n strm.next_out := PByte(PtrInt(OutBuf) + (PtrInt(strm.next_out) - PtrInt(P)));\n strm.avail_out := BufInc;\n end;\n finally\n DCheck(BZ2_bzDecompressEnd(strm));\n end;\n ReallocMem(OutBuf, strm.total_out_lo32);\n OutBytes := strm.total_out_lo32;\n except\n FreeMem(OutBuf);\n raise\n end;\nend;\n\n// TCustomBZip2Stream\n\nconstructor TCustomBZip2Stream.Create(Strm: TStream);\nbegin\n inherited Create;\n FStrm := Strm;\n FStrmPos := Strm.Position;\n FBZRec.bzalloc := bzip2AllocMem;\n FBZRec.bzfree := bzip2FreeMem;\nend;\n\nprocedure TCustomBZip2Stream.Progress(Sender: TObject);\nbegin\n if Assigned(FOnProgress) then FOnProgress(Sender);\nend; { TCustomBZip2Stream }\n\n\n// TBZCompressionStream\n\nconstructor TBZCompressionStream.Create(BlockSize100k: TBlockSize100k; Dest: TStream);\nconst\n BlockSizes: array[TBlockSize100k] of ShortInt = (1, 2, 3, 4, 5, 6, 7, 8, 9);\nbegin\n inherited Create(Dest);\n LoadBzip2DLL;\n FBZRec.next_out := @FBuffer[0];\n FBZRec.avail_out := sizeof(FBuffer);\n CCheck(BZ2_bzCompressInit(FBZRec, BlockSizes[BlockSize100k], 0, 0));\nend;\n\ndestructor TBZCompressionStream.Destroy;\nbegin\n if FBZRec.state <> nil then begin\n FBZRec.next_in := nil;\n FBZRec.avail_in := 0;\n try\n if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;\n while (CCheck(BZ2_bzCompress(FBZRec, BZ_FINISH)) <> BZ_STREAM_END)\n and (FBZRec.avail_out = 0) do\n begin\n FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));\n FBZRec.next_out := @FBuffer[0];\n FBZRec.avail_out := sizeof(FBuffer);\n end;\n if FBZRec.avail_out < sizeof(FBuffer) then\n FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FBZRec.avail_out);\n finally\n BZ2_bzCompressEnd(FBZRec);\n end;\n end;\n inherited Destroy;\nend;\n\nfunction TBZCompressionStream.Read(var Buffer; Count: Longint): Longint;\nbegin\n raise EBZCompressionError.Create('Invalid stream operation');\nend; { TBZCompressionStream }\n\nfunction TBZCompressionStream.Write(const Buffer; Count: Longint): Longint;\nbegin\n FBZRec.next_in := @Buffer;\n FBZRec.avail_in := Count;\n if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;\n while (FBZRec.avail_in > 0) do\n begin\n CCheck(BZ2_bzCompress(FBZRec, BZ_RUN));\n if FBZRec.avail_out = 0 then\n begin\n FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));\n FBZRec.next_out := @FBuffer[0];\n FBZRec.avail_out := sizeof(FBuffer);\n FStrmPos := FStrm.Position;\n end;\n Progress(Self);\n end;\n Result := Count;\nend; { TBZCompressionStream }\n\nfunction TBZCompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\nvar\n conv64 : TLargeInteger;\nbegin\n if (Offset = 0) and (Origin = soCurrent) then begin\n conv64.LowPart := FBZRec.total_in_lo32;\n conv64.HighPart := FBZRec.total_in_hi32;\n Result := conv64.QuadPart\n end\n else\n raise EBZCompressionError.Create('Invalid stream operation');\nend; { TBZCompressionStream }\n\nfunction TBZCompressionStream.GetCompressionRate: Single;\nvar\n conv64In : TLargeInteger;\n conv64Out: TLargeInteger;\nbegin\n conv64In.LowPart := FBZRec.total_in_lo32;\n conv64In.HighPart := FBZRec.total_in_hi32;\n conv64Out.LowPart := FBZRec.total_out_lo32;\n conv64Out.HighPart := FBZRec.total_out_hi32;\n\n if conv64In.QuadPart = 0 then\n Result := 0\n else\n Result := (1.0 - (conv64Out.QuadPart / conv64In.QuadPart)) * 100.0;\nend; { TBZCompressionStream }\n\n// TDecompressionStream\n\nconstructor TBZDecompressionStream.Create(Source: TStream);\nbegin\n inherited Create(Source);\n LoadBzip2DLL;\n FBZRec.next_in := @FBuffer[0];\n FBZRec.avail_in := 0;\n DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));\nend;\n\ndestructor TBZDecompressionStream.Destroy;\nbegin\n if FBZRec.state <> nil then\n BZ2_bzDecompressEnd(FBZRec);\n inherited Destroy;\nend;\n\nfunction TBZDecompressionStream.Read(var Buffer; Count: Longint): Longint;\nbegin\n FBZRec.next_out := @Buffer;\n FBZRec.avail_out := Count;\n if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;\n while (FBZRec.avail_out > 0) do\n begin\n if FBZRec.avail_in = 0 then\n begin\n FBZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));\n if FBZRec.avail_in = 0 then\n begin\n Result := Count - FBZRec.avail_out;\n Exit;\n end;\n FBZRec.next_in := @FBuffer[0];\n FStrmPos := FStrm.Position;\n end;\n CCheck(BZ2_bzDecompress(FBZRec));\n Progress(Self);\n end;\n Result := Count;\nend; { TBZDecompressionStream }\n\nfunction TBZDecompressionStream.Write(const Buffer; Count: Longint): Longint;\nbegin\n raise EBZDecompressionError.Create('Invalid stream operation');\nend; { TBZDecompressionStream }\n\nfunction TBZDecompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\nvar\n I : Integer;\n Buf : array[0..4095] of Char;\n conv64: TLargeInteger;\n NewOff: Int64;\nbegin\n conv64.LowPart := FBZRec.total_out_lo32;\n conv64.HighPart := FBZRec.total_out_hi32;\n\n if (Offset = 0) and (Origin = soBeginning) then\n begin\n DCheck(BZ2_bzDecompressEnd(FBZRec));\n DCheck(BZ2_bzDecompressInit(FBZRec, 0, 0));\n FBZRec.next_in := @FBuffer[0];\n FBZRec.avail_in := 0;\n FStrm.Position := 0;\n FStrmPos := 0;\n end\n else if ((Offset >= 0) and (Origin = soCurrent)) or\n (((Offset - conv64.QuadPart) > 0) and (Origin = soBeginning)) then\n begin\n NewOff := Offset;\n if Origin = soBeginning then Dec(NewOff, conv64.QuadPart);\n if NewOff > 0 then\n begin\n for I := 1 to NewOff div sizeof(Buf) do\n ReadBuffer(Buf, sizeof(Buf));\n ReadBuffer(Buf, NewOff mod sizeof(Buf));\n end;\n end\n else\n raise EBZDecompressionError.Create('Invalid stream operation');\n Result := conv64.QuadPart;\nend; { TBZDecompressionStream }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbBzip2Typ.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * Joel Haynie\n * Craig Peterson\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbBzip2Typ.pas *}\n{*********************************************************}\n{* ABBREVIA: TAbBzip2Archive, TAbBzip2Item classes *}\n{*********************************************************}\n{* Misc. constants, types, and routines for working *}\n{* with Bzip2 files *}\n{*********************************************************}\n\nunit AbBzip2Typ;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbArcTyp, AbTarTyp, AbUtils;\n\nconst\n { Default Stream Header for Bzip2s is 'BZhX', where X is the block size setting 1-9 in ASCII }\n { Each block has the following header: '1AY&SY', and are in units of 100kilobytes NOT 100kibiBytes }\n AB_BZIP2_FILE_HEADER = 'BZh';\n AB_BZIP2_BLOCK_SIZE = ['1','2','3','4','5','6','7','8','9'];\n AB_BZIP2_BLOCK_HEADER = '1AY&SY'; { Note: $314159265359, BCD for Pi :) }\n { Note that Blocks are bit aligned, as such the only time you will \"for sure\" see\n the block header is on the start of stream/File }\n AB_BZIP2_FILE_TAIL =#23#114#36#83#133#9#0; { $1772245385090, BCD for sqrt(Pi) :) }\n { This is odd as the blocks are bit allgned so this is a string that is 13*4 bits = 52 bits }\n\ntype\n PAbBzip2Header = ^TAbBzip2Header; { File Header }\n TAbBzip2Header = packed record { SizeOf(TAbBzip2Header) = 10 }\n FileHeader : array[0..2] of AnsiChar;{ 'BZh'; $42,5A,68 }\n BlockSize : AnsiChar; { '1'..'9'; $31-$39 }\n BlockHeader : array[0..5] of AnsiChar;{ '1AY&SY'; $31,41,59,26,53,59 }\n end;\n\n{ The Purpose for this Item is the placeholder for aaAdd and aaDelete Support. }\n{ For all intents and purposes we could just use a TAbArchiveItem }\ntype\n TAbBzip2Item = class(TabArchiveItem);\n\n TAbBzip2ArchiveState = (gsBzip2, gsTar);\n\n TAbBzip2Archive = class(TAbTarArchive)\n private\n FBzip2Stream : TStream; { stream for Bzip2 file}\n FBzip2Item : TAbArchiveList; { item in bzip2 (only one, but need polymorphism of class)}\n FTarStream : TStream; { stream for possible contained Tar }\n FTarList : TAbArchiveList; { items in possible contained Tar }\n FTarAutoHandle: Boolean;\n FState : TAbBzip2ArchiveState;\n FIsBzippedTar : Boolean;\n\n procedure DecompressToStream(aStream: TStream);\n procedure SetTarAutoHandle(const Value: Boolean);\n procedure SwapToBzip2;\n procedure SwapToTar;\n\n protected\n { Inherited Abstract functions }\n function CreateItem(const FileSpec : string): TAbArchiveItem; override;\n procedure ExtractItemAt(Index : Integer; const NewName : string); override;\n procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream); override;\n procedure LoadArchive; override;\n procedure SaveArchive; override;\n procedure TestItemAt(Index : Integer); override;\n function GetSupportsEmptyFolders : Boolean; override;\n\n public {methods}\n constructor CreateFromStream(aStream : TStream; const aArchiveName : string); override;\n destructor Destroy; override;\n\n procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer;\n var ImageName : string; var Abort : Boolean); override;\n\n { Properties }\n property TarAutoHandle : Boolean\n read FTarAutoHandle write SetTarAutoHandle;\n\n property IsBzippedTar : Boolean\n read FIsBzippedTar write FIsBzippedTar;\n end;\n\nfunction VerifyBzip2(Strm : TStream) : TAbArchiveType;\n\nimplementation\n\nuses\n{$IFDEF MSWINDOWS}\n Windows, // Fix inline warnings\n{$ENDIF}\n StrUtils, SysUtils,\n AbBzip2, AbExcept, AbVMStrm, AbBitBkt;\n\n{ ****************** Helper functions Not from Classes Above ***************** }\nfunction VerifyHeader(const Header : TAbBzip2Header) : Boolean;\nbegin\n Result := (Header.FileHeader = AB_BZIP2_FILE_HEADER) and\n (Header.BlockSize in AB_BZIP2_BLOCK_SIZE) and\n (Header.BlockHeader = AB_BZIP2_BLOCK_HEADER);\nend;\n{ -------------------------------------------------------------------------- }\nfunction VerifyBzip2(Strm : TStream) : TAbArchiveType;\nvar\n Hdr : TAbBzip2Header;\n CurPos : int64;\n DecompStream, TarStream: TStream;\nbegin\n Result := atUnknown;\n\n CurPos := Strm.Position;\n Strm.Seek(0, soBeginning);\n\n try\n if (Strm.Read(Hdr, SizeOf(Hdr)) = SizeOf(Hdr)) and VerifyHeader(Hdr) then begin\n Result := atBzip2;\n { Check for embedded TAR }\n Strm.Seek(0, soBeginning);\n DecompStream := TBZDecompressionStream.Create(Strm);\n try\n TarStream := TMemoryStream.Create;\n try\n TarStream.CopyFrom(DecompStream, 512 * 2);\n TarStream.Seek(0, soBeginning);\n if VerifyTar(TarStream) = atTar then\n Result := atBzippedTar;\n finally\n TarStream.Free;\n end;\n finally\n DecompStream.Free;\n end;\n end;\n except\n on EReadError do\n Result := atUnknown;\n end;\n Strm.Position := CurPos; { Return to original position. }\nend;\n\n\n{ ****************************** TAbBzip2Archive ***************************** }\nconstructor TAbBzip2Archive.CreateFromStream(aStream: TStream;\n const aArchiveName: string);\nbegin\n inherited CreateFromStream(aStream, aArchiveName);\n FState := gsBzip2;\n FBzip2Stream := FStream;\n FBzip2Item := FItemList;\n FTarStream := TAbVirtualMemoryStream.Create;\n FTarList := TAbArchiveList.Create(True);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.SwapToTar;\nbegin\n FStream := FTarStream;\n FItemList := FTarList;\n FState := gsTar;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.SwapToBzip2;\nbegin\n FStream := FBzip2Stream;\n FItemList := FBzip2Item;\n FState := gsBzip2;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBzip2Archive.CreateItem(const FileSpec: string): TAbArchiveItem;\nbegin\n if IsBzippedTar and TarAutoHandle then begin\n SwapToTar;\n Result := inherited CreateItem(FileSpec);\n end\n else begin\n SwapToBzip2;\n Result := TAbBzip2Item.Create;\n try\n Result.DiskFileName := ExpandFileName(FileSpec);\n Result.FileName := FixName(FileSpec);\n except\n Result.Free;\n raise;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbBzip2Archive.Destroy;\nbegin\n SwapToBzip2;\n FTarList.Free;\n FTarStream.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.ExtractItemAt(Index: Integer;\n const NewName: string);\nvar\n OutStream : TFileStream;\nbegin\n if IsBzippedTar and TarAutoHandle then begin\n SwapToTar;\n inherited ExtractItemAt(Index, NewName);\n end\n else begin\n SwapToBzip2;\n OutStream := TFileStream.Create(NewName, fmCreate or fmShareDenyNone);\n try\n try\n ExtractItemToStreamAt(Index, OutStream);\n finally\n OutStream.Free;\n end;\n { Bz2 doesn't store the last modified time or attributes, so don't set them }\n except\n on E : EAbUserAbort do begin\n FStatus := asInvalid;\n if FileExists(NewName) then\n DeleteFile(NewName);\n raise;\n end else begin\n if FileExists(NewName) then\n DeleteFile(NewName);\n raise;\n end;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.ExtractItemToStreamAt(Index: Integer;\n aStream: TStream);\nbegin\n if IsBzippedTar and TarAutoHandle then begin\n SwapToTar;\n inherited ExtractItemToStreamAt(Index, aStream);\n end\n else begin\n SwapToBzip2;\n { Index ignored as there's only one item in a Bz2 }\n DecompressToStream(aStream);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBzip2Archive.GetSupportsEmptyFolders : Boolean;\nbegin\n Result := IsBzippedTar and TarAutoHandle;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.LoadArchive;\nvar\n Item: TAbBzip2Item;\n Abort: Boolean;\n ItemName: string;\nbegin\n if FBzip2Stream.Size = 0 then\n Exit;\n\n if IsBzippedTar and TarAutoHandle then begin\n { Decompress and send to tar LoadArchive }\n DecompressToStream(FTarStream);\n SwapToTar;\n inherited LoadArchive;\n end\n else begin\n SwapToBzip2;\n Item := TAbBzip2Item.Create;\n Item.Action := aaNone;\n { Filename isn't stored, so constuct one based on the archive name }\n ItemName := ExtractFileName(ArchiveName);\n if ItemName = '' then\n Item.FileName := 'unknown'\n else if AnsiEndsText('.tbz', ItemName) or AnsiEndsText('.tbz2', ItemName) then\n Item.FileName := ChangeFileExt(ItemName, '.tar')\n else\n Item.FileName := ChangeFileExt(ItemName, '');\n Item.DiskFileName := Item.FileName;\n FItemList.Add(Item);\n end;\n DoArchiveProgress(100, Abort);\n FIsDirty := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.SaveArchive;\nvar\n CompStream: TStream;\n i: Integer;\n CurItem: TAbBzip2Item;\n InputFileStream: TStream;\nbegin\n if IsBzippedTar and TarAutoHandle then\n begin\n SwapToTar;\n inherited SaveArchive;\n FTarStream.Position := 0;\n FBzip2Stream.Size := 0;\n CompStream := TBZCompressionStream.Create(bs9, FBzip2Stream);\n try\n CompStream.CopyFrom(FTarStream, 0);\n finally\n CompStream.Free;\n end;\n end\n else begin\n { Things we know: There is only one file per archive.}\n { Actions we have to address in SaveArchive: }\n { aaNone & aaMove do nothing, as the file does not change, only the meta data }\n { aaDelete could make a zero size file unless there are two files in the list.}\n { aaAdd, aaStreamAdd, aaFreshen, & aaReplace will be the only ones to take action. }\n SwapToBzip2;\n for i := 0 to pred(Count) do begin\n FCurrentItem := ItemList[i];\n CurItem := TAbBzip2Item(ItemList[i]);\n case CurItem.Action of\n aaNone, aaMove: Break;{ Do nothing; bz2 doesn't store metadata }\n aaDelete: ; {doing nothing omits file from new stream}\n aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin\n FBzip2Stream.Size := 0;\n CompStream := TBZCompressionStream.Create(bs9, FBzip2Stream);\n try\n if CurItem.Action = aaStreamAdd then\n CompStream.CopyFrom(InStream, 0){ Copy/compress entire Instream to FBzip2Stream }\n else begin\n InputFileStream := TFileStream.Create(CurItem.DiskFileName, fmOpenRead or fmShareDenyWrite );\n try\n CompStream.CopyFrom(InputFileStream, 0);{ Copy/compress entire Instream to FBzip2Stream }\n finally\n InputFileStream.Free;\n end;\n end;\n finally\n CompStream.Free;\n end;\n Break;\n end; { End aaAdd, aaFreshen, aaReplace, & aaStreamAdd }\n end; { End of CurItem.Action Case }\n end; { End Item for loop }\n end; { End Tar Else }\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.SetTarAutoHandle(const Value: Boolean);\nbegin\n if Value then\n SwapToTar\n else\n SwapToBzip2;\n FTarAutoHandle := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.DecompressToStream(aStream: TStream);\nconst\n BufSize = $F000;\nvar\n DecompStream: TBZDecompressionStream;\n Buffer: PByte;\n N: Integer;\nbegin\n DecompStream := TBZDecompressionStream.Create(FBzip2Stream);\n try\n GetMem(Buffer, BufSize);\n try\n N := DecompStream.Read(Buffer^, BufSize);\n while N > 0 do begin\n aStream.WriteBuffer(Buffer^, N);\n N := DecompStream.Read(Buffer^, BufSize);\n end;\n finally\n FreeMem(Buffer, BufSize);\n end;\n finally\n DecompStream.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.TestItemAt(Index: Integer);\nvar\n Bzip2Type: TAbArchiveType;\n BitBucket: TAbBitBucketStream;\nbegin\n if IsBzippedTar and TarAutoHandle then begin\n SwapToTar;\n inherited TestItemAt(Index);\n end\n else begin\n { note Index ignored as there's only one item in a GZip }\n Bzip2Type := VerifyBzip2(FBzip2Stream);\n if not (Bzip2Type in [atBzip2, atBzippedTar]) then\n raise EAbGzipInvalid.Create;// TODO: Add bzip2-specific exceptions }\n BitBucket := TAbBitBucketStream.Create(1024);\n try\n DecompressToStream(BitBucket);\n finally\n BitBucket.Free;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBzip2Archive.DoSpanningMediaRequest(Sender: TObject;\n ImageNumber: Integer; var ImageName: string; var Abort: Boolean);\nbegin\n Abort := False;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCBrows.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCBrows.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet file browser component *}\n{*********************************************************}\n\nunit AbCBrows;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbBrowse,\n AbCabTyp;\n\ntype\n TAbCustomCabBrowser = class(TAbBaseBrowser)\n protected {private}\n FSetID : Word;\n\n function GetCabArchive : TAbCabArchive;\n function GetCabSize : Longint;\n function GetCurrentCab : Word;\n function GetFolderCount : Word;\n function GetItem(Index : Integer) : TAbCabItem; virtual;\n function GetHasNext : Boolean;\n function GetHasPrev : Boolean;\n function GetSetID : Word;\n procedure InitArchive;\n override;\n procedure SetFileName(const aFileName : string); override;\n procedure SetSetID(Value : Word);\n\n protected {properties}\n property CabSize : Longint\n read GetCabSize;\n property CurrentCab : Word\n read GetCurrentCab;\n property FolderCount : Word\n read GetFolderCount;\n property HasNext : Boolean\n read GetHasNext;\n property HasPrev : Boolean\n read GetHasPrev;\n property SetID : Word\n read GetSetID\n write SetSetID;\n\n public {methods}\n constructor Create(AOwner : TComponent);\n override;\n destructor Destroy;\n override;\n\n public {properties}\n property CabArchive : TAbCabArchive\n read GetCabArchive;\n property Items[Index : Integer] : TAbCabItem\n read GetItem; default;\n end;\n\n\ntype\n {$IFDEF HasPlatformsAttribute}\n [ComponentPlatformsAttribute(pidWin32 or pidWin64)]\n {$ENDIF}\n TAbCabBrowser = class(TAbCustomCabBrowser)\n published\n property ArchiveProgressMeter;\n property BaseDirectory;\n property CabSize;\n property CurrentCab;\n property FolderCount;\n property HasNext;\n property HasPrev;\n property ItemProgressMeter;\n property LogFile;\n property Logging;\n property OnArchiveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnLoad;\n property SetID;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad}\n end;\n {.Z+}\n\n\nimplementation\n\nuses\n SysUtils,\n AbArcTyp,\n AbUtils;\n\n{ TAbCustomCabBrowser ====================================================== }\nconstructor TAbCustomCabBrowser.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\n FArchiveType := atCab;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomCabBrowser.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetCabArchive : TAbCabArchive;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive)\n else\n Result := nil;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetCabSize : Longint;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive).CabSize\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetCurrentCab : Word;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive).CurrentCab\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetFolderCount : Word;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive).FolderCount\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetHasNext : Boolean;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive).HasNext\n else\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetHasPrev : Boolean;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive).HasPrev\n else\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetItem(Index : Integer) : TAbCabItem;\n {return cabinet item}\nbegin\n if Assigned(CabArchive) then\n Result := CabArchive.Items[Index]\n else\n Result := nil;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomCabBrowser.GetSetID : Word;\nbegin\n if Assigned(Archive) then\n Result := TAbCabArchive(Archive).SetID\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabBrowser.InitArchive;\nbegin\n inherited InitArchive;\n if Assigned(Archive) then\n TAbCabArchive(Archive).SetID := FSetID;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabBrowser.SetFileName(const aFileName : string);\n {open/create cabinet archive}\nbegin\n FFileName := aFileName;\n if (csDesigning in ComponentState) then\n Exit;\n if Assigned(FArchive) then begin\n FArchive.Free;\n FArchive := nil;\n end;\n if (aFileName <> '') and\n FileExists(aFilename) and\n (AbDetermineArcType(aFileName, atCab) = atCab) then\n begin\n FArchive := TAbCabArchive.Create(aFileName, fmOpenRead);\n InitArchive;\n FArchive.Load;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabBrowser.SetSetID(Value : Word);\nbegin\n FSetID := Value;\n if Assigned(Archive) then\n TAbCabArchive(Archive).SetID := Value;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCView.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCView.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet archive viewer component *}\n{* Use AbQCView.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nUnit AbCView;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Windows, Classes,\n {$IFDEF UsingClx}\n AbQView,\n {$ELSE}\n AbView,\n {$ENDIF}\n AbCBrows,\n AbCabTyp, AbArcTyp;\n\ntype\n TAbCabView = class(TAbBaseViewer)\n protected\n FCabComponent : TAbCustomCabBrowser;\n FEmptyItemList: TAbArchiveList;\n function GetItem(RowNum : Longint) : TAbCabItem;\n procedure SetCabComponent(Value : TAbCustomCabBrowser);\n procedure Notification(AComponent : TComponent; Operation : TOperation);\n override;\n procedure DoChange(Sender : TObject);\n override;\n public\n constructor Create(AOwner : TComponent);\n override;\n destructor Destroy;\n override;\n property Items[RowNum : Longint] : TAbCabItem\n read GetItem;\n published {properties}\n property Align;\n property Attributes;\n property BorderStyle;\n property Color;\n property Colors;\n{$IFNDEF UsingClx}\n property Ctl3D;\n{$ENDIF}\n property Cursor;\n property Headings;\n property DefaultColWidth;\n property DefaultRowHeight;\n property DisplayOptions;\n property HeaderRowHeight;\n property SortAttributes;\n{$IFNDEF UsingClx}\n property DragCursor;\n{$ENDIF}\n property DragMode;\n property Enabled;\n property Font;\n property ParentColor;\n{$IFNDEF UsingClx}\n property ParentCtl3D;\n{$ENDIF}\n property ParentFont;\n property ParentShowHint;\n property PopupMenu;\n property ShowHint;\n property TabOrder;\n property TabStop;\n property Version;\n property CabComponent : TAbCustomCabBrowser\n read FCabComponent write SetCabComponent;\n published {Events}\n property OnChange;\n property OnClick;\n property OnDblClick;\n property OnEnter;\n property OnExit;\n property OnKeyDown;\n property OnKeyPress;\n property OnKeyUp;\n property OnMouseDown;\n property OnMouseMove;\n property OnMouseUp;\n property OnSorted;\n property OnDrawSortArrow;\nend;\n\n\nimplementation\n\ntype\n TAbCabBrowserFriend = class(TAbCustomCabBrowser);\n\n\n{ ===== TAbCabView ========================================================= }\nconstructor TAbCabView.Create(AOwner : TComponent);\nbegin\n inherited;\n FEmptyItemList := FItemList;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCabView.Destroy;\nbegin\n FItemList := FEmptyItemList;\n inherited;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCabView.GetItem(RowNum : Longint) : TAbCabItem;\nbegin\n if Assigned(FItemList) then\n Result := TAbCabItem(FItemList.Items[FRowMap[RowNum]])\n else\n Result := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabView.Notification(AComponent : TComponent; Operation : TOperation);\nbegin\n inherited Notification(AComponent, Operation);\n if Operation = opRemove then\n if Assigned(FCabComponent) and (AComponent = FCabComponent) then begin\n FCabComponent := nil;\n Refresh;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabView.SetCabComponent(Value : TAbCustomCabBrowser);\nbegin\n FCabComponent := Value;\n FCabComponent.OnChange := DoChange;\n FCabComponent.OnLoad := DoLoad;\n DoChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabView.DoChange(Sender : TObject);\nbegin\n if Assigned(FCabComponent) and Assigned(TAbCabBrowserFriend(FCabComponent).Archive) then\n FItemList := TAbCabBrowserFriend(FCabComponent).Archive.ItemList\n else if FEmptyItemList <> nil then\n FItemList := FEmptyItemList;\n inherited DoChange(Sender);\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbCabExt.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCabExt.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet file extractor component *}\n{*********************************************************}\n\nunit AbCabExt;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbCBrows, \n AbArcTyp;\n\ntype\n TAbCustomCabExtractor = class(TAbCustomCabBrowser)\n protected {private}\n FExtractOptions : TAbExtractOptions;\n FOnConfirmOverwrite : TAbConfirmOverwriteEvent;\n\n procedure DoConfirmOverwrite(var Name : string;\n var Confirm : Boolean);\n procedure InitArchive;\n override;\n procedure SetExtractOptions( Value : TAbExtractOptions );\n\n protected {properties}\n property ExtractOptions : TAbExtractOptions\n read FExtractOptions\n write SetExtractOptions\n default AbDefExtractOptions;\n property OnConfirmOverwrite : TAbConfirmOverwriteEvent\n read FOnConfirmOverwrite\n write FOnConfirmOverwrite;\n\n public\n constructor Create( AOwner : TComponent ); override;\n destructor Destroy; override;\n\n procedure ExtractAt(Index : Integer; const NewName : string);\n procedure ExtractFiles(const FileMask : string);\n procedure ExtractFilesEx(const FileMask, ExclusionMask : string);\n procedure ExtractTaggedItems;\n end;\n\n {$IFDEF HasPlatformsAttribute}\n [ComponentPlatformsAttribute(pidWin32 or pidWin64)]\n {$ENDIF}\n TAbCabExtractor = class(TAbCustomCabExtractor)\n published\n property ArchiveProgressMeter;\n property BaseDirectory;\n property CabSize;\n property CurrentCab;\n property ExtractOptions;\n property FolderCount;\n property HasNext;\n property HasPrev;\n property ItemProgressMeter;\n property OnArchiveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmOverwrite;\n property OnConfirmProcessItem;\n property OnLoad;\n property OnProcessItemFailure;\n property OnRequestImage;\n property SetID;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad}\n end;\n {.Z+}\n\n\nimplementation\n\nuses\n AbExcept;\n\n{ TAbCustomCabExtractor ==================================================== }\nconstructor TAbCustomCabExtractor.Create(AOwner : TComponent);\nbegin\n inherited Create( AOwner );\n ExtractOptions := AbDefExtractOptions;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomCabExtractor.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.DoConfirmOverwrite\n (var Name : string;\n var Confirm : Boolean);\nbegin\n if Assigned(FOnConfirmOverwrite) then\n FOnConfirmOverwrite(Name, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.ExtractAt(Index : Integer;\n const NewName : string);\n {extract a file from the archive that match the index}\nbegin\n if Assigned( CabArchive ) then\n CabArchive.ExtractAt( Index, NewName )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.ExtractFiles(const FileMask : string);\n {Extract files from the cabinet matching the filemask}\nbegin\n if Assigned( CabArchive ) then\n CabArchive.ExtractFiles( FileMask )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.ExtractFilesEx(const FileMask, ExclusionMask : string);\n {Extract files from the cabinet matching the FileMask, exluding those\n matching ExclusionMask}\nbegin\n if Assigned( CabArchive ) then\n CabArchive.ExtractFilesEx( FileMask, ExclusionMask )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.ExtractTaggedItems;\n {Extract items in the archive that have been tagged}\nbegin\n if Assigned( CabArchive ) then\n CabArchive.ExtractTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.InitArchive;\n {Archive now points to the Cab file, update all Archive's properties...}\nbegin\n inherited InitArchive;\n if Assigned( CabArchive ) then begin\n {poperties}\n CabArchive.ExtractOptions := FExtractOptions;\n {events}\n CabArchive.OnConfirmOverwrite := DoConfirmOverwrite;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabExtractor.SetExtractOptions( Value : TAbExtractOptions );\nbegin\n FExtractOptions := Value;\n if Assigned( FArchive ) then\n FArchive.ExtractOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbCabKit.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCabKit.PAS *}\n{*********************************************************}\n{* ABBREVIA: Cabinet file builder/extractor component *}\n{*********************************************************}\n\nunit AbCabKit;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes, AbArcTyp,\n AbCabMak;\n\ntype\n TAbCustomCabKit = class(TAbCustomMakeCab)\n protected {private}\n FExtractOptions : TAbExtractOptions;\n FOnConfirmOverwrite : TAbConfirmOverwriteEvent;\n\n procedure DoConfirmOverwrite(var Name : string;\n var Confirm : Boolean);\n procedure InitArchive; override;\n procedure SetExtractOptions( Value : TAbExtractOptions );\n procedure SetFileName(const aFileName : string); override;\n\n\n protected {properties}\n property ExtractOptions : TAbExtractOptions\n read FExtractOptions\n write SetExtractOptions\n default AbDefExtractOptions;\n\n protected {events}\n property OnConfirmOverwrite : TAbConfirmOverwriteEvent\n read FOnConfirmOverwrite\n write FOnConfirmOverwrite;\n\n public {methods}\n constructor Create( AOwner : TComponent ); override;\n destructor Destroy; override;\n\n procedure ExtractAt(Index : Integer; const NewName : string);\n procedure ExtractFiles(const FileMask : string);\n procedure ExtractFilesEx(const FileMask, ExclusionMask : string);\n procedure ExtractTaggedItems;\n end;\n\n {$IFDEF HasPlatformsAttribute}\n [ComponentPlatformsAttribute(pidWin32 or pidWin64)]\n {$ENDIF}\n TAbCabKit = class(TAbCustomCabKit)\n published\n property ArchiveProgressMeter;\n property BaseDirectory;\n property CabSize;\n property CompressionType;\n property CurrentCab;\n property ExtractOptions;\n property FolderCount;\n property FolderThreshold;\n property HasNext;\n property HasPrev;\n property ItemProgressMeter;\n property OnArchiveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmOverwrite;\n property OnConfirmProcessItem;\n property OnLoad;\n property OnProcessItemFailure;\n property OnRequestImage;\n property OnSave;\n property SetID;\n property SpanningThreshold;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad}\n end;\n\n\nimplementation\n\nuses\n SysUtils,\n AbExcept,\n AbCabTyp,\n AbCBrows;\n\n{ TAbCustomCabKit ==================================================== }\nconstructor TAbCustomCabKit.Create(AOwner : TComponent);\nbegin\n inherited Create( AOwner );\n ExtractOptions := AbDefExtractOptions;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomCabKit.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.DoConfirmOverwrite(var Name : string;\n var Confirm : Boolean);\nbegin\n if Assigned(FOnConfirmOverwrite) then\n FOnConfirmOverwrite(Name, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.ExtractAt(Index : Integer; const NewName : string);\n {extract a file from the archive that match the index}\nbegin\n if Assigned( CabArchive ) then\n CabArchive.ExtractAt( Index, NewName )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.ExtractFiles(const FileMask : string);\n {Extract files from the cabinet matching the filemask}\nbegin\n if Assigned(CabArchive) then\n CabArchive.ExtractFiles(FileMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.ExtractFilesEx(const FileMask, ExclusionMask : string);\n {Extract files from the cabinet matching the FileMask, exluding those\n matching ExclusionMask}\nbegin\n if Assigned(CabArchive) then\n CabArchive.ExtractFilesEx(FileMask, ExclusionMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.ExtractTaggedItems;\n {Extract items in the archive that have been tagged}\nbegin\n if Assigned(CabArchive) then\n CabArchive.ExtractTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.InitArchive;\nbegin\n inherited InitArchive;\n if Assigned( CabArchive ) then begin\n {poperties}\n CabArchive.ExtractOptions := FExtractOptions;\n {events}\n CabArchive.OnConfirmOverwrite := DoConfirmOverwrite;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.SetExtractOptions( Value : TAbExtractOptions );\nbegin\n FExtractOptions := Value;\n if Assigned( FArchive ) then\n FArchive.ExtractOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomCabKit.SetFileName(const aFileName : string);\n {Create or open the specified cabinet file}\nbegin\n FFilename := aFileName;\n if csDesigning in ComponentState then\n Exit;\n if Assigned(FArchive) then begin\n FArchive.Free;\n FArchive := nil;\n end;\n if (aFileName <> '') then begin\n if (aFileName <> '') and FileExists(aFilename) then\n FArchive := TAbCabArchive.Create(aFileName, fmOpenRead)\n else\n FArchive := TAbCabArchive.Create(aFileName, fmOpenWrite);\n InitArchive;\n FArchive.Load;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCabMak.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCabMak.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet builder component (VCL) *}\n{* See AbQCabMk.pas for the CLX header *}\n{*********************************************************}\n\nunit AbCabMak;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbCBrows,\n AbArcTyp, AbCabTyp;\n\ntype\n TAbCustomMakeCab = class(TAbCustomCabBrowser)\n protected {private}\n FFolderThreshold : Longint;\n FCompressionType : TAbCabCompressionType;\n FStoreOptions : TAbStoreOptions;\n FOnSave : TAbArchiveEvent;\n\n protected {methods}\n procedure DoSave(Sender : TObject); virtual;\n procedure InitArchive; override;\n procedure SetFolderThreshold(Value : Longint);\n procedure SetCompressionType(Value : TAbCabCompressionType);\n procedure SetFileName(const aFileName : string); override;\n procedure SetStoreOptions( Value : TAbStoreOptions );\n\n protected {properties}\n property CompressionType : TAbCabCompressionType\n read FCompressionType\n write SetCompressionType;\n property FolderThreshold : Longint\n read FFolderThreshold\n write SetFolderThreshold;\n property StoreOptions : TAbStoreOptions\n read FStoreOptions\n write SetStoreOptions\n default AbDefStoreOptions;\n\n protected {events}\n property OnSave : TAbArchiveEvent\n read FOnSave\n write FOnSave;\n\n public {methods}\n constructor Create( AOwner : TComponent ); override;\n procedure AddFiles(const FileMask : string; SearchAttr : Integer );\n procedure AddFilesEx(const FileMask : string;\n const ExclusionMask : string; SearchAttr : Integer );\n procedure StartNewFolder;\n procedure StartNewCabinet;\n end;\n\ntype\n {$IFDEF HasPlatformsAttribute}\n [ComponentPlatformsAttribute(pidWin32 or pidWin64)]\n {$ENDIF}\n TAbMakeCab = class(TAbCustomMakeCab)\n published\n property ArchiveProgressMeter;\n property BaseDirectory;\n property CabSize;\n property CompressionType;\n property FolderThreshold;\n property ItemProgressMeter;\n property StoreOptions;\n property OnArchiveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmProcessItem;\n property OnLoad;\n property OnProcessItemFailure;\n property OnRequestImage;\n property OnSave;\n property SetID;\n property SpanningThreshold;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad}\n end;\n {.Z+}\n\n\nimplementation\n\nuses\n SysUtils,\n AbExcept,\n AbUtils;\n\n{ TAbCustomMakeCab ========================================================= }\nconstructor TAbCustomMakeCab.Create( AOwner : TComponent );\nbegin\n inherited Create( AOwner );\n FCompressionType := AbDefCompressionType;\n FSpanningThreshold := AbDefCabSpanningThreshold;\n FFolderThreshold := AbDefFolderThreshold;\n FSetID := 0;\n FStoreOptions := AbDefStoreOptions;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.AddFiles(const FileMask : string; SearchAttr : Integer );\n {Add files to the cabinet where the disk filespec matches}\nbegin\n if Assigned(CabArchive) then\n CabArchive.AddFiles(FileMask, SearchAttr)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.AddFilesEx(const FileMask : string;\n const ExclusionMask : string;\n SearchAttr : Integer);\n {Add files that match Filemask except those matching ExclusionMask}\nbegin\n if Assigned(CabArchive) then\n CabArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.DoSave(Sender : TObject);\nbegin\n if Assigned(FOnSave) then\n FOnSave(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.InitArchive;\nbegin\n inherited InitArchive;\n if Assigned(CabArchive) then begin\n {properties}\n CabArchive.FolderThreshold := FFolderThreshold;\n CabArchive.CompressionType := FCompressionType;\n CabArchive.SetID := FSetID;\n CabArchive.StoreOptions := FStoreOptions;\n {events}\n CabArchive.OnSave := DoSave;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.SetCompressionType(Value : TAbCabCompressionType);\n {Set the type of compression to use}\nbegin\n FCompressionType := Value;\n if Assigned(CabArchive) then\n CabArchive.CompressionType := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.SetFileName(const aFileName : string);\n {Create the specified cabinet file}\nbegin\n FFilename := aFileName;\n if csDesigning in ComponentState then\n Exit;\n if Assigned(FArchive) then begin\n FArchive.Free;\n FArchive := nil;\n end;\n if (aFileName <> '') then begin\n FArchive := TAbCabArchive.Create(aFileName, fmOpenWrite);\n InitArchive;\n FArchive.Load;\n FArchiveType := atCab;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.SetFolderThreshold(Value : Longint);\n {Set folder compression boundary}\nbegin\n FFolderThreshold := Value;\n if Assigned(CabArchive) then\n CabArchive.FolderThreshold := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.SetStoreOptions(Value : TAbStoreOptions);\nbegin\n FStoreOptions := Value;\n if Assigned(CabArchive) then\n CabArchive.StoreOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.StartNewCabinet;\n {Flush current cabinet and start a new one}\nbegin\n if Assigned(CabArchive) then\n CabArchive.NewCabinet\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMakeCab.StartNewFolder;\n {Flush current folder and start a new one}\nbegin\n if Assigned(CabArchive) then\n CabArchive.NewFolder\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCabTyp.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCabTyp.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet Archive *}\n{* Based on info from the FCI/FDI Library Description, *}\n{* included in the Microsoft Cabinet SDK *}\n{*********************************************************}\n\nunit AbCabTyp;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Windows, Classes, AbFciFdi, AbArcTyp, AbUtils;\n\ntype\n TAbCabItem = class(TAbArchiveItem)\n protected {private}\n FPartialFile : Boolean;\n FRawFileName : AnsiString;\n public\n property PartialFile : Boolean\n read FPartialFile\n write FPartialFile;\n property RawFileName : AnsiString\n read FRawFileName\n write FRawFileName;\n end;\n\ntype\n TAbCabCompressionType = (ctNone, ctMSZIP, ctLZX);\n TAbCabinetMode = (cmRead, cmWrite);\n TAbCabStatus = (csFile, csFolder, csCabinet);\n\n\nconst\n faExtractAndExecute = $040;\n faUTF8Name = $080;\n AbDefCabSpanningThreshold = 0;\n AbDefFolderThreshold = 0;\n AbDefCompressionType = ctMSZIP;\n AbDefReserveHeaderSize = 0;\n AbDefReserveFolderSize = 0;\n AbDefReserveDataSize = 0;\n AbDefLZXWindowSize = 18;\n\n CompressionTypeMap : array[TAbCabCompressionType] of Word = (0, 1, 4611);\n\ntype\n TAbCabArchive = class(TAbArchive)\n protected {private}\n {internal variables}\n FCabName : AnsiString;\n FCabPath : AnsiString;\n FFCICabInfo : FCICabInfo;\n FFCIContext : HFCI;\n FFDIContext : HFDI;\n FFDICabInfo : FDICabInfo;\n FErrors : CabErrorRecord;\n FItemInProgress : TAbCabItem;\n FItemStream : TStream;\n FIIPName : string;\n FItemProgress : DWord;\n FNextCabinet : string;\n FNextDisk : string;\n FTempFileID : Integer;\n\n {property variables}\n FCurrentCab : Word;\n FCabSize : Longint;\n FCompressionType : TAbCabCompressionType;\n FFileCount : Word;\n FFolderThreshold : LongWord;\n FFolderCount : Word;\n FHasPrev : Boolean;\n FHasNext : Boolean;\n FSetID : Word;\n\n {internal methods}\n procedure CloseCabFile;\n procedure CreateCabFile;\n function CreateItem( const FileSpec : string ): TAbArchiveItem;\n override;\n procedure DoCabItemProgress(BytesCompressed : DWord;\n var Abort : Boolean);\n procedure DoGetNextCabinet(CabIndex : Integer; var CabName : string;\n var Abort : Boolean);\n procedure ExtractItemAt(Index : Integer; const NewName : string);\n override;\n procedure ExtractItemToStreamAt(Index : Integer; OutStream : TStream);\n override;\n function GetItem(ItemIndex : Integer) : TAbCabItem;\n procedure LoadArchive;\n override;\n procedure OpenCabFile;\n procedure PutItem( Index : Integer; Value : TAbCabItem );\n procedure SaveArchive;\n override;\n procedure SetFolderThreshold(Value : LongWord);\n procedure SetSetID(Value : Word);\n procedure SetSpanningThreshold(Value : Int64);\n override;\n procedure TestItemAt(Index : Integer);\n override;\n\n public {methods}\n constructor Create(const FileName : string; Mode : Word);\n override;\n constructor CreateFromStream(aStream : TStream; const aArchiveName : string);\n override;\n destructor Destroy;\n override;\n procedure Add(aItem : TAbArchiveItem);\n override;\n procedure NewCabinet;\n procedure NewFolder;\n\n public {properties}\n property CurrentCab : Word\n read FCurrentCab;\n property CabSize : Longint\n read FCabSize;\n property CompressionType : TAbCabCompressionType\n read FCompressionType\n write FCompressionType;\n property FolderThreshold : LongWord\n read FFolderThreshold\n write SetFolderThreshold;\n property FolderCount : Word\n read FFolderCount;\n property HasPrev : Boolean\n read FHasPrev;\n property HasNext : Boolean\n read FHasNext;\n property Items[Index : Integer] : TAbCabItem\n read GetItem\n write PutItem; default;\n property ItemProgress : DWord\n read FItemProgress\n write FItemProgress;\n property SetID : Word\n read FSetID\n write SetSetID;\n end;\n\nfunction VerifyCab(const Fn : string) : TAbArchiveType; overload;\nfunction VerifyCab(Strm : TStream) : TAbArchiveType; overload;\n\nimplementation\n\nuses\n SysUtils,\n{$IFDEF HasAnsiStrings}\n System.AnsiStrings,\n{$ENDIF}\n AbCharset, AbConst, AbExcept;\n\n{$WARN UNIT_PLATFORM OFF}\n{$WARN SYMBOL_PLATFORM OFF}\n\ntype\n PWord = ^Word;\n PInteger = ^Integer;\n\n{ == FDI/FCI Callback Functions - cdecl calling convention ================= }\nfunction FXI_GetMem(uBytes : Integer) : Pointer;\n cdecl;\n {allocate memory}\nbegin\n Result := nil;\n if (uBytes > 0) then\n GetMem(Result, uBytes);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure FXI_FreeMem(lpBuffer : Pointer);\n cdecl;\n {free memory}\nbegin\n FreeMem(lpBuffer);\nend;\n\n\n{ == FCI Callback Functions - cdecl calling convention ===================== }\nfunction FCI_FileOpen(lpPathName: PAnsiChar; Flag, Mode: Integer;\n PError: PInteger; Archive: TAbCabArchive) : PtrInt;\n cdecl;\n {open a file}\nbegin\n Result := _lcreat(lpPathName, 0);\n if (Result = -1) then\n raise EAbFCIFileOpenError.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_FileRead(hFile: PtrInt; lpBuffer: Pointer;\n uBytes: UINT; PError: PInteger; Archive: TAbCabArchive) : UINT;\n cdecl;\n {read from a file}\nbegin\n Result := _lread(hFile, lpBuffer, uBytes);\n if (Result = UINT(-1)) then\n raise EAbFCIFileReadError.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_FileWrite(hFile: PtrInt; lpBuffer: Pointer;\n uBytes: UINT; PError: PInteger; Archive: TAbCabArchive) : UINT;\n cdecl;\n {write to a file}\nbegin\n Result := _lwrite(hFile, lpBuffer, uBytes);\n if (Result = UINT(-1)) then\n raise EAbFCIFileWriteError.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_FileClose(hFile: PtrInt; PError: PInteger;\n Archive: TAbCabArchive) : Integer;\n cdecl;\n {close a file}\nbegin\n Result := _lclose(hFile);\n if (Result = -1) then\n raise EAbFCIFileCloseError.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_FileSeek(hFile: PtrInt; Offset: Longint;\n Origin: Integer; PError: PInteger; Archive: TAbCabArchive) : Longint;\n cdecl;\n {reposition file pointer}\nbegin\n Result := _llseek(hFile, Offset, Origin);\n if (Result = -1) then\n raise EAbFCIFileSeekError.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_FileDelete(lpFilename: PAnsiChar; PError: PInteger;\n Archive: TAbCabArchive) : Boolean;\n cdecl;\n {delete a file}\nbegin\n Result := SysUtils.DeleteFile(string(lpFilename));\n if not Result then\n raise EAbFCIFileDeleteError.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_GetNextCab(lpCCab: PFCICabInfo; PrevCab: Longint;\n Archive: TAbCabArchive) : Boolean;\n cdecl;\n {get next cabinet filename}\nvar\n CabName : string;\n Abort : Boolean;\nbegin\n Abort := False;\n with lpCCab^ do begin\n CabName := string(szCab);\n {obtain next cabinet. Make index zero-based}\n Archive.DoGetNextCabinet(Pred(iCab), CabName, Abort);\n if not Abort then\n AbStrPLCopy(szCab, AnsiString(CabName), Length(szCab));\n end;\n Result := not Abort;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_FileDest(PCCab: PFCICabInfo; PFilename: PAnsiChar; cbFile: Longint;\n Continuation: Boolean; Archive: TAbCabArchive) : Integer;\n cdecl;\n {currently not used}\nbegin\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_GetOpenInfo(lpPathname: Pointer; PDate, PTime, PAttribs : PWord;\n PError: PInteger; Archive: TAbCabArchive) : PtrInt;\n cdecl;\n {open a file and return date/attributes}\nvar\n AttrEx: TAbAttrExRec;\n I, DT: Integer;\n RawName: RawByteString;\nbegin\n Result := FileOpen(string(lpPathname), fmOpenRead or fmShareDenyNone);\n if (Result = -1) then\n raise EAbFCIFileOpenError.Create;\n if not AbFileGetAttrEx(string(lpPathname), AttrEx) then\n raise EAbFileNotFound.Create;\n PAttribs^ := AttrEx.Attr;\n DT := DateTimeToFileDate(AttrEx.Time);\n PDate^ := DT shr 16;\n PTime^ := DT and $0FFFF;\n Archive.ItemProgress := 0;\n Archive.FItemInProgress.UncompressedSize := AttrEx.Size;\n RawName := Archive.FItemInProgress.RawFileName;\n for I := 1 to Length(RawName) do\n if Ord(RawName[I]) > 127 then\n PAttribs^ := PAttribs^ or faUTF8Name;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_Status(Status: Word; cb1, cb2: DWord;\n Archive: TAbCabArchive) : Longint; cdecl;\n {keep archive informed}\nvar\n Abort : Boolean;\nbegin\n Result := 0;\n if (Status = Word(csCabinet)) then begin\n Archive.DoSave;\n Archive.FCabSize := cb2;\n Result := cb2;\n end else if (Status = Word(csFolder)) then\n Archive.FCabSize := Archive.FCabSize + Longint(cb2)\n else if (Status = Word(csFile)) then begin\n Archive.DoCabItemProgress(cb2, Abort);\n Result := Longint(Abort);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FCI_GetTempFile(lpTempName: PAnsiChar; TempNameSize: Integer;\n Archive: TAbCabArchive) : PtrInt; cdecl;\n {obtain temporary filename}\nvar\n TempPath : array[0..255] of AnsiChar;\nbegin\n Archive.FTempFileID := Archive.FTempFileID + 1;\n if (Archive.TempDirectory <> '') then\n AbStrPLCopy(TempPath, AnsiString(Archive.TempDirectory), Length(TempPath))\n else\n GetTempPathA(255, TempPath);\n GetTempFileNameA(TempPath, 'VMS', Archive.FTempFileID, lpTempName);\n Result := 1;\nend;\n\n{ == FDI Callback Functions - cdecl calling convention ===================== }\nfunction FDI_FileOpen(lpPathName: PAnsiChar; Flag, Mode: Integer) : PtrInt;\n cdecl;\n {open a file}\nbegin\n try\n Result := PtrInt(TFileStream.Create(string(lpPathName), fmOpenRead or fmShareDenyWrite));\n except on EFOpenError do\n Result := -1;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FDI_FileRead(hFile: PtrInt; lpBuffer: Pointer; uBytes: UINT) : UINT;\n cdecl;\n {read from a file}\nbegin\n Result := TStream(hFile).Read(lpBuffer^, uBytes);\nend;\n{ -------------------------------------------------------------------------- }\nfunction FDI_FileWrite(hFile: PtrInt; lpBuffer: Pointer; uBytes: UINT) : UINT;\n cdecl;\n {write to a file}\nbegin\n Result := TStream(hFile).Write(lpBuffer^, uBytes);\nend;\n{ -------------------------------------------------------------------------- }\nfunction FDI_FileClose(hFile : PtrInt) : Longint;\n cdecl;\n {close a file}\nbegin\n try\n TStream(hFile).Free;\n Result := 0;\n except\n Result := -1;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FDI_FileSeek(hFile : PtrInt; Offset : Longint; Origin : Integer) : Longint;\n cdecl;\n {reposition file pointer}\nbegin\n Result := TStream(hFile).Seek(Offset, Origin);\nend;\n{ -------------------------------------------------------------------------- }\nfunction FDI_EnumerateFiles(fdint : FDINOTIFICATIONTYPE;\n pfdin : PFDINotification) : PtrInt;\n cdecl;\n {Enumerate the files and build the archive file list}\nvar\n Item : TAbCabItem;\n Archive : TAbCabArchive;\nbegin\n Result := 0;\n Archive := pfdin^.pv;\n with Archive do case fdint of\n FDINT_Cabinet_Info :\n begin\n FSetID := pfdin^.setID;\n FCurrentCab := pfdin^.iCabinet;\n FNextCabinet := string(pfdin^.psz1);\n FNextDisk := string(pfdin^.psz2);\n Result := 0;\n end;\n FDINT_Copy_File, FDINT_Partial_File :\n begin\n Item := TAbCabItem.Create;\n with Item do begin\n RawFileName := AnsiString(pfdin^.psz1);\n if (pfdin^.attribs and faUTF8Name) = faUTF8Name then\n Filename := UTF8ToString(RawFileName)\n else\n Filename := string(RawFileName);\n UnCompressedSize := pfdin^.cb;\n LastModFileDate := pfdin^.date;\n LastModFileTime := pfdin^.time;\n ExternalFileAttributes := pfdin^.attribs;\n IsEncrypted := False; {encryption not implemented at this time}\n PartialFile := (fdint = FDINT_Partial_File);\n end;\n FItemList.Add(Item);\n Result := 0;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction FDI_ExtractFiles(fdint : FDINOTIFICATIONTYPE;\n pfdin : PFDINotification) : PtrInt;\n cdecl;\n {extract file from cabinet}\nvar\n Archive : TAbCabArchive;\nbegin\n Result := 0;\n Archive := pfdin^.pv;\n case fdint of\n FDINT_Copy_File :\n begin\n if (AnsiString(pfdin^.psz1) = Archive.FItemInProgress.RawFileName) then\n if Archive.FIIPName <> '' then\n Result := Integer(TFileStream.Create(Archive.FIIPName, fmCreate))\n else\n Result := Integer(Archive.FItemStream)\n else\n Result := 0;\n end;\n FDINT_Next_Cabinet :\n begin\n if pfdin^.fdie = FDIError_None then\n Result := 0\n else\n Result := -1;\n end;\n FDINT_Close_File_Info :\n begin\n if Archive.FIIPName <> '' then begin\n FileSetDate(TFileStream(pfdin^.hf).Handle,\n Longint(pfdin^.date) shl 16 + pfdin^.time);\n TFileStream(pfdin^.hf).Free;\n FileSetAttr(Archive.FIIPName, pfdin^.attribs);\n end;\n Result := 1;\n end;\n end;\nend;\n\n\n{ == TAbCabArchive ========================================================= }\nfunction VerifyCab(const Fn : string) : TAbArchiveType;\nvar\n Stream : TFileStream;\nbegin\n Stream := TFileStream.Create(FN, fmOpenRead or fmShareDenyNone);\n try\n Result := VerifyCab(Stream);\n finally\n Stream.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction VerifyCab(Strm : TStream) : TAbArchiveType; overload;\nvar\n Context : HFDI;\n Info : FDICabInfo;\n Errors : CabErrorRecord;\n StartPos : int64;\nbegin\n Result := atUnknown;\n Context := FDICreate(@FXI_GetMem, @FXI_FreeMem, @FDI_FileOpen,\n @FDI_FileRead, @FDI_FileWrite, @FDI_FileClose, @FDI_FileSeek, cpuDefault,\n @Errors);\n if Context = nil then\n Exit;\n try\n StartPos := Strm.Position;\n if FDIIsCabinet(Context, Integer(Strm), @Info) then\n Result := atCab;\n Strm.Position := StartPos;\n finally\n FDIDestroy(Context);\n end;\nend;\n\n\n{ == TAbCabArchive ========================================================= }\nconstructor TAbCabArchive.Create(const FileName : string; Mode : Word );\nbegin\n {Mode is used to identify which interface to use: }\n { fmOpenWrite - FCI, fmOpenRead - FDI}\n inherited CreateInit;\n if (Mode and fmCreate) = fmCreate then FMode := fmOpenWrite\n else FMode := Mode and fmOpenWrite;\n FArchiveName := FileName;\n FCabName := AnsiString(ExtractFileName(FileName));\n FCabPath := AnsiString(ExtractFilePath(FileName));\n SpanningThreshold := AbDefCabSpanningThreshold;\n FFolderThreshold := AbDefFolderThreshold;\n FItemInProgress := nil;\n FItemProgress := 0;\nend;\n{ -------------------------------------------------------------------------- }\nconstructor TAbCabArchive.CreateFromStream(aStream : TStream;\n const aArchiveName : string);\nbegin\n raise EAbCabException.Create('TAbCabArchive does not support CreateFromStream');\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCabArchive.Destroy;\nbegin\n CloseCabFile;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.Add(aItem : TAbArchiveItem);\n {add a file to the cabinet}\nvar\n Confirm, ItemAdded : Boolean;\n Item : TAbCabItem;\nbegin\n ItemAdded := False;\n try\n CheckValid;\n if (FMode <> fmOpenWrite) then begin\n DoProcessItemFailure(aItem, ptAdd, ecCabError, 0);\n Exit;\n end;\n if FItemList.IsActiveDupe(aItem.FileName) then begin\n DoProcessItemFailure(aItem, ptAdd, ecAbbrevia, AbDuplicateName);\n Exit;\n end;\n DoConfirmProcessItem(aItem, ptAdd, Confirm);\n if not Confirm then\n Exit;\n Item := TAbCabItem(aItem);\n FItemInProgress := Item;\n Item.Action := aaAdd;\n\n Item.RawFileName := UTF8Encode(Item.FileName);\n if not FCIAddFile(FFCIContext, Pointer(Item.DiskFileName),\n PAnsiChar(Item.RawFileName), False, @FCI_GetNextCab, @FCI_Status,\n @FCI_GetOpenInfo, CompressionTypeMap[FCompressionType]) then\n raise EAbFCIAddFileError.Create;\n FItemList.Add(Item);\n ItemAdded := True;\n\n FIsDirty := True;\n finally\n if not ItemAdded then\n aItem.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.CloseCabFile;\n {Make sure the Cabinet DLL is shut down}\nvar\n Abort : Boolean;\nbegin\n if (FFDIContext <> nil) then begin\n FDIDestroy(FFDIContext);\n FFDIContext := nil;\n end;\n if (FFCIContext <> nil) then begin\n FCIFlushCabinet(FFCIContext, False, @FCI_GetNextCab, @FCI_Status);\n FCIDestroy(FFCIContext);\n FFCIContext := nil;\n end;\n DoArchiveProgress(0, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.CreateCabFile;\n {create a new cabinet}\nbegin\n {set cabinet parameters}\n with FFCICabInfo do begin\n if (SpanningThreshold > 0) then\n cb := SpanningThreshold\n else\n cb := AbDefCabSpanningThreshold;\n if (FolderThreshold > 0) then\n cbFolderThresh := FolderThreshold\n else\n cbFolderThresh := AbDefFolderThreshold;\n cbReserveCFHeader := AbDefReserveHeaderSize;\n cbReserveCFFolder := AbDefReserveFolderSize;\n cbReserveCFData := AbDefReserveDataSize;\n iCab := 1;\n iDisk := 0;\n fFailOnIncompressible := 0;\n setID := SetID;\n AbStrPCopy(szDisk, '');\n AbStrPLCopy(szCab, FCabName, Length(szCab));\n AbStrPLCopy(szCabPath, FCabPath, Length(szCabPath));\n end;\n\n {obtain an FCI context}\n FFCIContext := FCICreate(@FErrors, @FCI_FileDest, @FXI_GetMem, @FXI_FreeMem,\n @FCI_FileOpen, @FCI_FileRead, @FCI_FileWrite, @FCI_FileClose, @FCI_FileSeek,\n @FCI_FileDelete, @FCI_GetTempFile, @FFCICabInfo, Self);\n if (FFCIContext = nil) then\n if FErrors.ErrorPresent then begin\n CloseCabFile;\n raise EAbFCICreateError.Create;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCabArchive.CreateItem( const FileSpec : string ): TAbArchiveItem;\n {create a new item for the file list}\nbegin\n Result := TAbCabItem.Create;\n with TAbCabItem(Result) do begin\n CompressedSize := 0;\n DiskFileName := ExpandFileName(FileSpec);\n FileName := FixName(FileSpec);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.DoCabItemProgress(BytesCompressed : DWord;\n var Abort : Boolean);\n {fire OnCabItemProgress event}\nvar\n Progress : Byte;\nbegin\n Abort := False;\n if Assigned(FOnArchiveItemProgress) then begin\n Inc(FItemProgress, BytesCompressed);\n Progress := AbPercentage(FItemProgress,\n FItemInProgress.UnCompressedSize);\n FOnArchiveItemProgress(Self, FItemInProgress, Progress, Abort);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.DoGetNextCabinet(CabIndex : Integer;\n var CabName : string; var Abort : Boolean);\n {fire OnRequestImage event}\nbegin\n Abort := False;\n if Assigned(FOnRequestImage) then\n FOnRequestImage(Self, CabIndex, CabName, Abort)\n else\n AbIncFilename(CabName, CabIndex);\nend;\n{----------------------------------------------------------------------------}\nprocedure TAbCabArchive.ExtractItemAt(Index : Integer; const NewName : string);\n {extract a file from the cabinet}\nbegin\n FItemInProgress := GetItem(Index);\n FIIPName := NewName;\n try\n if not FDICopy(FFDIContext, PAnsiChar(FCabName), PAnsiChar(FCabPath), 0,\n @FDI_ExtractFiles, nil, Self) then\n DoProcessItemFailure(FItemInProgress, ptExtract, ecCabError, FErrors.ErrorCode);\n finally\n FIIPName := '';\n end;\nend;\n{----------------------------------------------------------------------------}\nprocedure TAbCabArchive.ExtractItemToStreamAt(Index : Integer; OutStream : TStream);\nbegin\n FItemInProgress := GetItem(Index);\n FItemStream := OutStream;\n try\n if not FDICopy(FFDIContext, PAnsiChar(FCabName), PAnsiChar(FCabPath), 0,\n @FDI_ExtractFiles, nil, Self) then\n DoProcessItemFailure(FItemInProgress, ptExtract, ecCabError, FErrors.ErrorCode);\n finally\n FItemStream := nil;\n end;\nend;\n{----------------------------------------------------------------------------}\nfunction TAbCabArchive.GetItem(ItemIndex : Integer) : TAbCabItem;\n {fetch an item from the file list}\nbegin\n Result := TAbCabItem(FItemList.Items[ItemIndex]);\nend;\n{----------------------------------------------------------------------------}\nprocedure TAbCabArchive.LoadArchive;\n {Open existing cabinet or create a new one}\nbegin\n if (FMode = fmOpenRead) then begin\n FFDIContext := FDICreate(@FXI_GetMem, @FXI_FreeMem, @FDI_FileOpen,\n @FDI_FileRead, @FDI_FileWrite, @FDI_FileClose, @FDI_FileSeek,\n cpuDefault, @FErrors);\n if (FFDIContext = nil) then\n raise EAbFDICreateError.Create;\n OpenCabFile;\n end else\n CreateCabFile;\nend;\n{----------------------------------------------------------------------------}\nprocedure TAbCabArchive.NewCabinet;\n {flush current cabinet and start a new one}\nbegin\n if not FCIFlushCabinet(FFCIContext, True, @FCI_GetNextCab, @FCI_Status) then\n raise EAbFCIFlushCabinetError.Create;\nend;\n{----------------------------------------------------------------------------}\nprocedure TAbCabArchive.NewFolder;\n {flush current folder and start a new one}\nbegin\n if not FCIFlushFolder(FFCIContext, @FCI_GetNextCab, @FCI_Status) then\n raise EAbFCIFlushFolderError.Create;\nend;\n{----------------------------------------------------------------------------}\nprocedure TAbCabArchive.OpenCabFile;\n {Open an existing cabinet}\nvar\n Abort : Boolean;\n Stream : TFileStream;\nbegin\n {verify that the archive can be opened and is a cabinet}\n Stream := TFileStream.Create(FArchiveName, fmOpenRead or fmShareDenyNone);\n try\n if not FDIIsCabinet(FFDIContext, PtrInt(Stream), @FFDICabInfo) then begin\n CloseCabFile;\n raise EAbInvalidCabFile.Create;\n end;\n finally\n Stream.Free;\n end;\n\n {store information about the cabinet}\n FCabSize := FFDICabInfo.cbCabinet;\n FFolderCount := FFDICabInfo.cFolders;\n FFileCount := FFDICabInfo.cFiles;\n FCurrentCab := FFDICabInfo.iCabinet;\n FHasPrev := FFDICabInfo.hasPrev;\n FHasNext := FFDICabInfo.hasNext;\n\n {Enumerate the files and build the file list}\n if not FDICopy(FFDIContext, PAnsiChar(FCabName), PAnsiChar(FCabPath), 0,\n @FDI_EnumerateFiles, nil, Self) then begin\n CloseCabFile;\n raise EAbFDICopyError.Create;\n end;\n DoArchiveProgress(100, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.PutItem( Index : Integer; Value : TAbCabItem );\n {replace an existing item in the file list}\nbegin\n FItemList.Items[Index] := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.SaveArchive;\nbegin\n { No-op; file is flushed in destructor }\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.SetFolderThreshold(Value : LongWord);\n {set maximum compression boundary}\nbegin\n if (Value > 0) then\n FFolderThreshold := Value\n else\n FFolderThreshold := AbDefFolderThreshold;\n FFCICabInfo.cbFolderThresh := FFolderThreshold;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.SetSetID(Value : Word);\n {set cabinet SetID}\nbegin\n FSetID := Value;\n FFCICabInfo.SetID := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.SetSpanningThreshold(Value : Int64);\n {set maximum cabinet size}\nbegin\n if (Value > 0) then\n FSpanningThreshold := Value\n else\n FSpanningThreshold := AbDefCabSpanningThreshold;\n FFCICabInfo.cb := FSpanningThreshold;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabArchive.TestItemAt(Index : Integer);\nbegin\n {not implemented for cabinet archives}\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCharset.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * Craig Peterson \n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCharset.pas *}\n{*********************************************************}\n{* ABBREVIA: Types and routines for working with various *}\n{* character encodings. *}\n{*********************************************************}\n\nunit AbCharset;\n\n{$I AbDefine.inc}\n\ninterface\n\n{$IFDEF MSWINDOWS}\nuses\n Windows;\n{$ENDIF}\n\n{ Unicode backwards compatibility types }\n{$IF NOT DECLARED(RawByteString)}\ntype\n RawByteString = AnsiString;\n{$IFEND}\n{$IF NOT DECLARED(UnicodeString)}\ntype\n UnicodeString = WideString;\n{$IFEND}\n\ntype\n TAbCharSet = (csASCII, csANSI, csUTF8);\n\nfunction AbDetectCharSet(const aValue: RawByteString): TAbCharSet;\n\nfunction AbIsOEM(const aValue: RawByteString): Boolean;\n\nfunction AbRawBytesToString(const aValue: RawByteString): string;\n\nfunction AbStringToUnixBytes(const aValue: string): RawByteString;\n\nfunction AbSysCharSetIsUTF8: Boolean;\n\n{$IFDEF MSWINDOWS}\nfunction AbTryEncode(const aValue: UnicodeString; aCodePage: UINT;\n aAllowBestFit: Boolean; out aResult: AnsiString): Boolean;\n{$ENDIF}\n\n{ Unicode backwards compatibility functions }\n{$IFNDEF UNICODE}\nfunction UTF8ToString(const S: RawByteString): string;\n{$ENDIF}\n\nimplementation\n\nuses\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n SysUtils;\n\nfunction AbDetectCharSet(const aValue: RawByteString): TAbCharSet;\nvar\n i, TrailCnt: Integer;\nbegin\n Result := csASCII;\n TrailCnt := 0;\n for i := 1 to Length(aValue) do begin\n if Byte(aValue[i]) >= $80 then\n Result := csANSI;\n if TrailCnt > 0 then\n if Byte(aValue[i]) in [$80..$BF] then\n Dec(TrailCnt)\n else Exit\n else if Byte(aValue[i]) in [$80..$BF] then\n Exit\n else\n case Byte(aValue[i]) of\n $C0..$C1, $F5..$FF: Exit;\n $C2..$DF: TrailCnt := 1;\n $E0..$EF: TrailCnt := 2;\n $F0..$F4: TrailCnt := 3;\n end;\n end;\n if (TrailCnt = 0) and (Result = csANSI) then\n Result := csUTF8;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbIsOEM(const aValue: RawByteString): Boolean;\n// Detect whether a string of bytes is likely to be the system's ANSI or OEM codepage\n{$IFDEF MSWINDOWS}\nconst\n // Byte values of alpha-numeric characters in OEM and ANSI codepages.\n // Excludes NBSP, ordinal indicators, exponents, the florin symbol, and, for\n // ANSI codepages matched to certain OEM ones, the micro character.\n //\n // US (OEM 437, ANSI 1252)\n Oem437AnsiChars =\n [138, 140, 142, 154, 156, 158, 159, 181, 192..214, 216..246, 248..255];\n Oem437OemChars =\n [128..154, 160..165, 224..235, 237, 238];\n // Arabic (OEM 720, ANSI 1256)\n Oem720AnsiChars =\n [129, 138, 140..144, 152, 154, 156, 159, 170, 181, 192..214, 216..239, 244,\n 249, 251, 252, 255];\n Oem720OemChars =\n [130, 131, 133, 135..140, 147, 149..155, 157..173, 224..239];\n // Greek (OEM 737, ANSI 1253)\n Oem737AnsiChars =\n [162, 181, 184..186, 188, 190..209, 211..254];\n Oem737OemChars =\n [128..175, 224..240, 244, 245];\n // Baltic Rim (OEM 775, ANSI 1257)\n Oem775AnsiChars =\n [168, 170, 175, 184, 186, 191..214, 216..246, 248..254];\n Oem775OemChars =\n [128..149, 151..155, 157, 160..165, 173, 181..184, 189, 190, 198, 199,\n 207..216, 224..238];\n // Western European (OEM 850, ANSI 1252)\n Oem850AnsiChars =\n [138, 140, 142, 154, 156, 158, 159, 192..214, 216..246, 248..255];\n Oem850OemChars =\n [128..155, 157, 160..165, 181..183, 198, 199, 208..216, 222, 224..237];\n // Central & Eastern European (OEM 852, ANSI 1250)\n Oem852AnsiChars =\n [138, 140..143, 154, 156..159, 163, 165, 170, 175, 179, 185, 186, 188,\n 190..214, 216..246, 248..254];\n Oem852OemChars =\n [128..157, 159..169, 171..173, 181..184, 189, 190, 198, 199, 208..216, 221,\n 222, 224..238, 251..253];\n // Cyrillic (OEM 855, ANSI 1251)\n Oem855AnsiChars =\n [128, 129, 131, 138, 140..144, 154, 156..159, 161..163, 165, 168, 170, 175,\n 178..180, 184, 186, 188..255];\n Oem855OemChars =\n [128..173, 181..184, 189, 190, 198, 199, 208..216, 221, 222, 224..238,\n 241..252];\n // Turkish (OEM 857, ANSI 1254)\n Oem857AnsiChars =\n [138, 140, 154, 156, 159, 192..214, 216..246, 248..255];\n Oem857OemChars =\n [128..155, 157..167, 181..183, 198, 199, 210..212, 214..216, 222, 224..230,\n 233..237];\n // Hebrew (OEM 862, ANSI 1255)\n Oem862AnsiChars =\n [181, 212..214, 224..250];\n Oem862OemChars =\n [128..154, 160..165, 224..235, 237, 238];\n // Cyrillic CIS (OEM 866, ANSI 1251)\n Oem866AnsiChars =\n [128, 129, 131, 138, 140..144, 154, 156..159, 161..163, 165, 168, 170, 175,\n 178..181, 184, 186, 188..255];\n Oem866OemChars =\n [128..175, 224..247];\nvar\n AnsiChars, OemChars: set of Byte;\n IsANSI: Boolean;\n i: Integer;\nbegin\n case GetOEMCP of\n 437:\n begin\n AnsiChars := Oem437AnsiChars;\n OemChars := Oem437OemChars;\n end;\n 720:\n begin\n AnsiChars := Oem720AnsiChars;\n OemChars := Oem720OemChars;\n end;\n 737:\n begin\n AnsiChars := Oem737AnsiChars;\n OemChars := Oem737OemChars;\n end;\n 775:\n begin\n AnsiChars := Oem775AnsiChars;\n OemChars := Oem775OemChars;\n end;\n 850:\n begin\n AnsiChars := Oem850AnsiChars;\n OemChars := Oem850OemChars;\n end;\n 852:\n begin\n AnsiChars := Oem852AnsiChars;\n OemChars := Oem852OemChars;\n end;\n 855:\n begin\n AnsiChars := Oem855AnsiChars;\n OemChars := Oem855OemChars;\n end;\n 857:\n begin\n AnsiChars := Oem857AnsiChars;\n OemChars := Oem857OemChars;\n end;\n 862:\n begin\n AnsiChars := Oem862AnsiChars;\n OemChars := Oem862OemChars;\n end;\n 866:\n begin\n AnsiChars := Oem866AnsiChars;\n OemChars := Oem866OemChars;\n end;\n else\n begin\n Result := False;\n Exit;\n end;\n end;\n\n IsANSI := True;\n Result := True;\n for i := 0 to Length(aValue) do\n if Ord(aValue[i]) >= $80 then\n begin\n if IsANSI then\n IsANSI := Ord(aValue[i]) in AnsiChars;\n if Result then\n Result := Ord(aValue[i]) in OemChars;\n if not IsANSI and not Result then\n Break\n end;\n if IsANSI then\n Result := False;\nend;\n{$ELSE !MSWINDOWS}\nbegin\n Result := False;\nend;\n{$ENDIF !MSWINDOWS}\n{ -------------------------------------------------------------------------- }\nfunction AbSysCharSetIsUTF8: Boolean;\nbegin\n {$IFDEF DARWIN}\n Result := True;\n {$ENDIF}\n {$IFDEF MSWINDOWS}\n Result := False;\n {$ENDIF}\n {$IFDEF LINUX}\n Result := StrComp(nl_langinfo(_NL_CTYPE_CODESET_NAME), 'UTF-8') = 0;\n {$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbRawBytesToString(const aValue: RawByteString): string;\n// Detect encoding of raw bytes and convert to a string\nbegin\n case AbDetectCharSet(aValue) of\n csASCII:\n Result := string(aValue);\n\n csANSI: begin\n {$IFDEF MSWINDOWS}\n if AbIsOEM(aValue) then begin\n SetLength(Result, Length(aValue));\n OemToCharBuff(PAnsiChar(aValue), PChar(Result), Length(Result));\n end\n else\n {$ENDIF}\n Result := string(aValue);\n end;\n\n csUTF8:\n Result := UTF8ToString(aValue);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbStringToUnixBytes(const aValue: string): RawByteString;\n// Convert from a string to an appropriate encoding for Unix archive types (tar/gz)\n// Based on testing the system encoding should be used on Linux, and UTF-8\n// everywhere else. Windows apps don't agree on whether to use ANSI, OEM, or UTF-8.\nbegin\n // Delphi XE2+ Posix platforms only support the UTF-8 locale\n {$IF DEFINED(LINUX) AND (DEFINED(FPC) OR DEFINED(KYLIX))}\n Result := AnsiString(aValue);\n {$ELSE}\n Result := UTF8Encode(aValue);\n {$IFEND}\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF MSWINDOWS}\nfunction AbTryEncode(const aValue: UnicodeString; aCodePage: UINT;\n aAllowBestFit: Boolean; out aResult: AnsiString): Boolean;\n// Try to encode the given Unicode string as the requested codepage\nconst\n WC_NO_BEST_FIT_CHARS = $00000400;\n Flags: array[Boolean] of DWORD = (WC_NO_BEST_FIT_CHARS, 0);\nvar\n UsedDefault: BOOL;\nbegin\n if not aAllowBestFit and not CheckWin32Version(4, 1) then\n Result := False\n else begin\n SetLength(aResult, WideCharToMultiByte(aCodePage, Flags[aAllowBestFit],\n PWideChar(aValue), Length(aValue), nil, 0, nil, @UsedDefault));\n SetLength(aResult, WideCharToMultiByte(aCodePage, Flags[aAllowBestFit],\n PWideChar(aValue), Length(aValue), PAnsiChar(aResult),\n Length(aResult), nil, @UsedDefault));\n Result := not UsedDefault;\n end;\nend;\n{$ENDIF MSWINDOWS}\n\n\n{ == Unicode backwards compatibility functions ============================= }\n{$IFNDEF UNICODE}\nfunction UTF8ToString(const S: RawByteString): string;\nbegin\n Result := UTf8ToAnsi(S);\nend;\n{$ENDIF}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbComCtrls.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is Craig Peterson\n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbComCtrls.pas *}\n{*********************************************************}\n{* ABBREVIA: Listview and treeview components that work *}\n{* with an archive component. The treeview can have a *}\n{* listview associated, in which case the listview will*}\n{* only show items in the selected folder. *}\n{*********************************************************}\n\nunit AbComCtrls;\n\ninterface\n\n{$I AbDefine.inc}\n\nuses\n Windows, Messages, SysUtils, Classes, Controls, ComCtrls, Graphics, AbBrowse,\n AbArcTyp;\n\nconst\n AbTreeArchiveImage = 0;\n AbTreeFolderImage = 1;\n AbTreeFolderExpandedImage = 2;\n\ntype\n{ ===== TAbListItem ========================================================= }\n TAbListItem = class(TListItem)\n protected {private}\n FArchiveItem : TAbArchiveItem;\n protected {methods}\n function GetIsDirectory : Boolean;\n function GetIsEncrypted : Boolean;\n public {properties}\n property ArchiveItem : TAbArchiveItem\n read FArchiveItem\n write FArchiveItem;\n property IsDirectory : Boolean\n read GetIsDirectory;\n property IsEncrypted : Boolean\n read GetIsEncrypted;\n end;\n\n\n{ ===== TAbListItems ======================================================== }\n TAbListItems = class(TListItems)\n protected {methods}\n function GetItem(aIndex: Integer): TAbListItem;\n procedure SetItem(aIndex: Integer; aValue: TAbListItem);\n public {properties}\n property Item[Index: Integer]: TAbListItem\n read GetItem\n write SetItem; default;\n end;\n\n\n{ ===== TAbCustomListView =================================================== }\ntype\n TAbViewColumn =\n (vcName, vcFileType, vcLastModified, vcSize, vcRatio,\n vcPacked, vcCRC, vcAttributes, vcEncrypted, vcMethod, vcPath);\n TAbViewColumns = set of TAbViewColumn;\n\nconst\n AbDefVisibleColumns = [Low(TAbViewColumn)..High(TAbViewColumn)];\n\ntype\n TAbCustomTreeView = class;\n\n {$IF NOT DECLARED(TWindowProcPtr)}\n TWindowProcPtr = Pointer;\n {$IFEND}\n\n TAbCustomListView = class(TCustomListView)\n protected {private}\n FArchive : TAbBaseBrowser;\n FDefHeaderProc : TWindowProcPtr;\n FFlatList: Boolean;\n FHeaderHandle : HWND;\n FHeaderImages : TImageList;\n FHeaderInstance : Pointer;\n FInUpdateSortArrows: Boolean;\n FPath : string;\n FSortAscending : Boolean;\n FSortColIndex : Integer;\n FSortColumn : TAbViewColumn;\n FSortUpBmp : HBITMAP;\n FSortDownBmp : HBITMAP;\n FTreeView : TAbCustomTreeView;\n FVisibleColumns : TAbViewColumns;\n\n protected {methods}\n procedure ColClick(aColumn: TListColumn);\n override;\n function CreateListItem: TListItem;\n override;\n function CreateListItems: TListItems;\n override;\n procedure CreateWnd;\n override;\n function CustomDrawSubItem(Item: TListItem; SubItem: Integer;\n State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;\n override;\n procedure DblClick;\n override;\n procedure DoChange(Sender : TObject);\n virtual;\n function GetListItems: TAbListItems;\n function GetVersion: string;\n procedure HeaderWndProc(var Msg: TMessage);\n virtual;\n function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean;\n override;\n procedure Notification(aComponent : TComponent; aOperation : TOperation);\n override;\n procedure SetArchive(aValue : TAbBaseBrowser);\n procedure SetFlatList(aValue : Boolean);\n procedure SetPath(aValue : string);\n procedure SetTreeView(aValue : TAbCustomTreeView);\n procedure SetVisibleColumns(aValue : TAbViewColumns);\n procedure UpdateColumns;\n procedure UpdateSortArrow;\n procedure UpdateView;\n\n protected {properties}\n property HeaderImages : TImageList\n read FHeaderImages;\n\n public {methods}\n constructor Create(aOwner: TComponent);\n override;\n destructor Destroy;\n override;\n procedure Sort(aColumn: TAbViewColumn; aAscending: Boolean);\n\n public {properties}\n property Archive : TAbBaseBrowser\n read FArchive\n write SetArchive;\n property Columns;\n // Show only items in the current path\n property FlatList : Boolean\n read FFlatList\n write SetFlatList;\n property Items: TAbListItems\n read GetListItems\n stored False;\n property TreeView : TAbCustomTreeView\n read FTreeView\n write SetTreeView;\n property Path : string\n read FPath\n write SetPath;\n property Version : string\n read GetVersion\n stored False;\n property VisibleColumns : TAbViewColumns\n read FVisibleColumns\n write SetVisibleColumns\n default AbDefVisibleColumns;\n end;\n\n\n{ ===== TAbListView ========================================================= }\n TAbListView = class(TAbCustomListView)\n published\n property Action;\n property Align;\n property AllocBy;\n property Anchors;\n property Archive;\n property BevelEdges;\n property BevelInner;\n property BevelOuter;\n property BevelKind default bkNone;\n property BevelWidth;\n property BiDiMode;\n property BorderStyle;\n property BorderWidth;\n property Checkboxes;\n property Color;\n property ColumnClick;\n property Constraints;\n property Ctl3D;\n property DoubleBuffered;\n property DragCursor;\n property DragKind;\n property DragMode;\n property Enabled;\n property Font;\n property FlatScrollBars;\n property FullDrag;\n property GridLines;\n{$IFDEF HasListViewGroups}\n property Groups;\n{$ENDIF}\n property HideSelection;\n property HotTrack;\n property HotTrackStyles;\n property HoverTime;\n property IconOptions;\n property Items;\n property LargeImages;\n property MultiSelect;\n{$IFDEF HasListViewGroups}\n property GroupHeaderImages;\n property GroupView default False;\n{$ENDIF}\n property ReadOnly default False;\n property RowSelect;\n property ParentBiDiMode;\n property ParentColor default False;\n{$IFDEF HasParentDoubleBuffered}\n property ParentDoubleBuffered;\n{$ENDIF}\n property ParentFont;\n property ParentShowHint;\n property Path;\n property PopupMenu;\n property ShowColumnHeaders;\n property ShowWorkAreas;\n property ShowHint;\n property TabOrder;\n property TabStop default True;\n property TreeView;\n property Version;\n property ViewStyle;\n property Visible;\n property VisibleColumns;\n property OnClick;\n property OnColumnClick;\n property OnColumnDragged;\n property OnColumnRightClick;\n property OnContextPopup;\n property OnDblClick;\n property OnEdited;\n property OnEditing;\n property OnEndDock;\n property OnEndDrag;\n property OnEnter;\n property OnExit;\n property OnDragDrop;\n property OnDragOver;\n property OnInfoTip;\n property OnKeyDown;\n property OnKeyPress;\n property OnKeyUp;\n{$IFDEF HasOnMouseActivate}\n property OnMouseActivate;\n{$ENDIF}\n property OnMouseDown;\n{$IFDEF HasOnMouseEnter}\n property OnMouseEnter;\n property OnMouseLeave;\n{$ENDIF}\n property OnMouseMove;\n property OnMouseUp;\n property OnResize;\n property OnSelectItem;\n{$IFDEF HasListViewOnItemChecked}\n property OnItemChecked;\n{$ENDIF}\n property OnStartDock;\n property OnStartDrag;\n end;\n\n\n{ ===== TAbCustomTreeView =================================================== }\n TAbCustomTreeView = class(TTreeView)\n protected {private}\n FArchive: TAbBaseBrowser;\n FListView: TAbCustomListView;\n FPath: string;\n\n protected {methods}\n procedure Change(aNode: TTreeNode);\n override;\n procedure DoChange(Sender : TObject);\n virtual;\n procedure GetSelectedIndex(aNode: TTreeNode);\n override;\n function GetVersion: string;\n procedure Notification(aComponent : TComponent; aOperation : TOperation);\n override;\n procedure SelectPathNode;\n procedure SetArchive(aValue: TAbBaseBrowser);\n procedure SetListView(aValue: TAbCustomListView);\n procedure SetPath(const aValue: string);\n\n public {methods}\n constructor Create(aOwner: TComponent);\n override;\n\n public {properties}\n property Archive: TAbBaseBrowser\n read FArchive\n write SetArchive;\n property HideSelection\n default False;\n property ListView: TAbCustomListView\n read FListView\n write SetListView;\n property Path: string\n read FPath\n write SetPath;\n property Version: string\n read GetVersion\n stored False;\n end;\n\n\n{ ===== TAbTreeView ========================================================= }\n TAbTreeView = class(TAbCustomTreeView)\n published\n property Align;\n property Anchors;\n property Archive;\n property AutoExpand;\n property BevelEdges;\n property BevelInner;\n property BevelOuter;\n property BevelKind default bkNone;\n property BevelWidth;\n property BiDiMode;\n property BorderStyle;\n property BorderWidth;\n property ChangeDelay;\n property Color;\n property Ctl3D;\n property Constraints;\n property DoubleBuffered;\n property DragKind;\n property DragCursor;\n property DragMode;\n property Enabled;\n property Font;\n property HideSelection;\n property HotTrack;\n property Indent;\n property Items;\n property ListView;\n property ParentBiDiMode;\n property ParentColor default False;\n property ParentCtl3D;\n{$IFDEF HasParentDoubleBuffered}\n property ParentDoubleBuffered;\n{$ENDIF}\n property ParentFont;\n property ParentShowHint;\n property Path;\n property PopupMenu;\n property ReadOnly;\n property RightClickSelect;\n property RowSelect;\n property ShowButtons;\n property ShowHint;\n property ShowLines;\n property ShowRoot;\n property TabOrder;\n property TabStop default True;\n property ToolTips;\n property Version;\n property Visible;\n property OnChanging;\n property OnClick;\n property OnCollapsed;\n property OnCollapsing;\n property OnContextPopup;\n property OnDblClick;\n property OnDeletion;\n property OnDragDrop;\n property OnDragOver;\n property OnEdited;\n property OnEditing;\n property OnEndDock;\n property OnEndDrag;\n property OnEnter;\n property OnExit;\n property OnExpanding;\n property OnExpanded;\n property OnKeyDown;\n property OnKeyPress;\n property OnKeyUp;\n{$IFDEF HasOnMouseActivate}\n property OnMouseActivate;\n{$ENDIF}\n property OnMouseDown;\n{$IFDEF HasOnMouseEnter}\n property OnMouseEnter;\n property OnMouseLeave;\n{$ENDIF}\n property OnMouseMove;\n property OnMouseUp;\n property OnStartDock;\n property OnStartDrag;\n end;\n\n\n{ ===== TAbProgressBar ====================================================== }\n TAbProgressBar = class(TProgressBar, IAbProgressMeter)\n protected {private}\n function GetVersion : string;\n\n public {methods}\n procedure DoProgress(Progress : Byte);\n procedure Reset;\n\n published {properties}\n property Version: string\n read GetVersion\n stored False;\n end;\n\n\nimplementation\n\n{$R AbComCtrls.res}\n\nuses\n CommCtrl, Contnrs, Forms, ShellAPI, StrUtils, AbConst, AbResString, AbUtils,\n AbZipTyp;\n\nconst\n HDF_SORTDOWN = $0200;\n HDF_SORTUP = $0400;\n\n{ -------------------------------------------------------------------------- }\n{$IF NOT DECLARED(StartsText)}\nfunction StartsText(const aSubText, aText: string): Boolean;\nbegin\n Result := (Length(aText) > Length(aSubText)) and\n SameText(aSubText, Copy(aText, 1, Length(aSubText)));\nend;\n{$IFEND}\n{ -------------------------------------------------------------------------- }\nfunction AbNormalizeFilename(const aFilename: string): string;\nvar\n i: Integer;\nbegin\n Result := aFilename;\n for i := 1 to Length(Result) do\n if IsDelimiter('\\/', Result, i) then\n Result[i] := PathDelim;\n if IsDelimiter(PathDelim, Result, Length(Result)) then\n SetLength(Result, Length(Result) - 1);\nend;\n{ -------------------------------------------------------------------------- }\nvar\n ComCtl32MajorVer: Integer = -1;\n\nfunction IsComCtl32Version6: Boolean;\ntype\n PDllVersionInfo = ^TDllVersionInfo;\n TDllVersionInfo = packed record\n cbSize: DWORD;\n dwMajorVersion: DWORD;\n dwMinorVersion: DWORD;\n dwBuildNumber: DWORD;\n dwPlatformId: DWORD;\n end;\nvar\n DllGetVersion: function(pdvi: PDllVersionInfo): HRESULT; stdcall;\n dvi: TDllVersionInfo;\n hComCtl32: HMODULE;\nbegin\n if ComCtl32MajorVer = -1 then begin\n ComCtl32MajorVer := 0;\n hComCtl32 := LoadLibrary(comctl32);\n if hComCtl32 <> 0 then begin\n DllGetVersion := GetProcAddress(hComCtl32, 'DllGetVersion');\n if Assigned(DllGetVersion) then begin\n dvi.cbSize := SizeOf(dvi);\n if Succeeded(DllGetVersion(@dvi)) then\n ComCtl32MajorVer := dvi.dwMajorVersion;\n end;\n FreeLibrary(hComCtl32);\n end;\n end;\n Result := ComCtl32MajorVer >= 6;\nend;\n{ -------------------------------------------------------------------------- }\nfunction SameEvent(const aEvent1, aEvent2: TNotifyEvent): Boolean;\nbegin\n Result := (TMethod(aEvent1).Code = TMethod(aEvent2).Code) and\n (TMethod(aEvent1).Data = TMethod(aEvent2).Data);\nend;\n\n\n\n{ ===== TAbListItem ========================================================= }\nfunction TAbListItem.GetIsDirectory: Boolean;\nbegin\n Result := (ArchiveItem = nil) or ArchiveItem.IsDirectory;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbListItem.GetIsEncrypted: Boolean;\nbegin\n Result := (ArchiveItem <> nil) and ArchiveItem.IsEncrypted;\nend;\n\n\n{ ===== TAbListItems ======================================================== }\nfunction TAbListItems.GetItem(aIndex: Integer): TAbListItem;\nbegin\n Result := inherited Item[aIndex] as TAbListItem;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbListItems.SetItem(aIndex: Integer; aValue: TAbListItem);\nbegin\n inherited Item[aIndex] := aValue;\nend;\n\n{ ===== TAbCustomListView =================================================== }\nconstructor TAbCustomListView.Create(aOwner: TComponent);\nvar\n Bmp : TBitmap;\n sfi: SHFILEINFO;\nbegin\n inherited;\n FHeaderInstance := MakeObjectInstance(HeaderWndProc);\n // Load header image into an image list; the header's hbm property\n // doesn't support transparency\n FHeaderImages := TImageList.Create(Self);\n Bmp := TBitmap.Create;\n try\n Bmp.LoadFromResourceName(HInstance, 'AbComCtrls_Lock');\n FHeaderImages.AddMasked(Bmp, clFuchsia);\n finally\n Bmp.Free;\n end;\n // Load system image lists\n LargeImages := TImageList.Create(Self);\n LargeImages.ShareImages := True;\n LargeImages.Handle := SHGetFileInfo('', 0, sfi, SizeOf(sfi),\n SHGFI_LARGEICON or SHGFI_SYSICONINDEX);\n SmallImages := TImageList.Create(Self);\n SmallImages.ShareImages := True;\n SmallImages.Handle := SHGetFileInfo('', 0, sfi, SizeOf(sfi),\n SHGFI_SMALLICON or SHGFI_SYSICONINDEX);\n // Load sort arrow bitmaps for older comctrl32.dll versions\n FSortAscending := True;\n FSortColumn := vcName;\n if not IsComCtl32Version6 then begin\n FSortUpBmp := LoadImage(HInstance, 'AbComCtrls_SortUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);\n FSortDownBmp := LoadImage(HInstance, 'AbComCtrls_SortDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DColors);\n end;\n // Set default column visibility\n VisibleColumns := AbDefVisibleColumns;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomListView.Destroy;\nbegin\n if FHeaderHandle <> 0 then\n SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));\n FreeObjectInstance(FHeaderInstance);\n if FSortUpBmp <> 0 then\n DeleteObject(FSortUpBmp);\n if FSortDownBmp <> 0 then\n DeleteObject(FSortDownBmp);\n inherited;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.ColClick(aColumn: TListColumn);\nvar\n Col: TAbViewColumn;\nbegin\n inherited;\n Col := TAbViewColumn(aColumn.Tag);\n Sort(Col, (Col <> FSortColumn) or not FSortAscending);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView.CreateListItem: TListItem;\nbegin\n Result := TAbListItem.Create(Items);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView.CreateListItems: TListItems;\nbegin\n Result := TAbListItems.Create(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.CreateWnd;\nbegin\n inherited;\n FHeaderHandle := ListView_GetHeader(Handle);\n if FHeaderHandle <> 0 then begin\n FDefHeaderProc := TWindowProcPtr(GetWindowLong(FHeaderHandle, GWL_WNDPROC));\n SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance));\n end;\n Header_SetImageList(ListView_GetHeader(Handle), FHeaderImages.Handle);\n UpdateColumns;\n UpdateView;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;\n State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;\nvar\n i: Integer;\n R: TRect;\nbegin\n Result := True;\n if (Stage = cdPrePaint) and TAbListItem(Item).IsEncrypted then\n if TAbViewColumn(Columns[SubItem].Tag) = vcEncrypted then begin\n Result := False;\n R := Item.DisplayRect(drBounds);\n Inc(R.Left, 6);\n for i := 0 to SubItem - 1 do\n Inc(R.Left, Columns[i].Width);\n HeaderImages.Draw(Canvas, R.Left, R.Top, 0);\n end\n else begin\n Result := True;\n // Fixed other columns drawing with wrong font after using TImageList.Draw\n Canvas.Brush.Color := ColorToRGB(Color);\n SetBkMode(Canvas.Handle, TRANSPARENT);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.DblClick;\nbegin\n inherited;\n if TAbListItem(Selected).IsDirectory then\n if Path = '' then\n Path := Selected.Caption\n else\n Path := Path + PathDelim + Selected.Caption;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.DoChange(Sender: TObject);\nbegin\n UpdateView;\n if (Sender = FArchive) and Assigned(FTreeView) then\n FTreeView.DoChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView.GetListItems: TAbListItems;\nbegin\n Result := inherited Items as TAbListItems;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView.GetVersion: string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.HeaderWndProc(var Msg: TMessage);\nconst\n FMT_MASK = HDF_BITMAP or HDF_BITMAP_ON_RIGHT or HDF_SORTDOWN or HDF_SORTUP;\nvar\n Item: THDItem;\nbegin\n if (Msg.Msg = HDM_SETITEM) and not FInUpdateSortArrows then begin\n Item.Mask := HDI_FORMAT;\n if Header_GetItem(FHeaderHandle, Msg.WParam, Item) then begin\n PHDItem(Msg.LParam).Mask := PHDItem(Msg.LParam).Mask and not HDI_BITMAP;\n PHDItem(Msg.LParam).fmt := PHDItem(Msg.LParam).fmt and not FMT_MASK\n or (Item.fmt and FMT_MASK);\n end;\n end;\n Msg.Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg.Msg,\n Msg.WParam, Msg.LParam);\n if Msg.Msg = WM_DESTROY then\n FHeaderHandle := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView.IsCustomDrawn(Target: TCustomDrawTarget;\n Stage: TCustomDrawStage): Boolean;\nbegin\n Result := (vcEncrypted in VisibleColumns) and (Stage = cdPrePaint) and\n (Target = dtSubItem);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.Notification(aComponent: TComponent;\n aOperation: TOperation);\nbegin\n inherited;\n if aOperation = opRemove then begin\n if aComponent = FArchive then begin\n FArchive := nil;\n Clear;\n end;\n if aComponent = FTreeView then begin\n if Assigned(FArchive) and SameEvent(FArchive.OnChange, FTreeView.DoChange) then\n FArchive.OnChange := DoChange;\n FTreeView := nil;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.SetArchive(aValue: TAbBaseBrowser);\nbegin\n if aValue <> FArchive then begin\n if Assigned(FArchive) then begin\n FArchive.RemoveFreeNotification(Self);\n if SameEvent(FArchive.OnChange, DoChange) then\n if Assigned(TreeView) and (TreeView.Archive = FArchive) then\n FArchive.OnChange := TreeView.DoChange\n else\n FArchive.OnChange := nil;\n end;\n FArchive := aValue;\n if Assigned(FArchive) then begin\n FArchive.FreeNotification(Self);\n FArchive.OnChange := DoChange;\n DoChange(Self);\n end\n else\n Items.Clear;\n if Assigned(TreeView) then\n TreeView.Archive := aValue;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.SetFlatList(aValue : Boolean);\nbegin\n if aValue <> FFlatList then begin\n FFlatList := aValue;\n UpdateView;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.SetPath(aValue: string);\nbegin\n if aValue <> FPath then begin\n FPath := ExcludeTrailingPathDelimiter(aValue);\n if Assigned(TreeView) then\n TreeView.Path := aValue;\n if not FlatList then\n UpdateView;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.SetTreeView(aValue: TAbCustomTreeView);\nbegin\n if aValue <> FTreeView then begin\n if Assigned(FTreeView) then begin\n FTreeView.RemoveFreeNotification(Self);\n FTreeView.ListView := nil;\n end;\n FTreeView := aValue;\n if Assigned(FTreeView) then begin\n FTreeView.FreeNotification(Self);\n if Assigned(FArchive) then\n FTreeView.Archive := FArchive\n else if Assigned(FTreeView.Archive) then\n Archive := FTreeView.Archive;\n FTreeView.ListView := Self;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.SetVisibleColumns(aValue : TAbViewColumns);\nbegin\n if aValue <> FVisibleColumns then begin\n FVisibleColumns := aValue;\n UpdateColumns;\n UpdateView;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomListView_SortProc(aItem1, aItem2: TAbListItem;\n aListView: TAbCustomListView): Integer; stdcall;\nvar\n Item1, Item2: TAbArchiveItem;\n Ratio1, Ratio2: Single;\nbegin\n if aItem1.IsDirectory <> aItem2.IsDirectory then\n if aItem1.IsDirectory then\n Result := -1\n else\n Result := 1\n else begin\n Result := 0;\n if aListView.FSortColumn in [vcFileType, vcPath] then begin\n Result := CompareText(aItem1.SubItems[aListView.FSortColIndex],\n aItem2.SubItems[aListView.FSortColIndex]);\n end\n else if not aItem1.IsDirectory then begin\n // Don't do more advanced sorts for directories, since they may be\n // implicitly stored and won't have corresponding archive items\n Item1 := aItem1.ArchiveItem;\n Item2 := aItem2.ArchiveItem;\n case aListView.FSortColumn of\n vcLastModified:\n begin\n if Item1.LastModTimeAsDateTime < Item2.LastModTimeAsDateTime then\n Result := -1\n else if Item1.LastModTimeAsDateTime > Item2.LastModTimeAsDateTime then\n Result := 1;\n end;\n vcSize:\n begin\n if Item1.UncompressedSize < Item2.UncompressedSize then\n Result := -1\n else if Item1.UncompressedSize > Item2.UncompressedSize then\n Result := 1;\n end;\n vcRatio:\n begin\n if Item1.UncompressedSize > 0 then\n Ratio1 := Item1.CompressedSize / Item1.UncompressedSize\n else\n Ratio1 := 1;\n if Item2.UncompressedSize > 0 then\n Ratio2 := Item2.CompressedSize / Item2.UncompressedSize\n else\n Ratio2 := 1;\n if Ratio1 > Ratio2 then\n Result := -1\n else if Ratio1 < Ratio2 then\n Result := 1\n end;\n vcPacked:\n begin\n if Item1.CompressedSize < Item2.CompressedSize then\n Result := -1\n else if Item1.CompressedSize > Item2.CompressedSize then\n Result := 1;\n end;\n vcCRC:\n begin\n if Longword(Item1.CRC32) < Longword(Item2.CRC32) then\n Result := -1\n else if Longword(Item1.CRC32) > Longword(Item2.CRC32) then\n Result := 1;\n end;\n vcAttributes,\n vcMethod:\n begin\n Result := CompareText(aItem1.SubItems[aListView.FSortColIndex],\n aItem2.SubItems[aListView.FSortColIndex]);\n end;\n vcEncrypted:\n begin\n if not Item1.IsEncrypted and Item2.IsEncrypted then\n Result := -1\n else if Item1.IsEncrypted and not Item2.IsEncrypted then\n Result := 1\n end;\n end;\n end;\n if Result = 0 then\n Result := AnsiCompareText(aItem1.Caption, aItem2.Caption);\n end;\n if not aListView.FSortAscending then\n Result := -Result;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.Sort(aColumn: TAbViewColumn; aAscending: Boolean);\nbegin\n if (aColumn <> FSortColumn) or (aAscending <> FSortAscending) then begin\n FSortColumn := aColumn;\n FSortAscending := aAscending;\n UpdateSortArrow;\n CustomSort(TLVCompare(@TAbCustomListView_SortProc), LPARAM(Self));\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.UpdateColumns;\nconst\n ColWidths: array[TAbViewColumn] of Integer = (\n 180{vcName}, 110{vcFileType}, 130{vcLastModified}, 80{vcSize}, 50{vcRatio},\n 80{vcPacked}, 70{vcCRC}, 30{vcAttributes}, 28{vcEncrypted}, 60{vcMethod},\n 300{vcPath});\nvar\n Col: TAbViewColumn;\n Column: TListColumn;\nbegin\n if HandleAllocated then\n Items.BeginUpdate;\n Columns.BeginUpdate;\n try\n Columns.Clear;\n for Col := Low(Col) to High(Col) do begin\n if not (Col in FVisibleColumns) then\n Continue;\n Column := Columns.Add;\n case Col of\n vcName: Column.Caption := AbItemNameHeadingS;\n vcFileType: Column.Caption := AbFileTypeHeadingS;\n vcLastModified: Column.Caption := AbLastModifiedHeadingS;\n vcSize: Column.Caption := AbFileSizeHeadingS;\n vcRatio: Column.Caption := AbRatioHeadingS;\n vcPacked: Column.Caption := AbPackedHeadingS;\n vcCRC: Column.Caption := AbCRCHeadingS;\n vcAttributes: Column.Caption := AbFileAttrHeadingS;\n vcEncrypted: Column.ImageIndex := 0;\n vcMethod: Column.Caption := AbMethodHeadingS;\n vcPath: Column.Caption := AbPathHeadingS;\n end;\n Column.Width := ColWidths[Col];\n Column.Tag := Ord(Col);\n if Col in [vcSize, vcRatio, vcPacked] then\n Column.Alignment := taRightJustify;\n end;\n finally\n Columns.EndUpdate;\n if HandleAllocated then\n Items.EndUpdate;\n end;\n UpdateSortArrow;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.UpdateSortArrow;\nvar\n i: Integer;\n Item: THDITEM;\nbegin\n if not HandleAllocated then\n Exit;\n FInUpdateSortArrows := True;\n try\n for i := 0 to Columns.Count - 1 do begin\n FillChar(Item, SizeOf(Item), 0);\n Item.Mask := HDI_FORMAT;\n if not IsComCtl32Version6 then\n Item.Mask := Item.Mask or HDI_BITMAP;\n Header_GetItem(FHeaderHandle, Columns[i].Index, Item);\n // Add sort arrow to requested column\n if TAbViewColumn(Columns[i].Tag) = FSortColumn then begin\n FSortColIndex := i - 1;\n if IsComCtl32Version6 then begin\n Item.fmt := Item.fmt and not (HDF_SORTDOWN or HDF_SORTUP);\n if FSortAscending then\n Item.fmt := Item.fmt or HDF_SORTUP\n else\n Item.fmt := Item.fmt or HDF_SORTDOWN;\n end\n else begin\n Item.fmt := Item.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;\n if FSortAscending then\n Item.hbm := FSortUpBmp\n else\n Item.hbm := FSortDownBmp;\n end;\n end\n // Remove sort arrow from other columns\n else begin\n if IsComCtl32Version6 then\n Item.fmt := Item.fmt and not (HDF_SORTDOWN or HDF_SORTUP)\n else begin\n Item.Mask := Item.Mask and not HDI_BITMAP;\n Item.fmt := Item.fmt and not (HDF_BITMAP OR HDF_BITMAP_ON_RIGHT);\n end;\n end;\n Header_SetItem(FHeaderHandle, Columns[i].Index, Item);\n end;\n finally\n FInUpdateSortArrows := False;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomListView.UpdateView;\nvar\n ArcItem: TAbArchiveItem;\n Col: TAbViewColumn;\n ColImage: Integer;\n ColText, Filename, FolderName: string;\n DOSAttr: Integer;\n Folders: TStringList;\n i, j: Integer;\n ListItem: TAbListItem;\n ParentDir: string;\n sfi: SHFILEINFO;\nbegin\n ListItem := nil; // Suppress compiler warning\n if (Items.Count = 0) and (FArchive = nil) then\n Exit;\n Items.BeginUpdate;\n try\n Items.Clear;\n if Assigned(FArchive) then begin\n Folders := TStringList.Create;\n try\n for i := 0 to FArchive.Count - 1 do\n if FArchive[i].Action <> aaDelete then begin\n ArcItem := FArchive[i];\n Filename := AbNormalizeFilename(ArcItem.FileName);\n // Exclude unwanted items\n if FlatList and ArcItem.IsDirectory then\n Continue;\n // Create new ListItem\n ParentDir := ExtractFileDir(FileName);\n if FlatList or (ParentDir = Path) then begin\n // If an ListItem has already been created for a folder, use it\n if ArcItem.IsDirectory then begin\n FolderName := ExtractFileName(FileName);\n if Folders.Find(FolderName, j) then\n ListItem := Folders.Objects[j] as TAbListItem\n else begin\n ListItem := Items.Add as TAbListItem;\n Folders.AddObject(FolderName, ListItem);\n end\n end\n else\n ListItem := Items.Add as TAbListItem;\n ListItem.ArchiveItem := FArchive[i];\n end\n else if (Path = '') or StartsText(Path + PathDelim, ParentDir) then begin\n // Create folder for implicitly stored directories,\n // if one hasn't been created already\n while ParentDir <> Path do begin\n FileName := ParentDir;\n ParentDir := ExtractFileDir(FileName);\n end;\n FolderName := ExtractFileName(FileName);\n if Folders.IndexOf(FolderName) <> -1 then\n Continue;\n ListItem := Items.Add as TAbListItem;\n Folders.AddObject(FolderName, ListItem);\n ArcItem := nil;\n end\n else\n // ListItem isn't below Path\n Continue;\n // Get file type information from the shell\n if ListItem.IsDirectory then\n DOSAttr := FILE_ATTRIBUTE_DIRECTORY\n else\n DOSAttr := FILE_ATTRIBUTE_NORMAL;\n SHGetFileInfo(PChar(ExtractFileName(Filename)), DOSAttr, sfi, sizeof(sfi),\n SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);\n // Fill in columns\n ListItem.Caption := ExtractFileName(Filename);\n ListItem.ImageIndex := sfi.iIcon;\n ListItem.SubItems.Clear;\n for Col := Succ(Low(Col)) to High(Col) do\n if Col in FVisibleColumns then begin\n ColText := '';\n ColImage := -1;\n case Col of\n vcFileType:\n ColText := sfi.szTypeName;\n vcLastModified:\n if ArcItem <> nil then\n ColText := DateToStr(ArcItem.LastModTimeAsDateTime) + ' ' +\n TimeToStr(ArcItem.LastModTimeAsDateTime);\n vcSize:\n if not ListItem.IsDirectory then\n ColText := FormatFloat('#,##0', ArcItem.UncompressedSize);\n vcRatio:\n if not ListItem.IsDirectory then\n if ArcItem.UncompressedSize > 0 then\n ColText := Format('%d%%',\n [100 - Round(ArcItem.CompressedSize * 100 / ArcItem.UncompressedSize)])\n else\n ColText := '0%';\n vcPacked:\n if not ListItem.IsDirectory then\n ColText := FormatFloat('#,##0', ArcItem.CompressedSize);\n vcCRC:\n if not ListItem.IsDirectory then\n ColText := IntToHex(ArcItem.CRC32, 8);\n vcAttributes:\n if ArcItem <> nil then begin\n {$WARN SYMBOL_PLATFORM OFF}\n if (faReadOnly and ArcItem.ExternalFileAttributes) = faReadOnly then\n ColText := ColText + AbReadOnlyS;\n if (faHidden and ArcItem.ExternalFileAttributes) = faHidden then\n ColText := ColText + AbHiddenS;\n if (faSysFile and ArcItem.ExternalFileAttributes) = faSysFile then\n ColText := ColText + AbSystemS;\n if (faArchive and ArcItem.ExternalFileAttributes) = faArchive then\n ColText := ColText + AbArchivedS;\n {$WARN SYMBOL_PLATFORM ON}\n end;\n vcMethod:\n if ArcItem is TAbZipItem then\n ColText := ZipCompressionMethodToString(\n TAbZipItem(ArcItem).CompressionMethod);\n vcPath:\n ColText := ExtractFileDir(FileName);\n end;\n ListItem.SubItems.Add(ColText);\n ListItem.SubItemImages[ListItem.SubItems.Count - 1] := ColImage;\n end;\n end;\n finally\n Folders.Free;\n end;\n CustomSort(TLVCompare(@TAbCustomListView_SortProc), LPARAM(Self));\n end;\n finally\n Items.EndUpdate;\n end;\nend;\n\n\n{ ===== TAbCustomTreeView =================================================== }\nconstructor TAbCustomTreeView.Create(aOwner: TComponent);\nvar\n Bmp : TBitmap;\n Icon : TIcon;\n sfi: SHFILEINFO;\nbegin\n inherited;\n HideSelection := False;\n Images := TImageList.Create(Self);\n Bmp := TBitmap.Create;\n try\n Bmp.LoadFromResourceName(HInstance, 'AbComCtrls_Zip');\n Images.AddMasked(Bmp, clFuchsia);\n Icon := TIcon.Create;\n try\n // On Windows 7 an empty filename returns the drive icon instead of a folder\n SHGetFileInfo('Folder', FILE_ATTRIBUTE_DIRECTORY, sfi, sizeof(sfi),\n SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);\n Icon.Handle := sfi.hIcon;\n Bmp.PixelFormat := pf24bit;\n Bmp.Canvas.Brush.Color := clWindow;\n Bmp.Canvas.FillRect(Rect(0, 0, 16, 16));\n Bmp.Canvas.Draw(0, 0, Icon);\n Images.AddMasked(Bmp, clWindow);\n SHGetFileInfo('Folder', FILE_ATTRIBUTE_DIRECTORY, sfi, sizeof(sfi),\n SHGFI_ICON or SHGFI_OPENICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES);\n Icon.Handle := sfi.hIcon;\n Bmp.Canvas.FillRect(Rect(0, 0, 16, 16));\n Bmp.Canvas.Draw(0, 0, Icon);\n Images.AddMasked(Bmp, clWindow);\n finally\n Icon.Free;\n end;\n finally\n Bmp.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.Change(aNode: TTreeNode);\nvar\n Filename: string;\nbegin\n inherited;\n if aNode.Selected then begin\n Filename := '';\n if aNode <> Items.GetFirstNode then begin\n Filename := aNode.Text;\n aNode := aNode.Parent;\n while aNode <> Items.GetFirstNode do begin\n Filename := aNode.Text + PathDelim + Filename;\n aNode := aNode.Parent;\n end;\n end;\n Path := Filename;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.DoChange(Sender: TObject);\nvar\n Nodes: TStringList;\n ZipNode: TTreeNode;\n\n function GetNode(const aFilename: string): TTreeNode;\n var\n i: Integer;\n begin\n if aFilename = '' then\n Result := ZipNode\n else if Nodes.Find(aFilename, i) then\n Result := TTreeNode(Nodes.Objects[i])\n else begin\n Result := Items.AddChild(GetNode(ExtractFileDir(aFilename)),\n ExtractFileName(aFilename));\n {$IFDEF HasTreeViewExpandedImageIndex}\n Result.ExpandedImageIndex := AbTreeFolderExpandedImage;\n {$ENDIF}\n Result.ImageIndex := AbTreeFolderImage;\n Nodes.AddObject(aFilename, Result);\n end;\n end;\n\nvar\n i: Integer;\n Filename: string;\nbegin\n Items.BeginUpdate;\n try\n Items.Clear;\n if Assigned(FArchive) then begin\n Nodes := TStringList.Create;\n try\n Nodes.Sorted := True;\n if Archive.FArchive <> nil then\n Filename := ExtractFileName(Archive.FArchive.ArchiveName)\n else\n Filename := PathDelim;\n ZipNode := Items.AddChild(nil, Filename);\n {$IFDEF HasTreeViewExpandedImageIndex}\n ZipNode.ExpandedImageIndex := AbTreeArchiveImage;\n {$ENDIF}\n ZipNode.ImageIndex := AbTreeArchiveImage;\n for i := 0 to FArchive.Count - 1 do\n if FArchive[i].Action <> aaDelete then begin\n Filename := AbNormalizeFilename(FArchive[i].FileName);\n if not FArchive[i].IsDirectory then\n Filename := ExtractFileDir(Filename);\n GetNode(Filename);\n end;\n finally\n Nodes.Free;\n end;\n Items.AlphaSort(True);\n ZipNode.Expand(False);\n SelectPathNode;\n end;\n finally\n Items.EndUpdate;\n end;\n if (Sender = FArchive) and Assigned(FListView) then\n FListView.DoChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.GetSelectedIndex(aNode: TTreeNode);\nbegin\n {$IFDEF HasTreeViewExpandedImageIndex}\n if aNode.Expanded then\n aNode.SelectedIndex := aNode.ExpandedImageIndex\n else\n {$ENDIF}\n aNode.SelectedIndex := aNode.ImageIndex;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomTreeView.GetVersion: string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.Notification(aComponent: TComponent;\n aOperation: TOperation);\nbegin\n inherited;\n if aOperation = opRemove then begin\n if aComponent = FArchive then begin\n FArchive := nil;\n Items.Clear;\n end;\n if aComponent = FListView then begin\n if Assigned(FArchive) and SameEvent(FArchive.OnChange, FListView.DoChange) then\n FArchive.OnChange := DoChange;\n FListView := nil;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.SelectPathNode;\nvar\n Filename, Remaining: string;\n i: Integer;\n Node: TTreeNode;\nbegin\n // Find selected node, expanding parents along the way\n Node := Items.GetFirstNode;\n Remaining := FPath;\n if StartsText(PathDelim, Remaining) then\n System.Delete(Remaining, 1, 1);\n while Remaining <> '' do begin\n Node.Expand(False);\n i := Pos(PathDelim, Remaining);\n if i = 0 then\n i := Length(Remaining) + 1;\n Filename := Copy(Remaining, 1, i - 1);\n Remaining := Copy(Remaining, i + 1, MaxInt);\n if Filename = '' then\n Continue;\n Node := Node.getFirstChild;\n while (Node <> nil) and not SameText(Filename, Node.Text) do\n Node := Node.getNextSibling;\n if Node = nil then begin\n Node := Items.GetFirstNode;\n Break;\n end;\n end;\n Selected := Node;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.SetArchive(aValue: TAbBaseBrowser);\nbegin\n if aValue <> FArchive then begin\n if Assigned(FArchive) then begin\n FArchive.RemoveFreeNotification(Self);\n if SameEvent(FArchive.OnChange, DoChange) then\n if Assigned(ListView) and (ListView.Archive = FArchive) then\n FArchive.OnChange := ListView.DoChange\n else\n FArchive.OnChange := nil;\n end;\n FArchive := aValue;\n if Assigned(FArchive) then begin\n FArchive.FreeNotification(Self);\n FArchive.OnChange := DoChange;\n DoChange(Self);\n end\n else\n Items.Clear;\n if Assigned(ListView) then\n ListView.Archive := aValue;\n SelectPathNode;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.SetListView(aValue: TAbCustomListView);\nbegin\n if aValue <> FListView then begin\n if Assigned(FListView) then begin\n FListView.RemoveFreeNotification(Self);\n FListView.TreeView := nil;\n end;\n FListView := aValue;\n if Assigned(FListView) then begin\n FListView.FreeNotification(Self);\n if Assigned(FArchive) then\n FListView.Archive := FArchive\n else if Assigned(FListView.Archive) then\n Archive := FListView.Archive;\n FListView.TreeView := Self;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomTreeView.SetPath(const aValue: string);\nbegin\n if FPath <> aValue then begin\n FPath := ExcludeTrailingPathDelimiter(aValue);\n SelectPathNode;\n if Assigned(FListView) then\n FListView.Path := aValue;\n end;\nend;\n\n\n{ ===== TAbProgressBar ====================================================== }\nprocedure TAbProgressBar.DoProgress(Progress : Byte);\nbegin\n Position := Progress;\n Application.ProcessMessages;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbProgressBar.GetVersion : string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbProgressBar.Reset;\nbegin\n DoProgress(0);\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCompnd.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCompnd.pas *}\n{*********************************************************}\n{* ABBREVIA: Compound File classes and component *}\n{* Use AbQCmpnd.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbCompnd;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes, SysUtils,\n{$IFDEF UsingClx}\n QComCtrls,\n{$ELSE}\n ComCtrls,\n{$ENDIF}\n AbBase, AbResString, AbDfDec, AbDfEnc, AbDfBase;\n\nconst\n AbCompoundFileVersion = '3.1';\n\nconst\n {SystemBlock constants}\n sbSignatureSize = 40; {byte size of Signature field}\n sbVolumeLabelSize = 40; {byte size of Volume Label field}\n sbAllocationSizeSize = 4; {byte size of Allocation Size field}\n sbVersionSize = 4; {byte size of Version field}\n sbUpdateSize = 1; {byte size of Updating Flag field}\n\n {Total size of System Block}\n SizeOfSystemBlock = sbSignatureSize + sbVolumeLabelSize +\n sbAllocationSizeSize + sbVersionSize + sbUpdateSize;\n\n {RootDir constants}\n rdEntryNameSize = 28; {byte size of Name field}\n rdEntryIDSize = 4; {byte size of EntryID field}\n rdParentFolderSize = 4; {byte size of ParentFolder field}\n rdEntryTypeSize = 4; {byte size of EntryType field}\n rdAttributesSize = 4; {byte size of Attributes field}\n rdStartBlockSize = 4; {byte size of StartBlock field}\n rdLastModifiedSize = 8; {byte size of LastModified field}\n rdSizeSize = 4; {byte size of UncompressedSize field}\n rdCompressedSizeSize = 4; {byte size of CompressedSize field}\n\n {Total size of a single Root Directory Entry}\n rdSizeOfDirEntry = rdEntryNameSize + rdEntryIDSize + rdParentFolderSize +\n rdEntryTypeSize + rdAttributesSize + rdStartBlockSize +\n rdLastModifiedSize + rdSizeSize + rdCompressedSizeSize;\n\n rdUnUsed = -2; {Constant used to flag an RD entry as unused}\n\n {Total size of a Root Directory entry}\n SizeOfRootDirBlock = rdEntryNameSize + rdEntryIDSize + rdParentFolderSize +\n rdEntryTypeSize + rdAttributesSize + rdStartBlockSize +\n rdLastModifiedSize + rdSizeSize + rdCompressedSizeSize;\n\n {FAT table constants}\n ftEndOfBlock = -1; {End of Block}\n ftUnusedBlock = -2; {Unused Block}\n\n {General constants}\n cfAllocationSize = 512; {Default AllocationSize (bytes)}\n\ntype\n ECompoundFileError = class(Exception);\n TrdEntryType = (etFolder, etFile);\n\n {dynamic array parameter for returning FAT chain sequences}\n type TFATChainArray = array of Integer;\n\n {forwards}\n{$M+}\n TAbCompoundFile = class;\n{$M-}\n TBeforeDirDeleteEvent = procedure(Sender : TAbCompoundFile; Dir : AnsiString;\n var AllowDelete : Boolean) of object;\n TBeforeDirModifiedEvent = procedure(Sender : TAbCompoundFile; Dir : AnsiString;\n var AllowModify : Boolean) of object;\n TBeforeFileDeleteEvent = procedure(Sender : TAbCompoundFile;FileName : AnsiString;\n var AllowDelete : Boolean) of object;\n TBeforeFileModifiedEvent = procedure(Sender : TAbCompoundFile;\n FileName : AnsiString; var AllowModify :\n Boolean) of object;\n\n TMultiNode = class(TObject)\n protected {private}\n FParent : Pointer; {pointer to the parent node}\n FKey : AnsiString; {node identifier}\n FChildren : TStringList; {list for child keys & nodes}\n FData : TObject; {contained object}\n\n function GetChildCount : Integer;\n public\n constructor Create(const Key : AnsiString);\n destructor Destroy; override;\n function AddChild(const Key : AnsiString) : TMultiNode;\n procedure DeleteChild(Index : Integer);\n function DeleteChildByName(const ChildKey : AnsiString) : Boolean;\n function DeleteChildren : Boolean;\n function GetChild(Index : integer) : TMultiNode;\n function GetChildByName(const Key : AnsiString) : TMultiNode;\n function HasParent : Boolean;\n function HasChildren : Boolean;\n function Contains(const Key : AnsiString) : Boolean;\n property Parent : Pointer read FParent write FParent;\n property ChildCount : Integer read GetChildCount;\n property Children[Index : Integer] : TMultiNode read GetChild;\n property Data : TObject read FData write FData;\n property Key : AnsiString read FKey write FKey;\n end;\n\n\n TMultiTree = class(TObject)\n protected {private}\n FRoot : TMultiNode; {reference to root node}\n FCount : Integer; {count of nodes in the tree}\n FCurrentNode : TMultiNode; {analogous to current directory}\n FSepChar : AnsiChar; {directory separator character}\n FIDCount : Integer; {counter incremented during preorder trav.}\n {(used to assign unique ID to each node)}\n\n procedure VisitSubNodesPost(Node : TMultiNode; ID : Integer);\n procedure VisitSubNodesPre(Node : TMultiNode; Strm : TStream);\n procedure VisitNode(Node : TMultiNode; Strm : TStream);\n procedure ParseDirStr(const Key : AnsiString; Lst : TStringList);\n procedure PopulateSubNodes(ParentNode : TMultiNode;\n TreeView : TTreeView; TreeNode : TTreeNode);\n procedure TraversePost(ID : Integer);\n procedure TraversePre(Strm : TStream);\n\n public\n constructor Create;\n destructor Destroy; override;\n function Insert(ParentNode : TMultiNode; const Key : AnsiString) : TMultiNode;\n function GetNode(const Key : AnsiString) : TMultiNode;\n function DeleteNode(const Key : AnsiString) : Boolean;\n procedure ChangeDir(const Key : AnsiString);\n function PopulateTreeView(TreeView : TTreeView) : Integer;\n property Root : TMultiNode read FRoot;\n property Count : Integer read FCount;\n property CurrentNode : TMultiNode read FCurrentNode;\n property SepChar : AnsiChar read FSepChar write FSepChar;\n end;\n\n\n TAbSystemBlock = class(TObject)\n protected {private}\n FSignature : AnsiString; {identifies the compound file structure}\n FVolumeLabel : AnsiString; {file identification in addition to filename}\n FAllocationSize : Integer; {size of allocation block}\n FVersion : AnsiString; {version string identifier}\n FUpdating : Boolean; {internal processing indicator}\n\n {protected methods}\n procedure BeginUpdate;\n procedure EndUpdate;\n procedure WriteToStream(Strm : TMemoryStream);\n\n {properties}\n property Signature : AnsiString read FSignature write FSignature;\n property VolumeLabel : AnsiString read FVolumeLabel write FVolumeLabel;\n property Updating : Boolean read FUpdating;\n property AllocationSize : Integer\n read FAllocationSize write FAllocationSize;\n property Version : AnsiString read FVersion;\n public\n constructor Create(const VolLabel : AnsiString; AllocationSz : Integer);\n end;\n\n TAbDirectoryEntry = class(TObject)\n protected {private}\n FName : AnsiString; {name of file or folder}\n FEntryID : Integer; {unique ID for this dir. entry}\n FParentFolder : LongInt; {unique ID of parent folder}\n FEntryType : TrdEntryType; {folder or file}\n FAttributes : LongInt; {file system attributes}\n FStartBlock : LongInt; {starting allocation block}\n FLastModified : TDateTime; {last modification date/time}\n FSize : LongInt; {uncompressed file size}\n FCompressedSize : LongInt; {compressed file size}\n\n procedure WriteToStream(Strm : TMemoryStream);\n function IsReadOnly : Boolean;\n function IsHidden : Boolean;\n function IsSysFile : Boolean;\n function IsVolumeID : Boolean;\n function IsDirectory : Boolean;\n function IsArchive : Boolean;\n function GetIsFree : Boolean;\n\n public\n constructor Create(AsFile : Boolean);\n\n property EntryName : AnsiString read FName write FName;\n property ParentFolder : LongInt read FParentFolder write FParentFolder;\n property Attributes : LongInt read FAttributes write FAttributes;\n property StartBlock : LongInt read FStartBlock write FStartBlock;\n property LastModified : TDateTime read FLastModified write FLastModified;\n property Size : LongInt read FSize write FSize;\n property CompressedSize : LongInt\n read FCompressedSize write FCompressedSize;\n property IsFree : Boolean read GetIsFree;\n property EntryType : TrdEntryType read FEntryType write FEntryType;\n end;\n\n\n TAbRootDir = class(TMultiTree)\n fAllocSize : Integer;\n protected {private}\n function AddFolder(FolderName : AnsiString) : TAbDirectoryEntry;\n function AddFile(FileName : AnsiString) : TAbDirectoryEntry;\n procedure DeleteFolder(FolderName : AnsiString);\n procedure DeleteFile(FileName : AnsiString);\n procedure WriteToStream(Strm : TMemoryStream);\n procedure GoToEntryID(ID : Integer);\n public\n constructor Create(VolLabel : AnsiString; AllocSize : Integer);\n destructor Destroy; override;\n end;\n\n\n TAbFATTable = class(TObject)\n protected {private}\n fFATArray : Array of Integer; {dynamic array for the FAT}\n fAllocSize : Integer;\n\n procedure WriteToStream(Strm : TMemoryStream);\n\n public\n constructor Create(AllocSize : Integer);\n destructor Destroy; override;\n function IsEndOfFile(Ndx : Integer) : Boolean;\n function IsUnUsed(Ndx : Integer) : Boolean;\n function GetNextUnusedBlock : Integer;\n procedure GetNewChain(NumBytes : Integer;\n var ChainArray : TFATChainArray);\n procedure GetExistingChain(StartNdx : Integer;\n var ChainArray : TFATChainArray);\n procedure ClearExistingChain(StartNdx : Integer);\n procedure GetRootDirChain(var ChainArray : TFATChainArray);\n procedure GetFATChain(var ChainArray : TFATChainArray);\n procedure GetNewRootDirChain(NumBytes : Integer;\n var ChainArray : TFATChainArray);\n procedure GetNewFATChain(NumBytes : Integer;\n var ChainArray : TFATChainArray);\n procedure ClearRootDirChain;\n procedure ClearFATChain;\n end;\n\n\n TAbCompoundFile = class(TObject)\n protected {private}\n FSystemBlock : TAbSystemBlock; {system block}\n FFATTable : TAbFATTable; {FAT table}\n FRootDir : TAbRootDir; {root directory}\n FDiskFile : string; {compound file name}\n FSizeOnDisk : Integer; {sum total of compressed sizes +\n uncompressed Sys, RootDir, & FAT blks}\n FStream : TFileStream; {Compound file stream (*.cf)}\n\n FOnAfterOpen : TNotifyEvent;\n FOnBeforeClose : TNotifyEvent;\n FOnBeforeDirDelete : TBeforeDirDeleteEvent;\n FOnBeforeDirModified : TBeforeDirModifiedEvent;\n FOnBeforeFileDelete : TBeforeFileDeleteEvent;\n FOnBeforeFileModified : TBeforeFileModifiedEvent;\n\n function GetVolumeLabel : AnsiString;\n procedure SetVolumeLabel(Val : AnsiString);\n function GetDirectoryEntries : Integer;\n function GetSizeOnDisk : Integer;\n procedure PersistFileData(FileData : TStream;\n var ChainArray : TFATChainArray);\n procedure PersistSystemBlock;\n procedure PersistRootDirBlock;\n procedure PersistFATBlock;\n procedure BuildSysBlock;\n procedure BuildFat;\n procedure BuildRootDir;\n procedure AddDirEntriesFromList(Lst : TStringList);\n\n procedure Defrag; {not implemented}\n public\n constructor Create(const FileName : string; const VolLabel : AnsiString;\n AllocSize : Integer); overload;\n constructor Create(const FileName : string; const VolLabel : AnsiString;\n AllocSize : Integer; const Signature: AnsiString); overload;\n destructor Destroy; override;\n procedure EnumerateFiles(Lst : TStringList);\n procedure EnumerateFolders(Lst : TStringList);\n procedure AddFile(FName : AnsiString; FileData : TStream; FileSize : Integer);\n function AddFolder(FName : AnsiString) : Boolean;\n procedure UpdateFile(FName : AnsiString; FData : TStream);\n procedure DeleteFile(FName : AnsiString);\n procedure DeleteFolder(FName : AnsiString);\n procedure Open(const FName : string); overload;\n procedure Open(const FName : string; const Signature: AnsiString); overload;\n function OpenFile(FileName : AnsiString; var Strm : TStream) : Integer;\n function PopulateTreeView(TreeView : TTreeView) : Integer;\n procedure PopulateSubNodes(ParentNode : TMultiNode;\n TreeView : TTreeView; TreeNode : TTreeNode);\n procedure RenameFile(OrigName, NewName : AnsiString);\n procedure RenameFolder(OrigName, NewName : AnsiString);\n procedure SetCurrentDirectory(val : AnsiString);\n function GetCurrentDirectory : AnsiString;\n function GetAllocationSize : Integer;\n property CurrentDirectory : AnsiString\n read GetCurrentDirectory write SetCurrentDirectory;\n property DirectoryEntries : Integer read GetDirectoryEntries;\n property SizeOnDisk : Integer read GetSizeOnDisk;\n property Stream : TFileStream read FStream write FStream;\n\n\n published\n property VolumeLabel : AnsiString read GetVolumeLabel write SetVolumeLabel;\n property FileName : string read FDiskFile;\n property AllocationSize : Integer read GetAllocationSize;\n\n property OnAfterOpen : TNotifyEvent\n read FOnAfterOpen write FOnAfterOpen;\n property OnBeforeClose : TNotifyEvent\n read FOnBeforeClose write FOnBeforeClose;\n property OnBeforeDirDelete : TBeforeDirDeleteEvent\n read FOnBeforeDirDelete write FOnBeforeDirDelete;\n property OnBeforeDirModified : TBeforeDirModifiedEvent\n read FOnBeforeDirModified write FOnBeforeDirModified;\n property OnBeforeFileDelete : TBeforeFileDeleteEvent\n read FOnBeforeFileDelete write FOnBeforeFileDelete;\n property OnBeforeFileModified : TBeforeFileModifiedEvent\n read FOnBeforeFileModified write FOnBeforeFileModified;\n end;\n\nimplementation\n\nuses\n StrUtils,\n {$IFDEF HasAnsiStrings}AnsiStrings,{$ENDIF}\n ABUtils;\n\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TMultiNode}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TMultiNode.Create(const Key : AnsiString);\n {- Creates and initializes a new node}\nbegin\n inherited Create;\n FKey := Key;\n FChildren := TStringList.Create;\n FChildren.Sorted := True;\n FChildren.Duplicates := dupError;\nend;\n{-----------------------------------------------------------------------------}\ndestructor TMultiNode.Destroy;\n {- Destroys the node and all of the children}\nvar\n i : integer;\nbegin\n {free children}\n for i := FChildren.Count - 1 downto 0 do\n FChildren.Objects[i].Free;\n FChildren.Free;\n if Assigned(FData) then\n TAbDirectoryEntry(FData).Free;\n inherited Destroy;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.AddChild(const Key : AnsiString) : TMultiNode;\n {- Creates and adds a new node - returns the newly added node}\nbegin\n if Contains(Key) then\n Result := nil\n else begin\n Result := TMultiNode.Create(Key);\n Result.Parent := self;\n FChildren.AddObject(string(Key), Result);\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.Contains(const Key : AnsiString) : Boolean;\n {- Returns true if the node contains a child of the name specified by 'Key'}\nbegin\n Result := (FChildren.IndexOf(string(Key)) >= 0);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiNode.DeleteChild(Index : Integer);\n {- Deletes the child node specified by 'Index'}\nbegin\n if ((Index < 0) or (Index > FChildren.Count - 1)) then\n raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds);\n FChildren.Objects[Index].Free;\n FChildren.Delete(Index);\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.DeleteChildByName(const ChildKey : AnsiString) : Boolean;\n {- If node found, node is deleted and true is returned, else returns false}\nbegin\n Result := Contains(ChildKey);\n if Result then begin\n FChildren.Objects[FChildren.IndexOf(string(ChildKey))].Free;\n FChildren.Delete(FChildren.IndexOf(string(ChildKey)));\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.DeleteChildren : Boolean;\n {- Deletes all child nodes}\nvar\n i : Integer;\nbegin\n Result := FChildren.Count > 0;\n for i := FChildren.Count - 1 downto 0 do begin\n FChildren.Objects[i].Free;\n FChildren.Delete(i);\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.GetChild(Index : integer) : TMultiNode;\n {- Returns the node specified by Index}\nbegin\n if ((Index < 0) or (Index > FChildren.Count - 1)) then\n raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds);\n Result := (FChildren.Objects[Index] as TMultiNode);\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.GetChildByName(const Key : AnsiString) : TMultiNode;\n {- Returns the child node specified by 'Key'. If not found, result = nil}\nbegin\n Result := nil;\n if Contains(Key) then\n Result := (FChildren.Objects[FChildren.IndexOf(string(Key))] as TMultiNode);\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.GetChildCount : Integer;\n {- Returns the node's children count}\nbegin\n Result := FChildren.Count;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.HasParent : Boolean;\n {- Returns true if parent is assigned, else returns false}\nbegin\n Result := (FParent <> nil);\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiNode.HasChildren : Boolean;\n {- Returns true if the node contains 1 or more child nodes.}\nbegin\n Result := (FChildren.Count > 0);\nend;\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TMultiTree}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TMultiTree.Create;\n {- creates an empty tree}\nbegin\n inherited Create;\n FSepChar := '\\';\nend;\n{-----------------------------------------------------------------------------}\ndestructor TMultiTree.Destroy;\n {- destroys all nodes (post-order)}\nvar\n Curr : TMultiNode;\nbegin\n Curr := Root;\n while Curr <> nil do begin\n if Curr.HasChildren then\n Curr := Curr.Children[0]\n else\n begin\n if Curr = Root then begin\n Curr.Free;\n exit;\n end else begin\n Curr := Curr.Parent;\n Curr.DeleteChild(0);\n end;\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.ChangeDir(const Key : AnsiString);\n {- Sets current directory of tree if path('Key') is valid}\nvar\n Node : TMultiNode;\n Lst : TStringList;\n i, Ndx : integer;\n NotFound : Boolean;\nbegin\n if Root = nil then exit;\n NotFound := False;\n Lst := TStringList.Create;\n try\n ParseDirStr(Key, Lst);\n Node := CurrentNode;\n for i := 0 to Lst.Count - 1 do begin\n\n if Lst.Strings[i] = '\\' then begin\n Node := Root;\n Continue;\n end\n\n else if Lst.Strings[i] = '.' then\n Continue\n\n else if Lst.Strings[i] = '..' then begin\n if Node <> Root then\n Node := TMultiNode(Node.Parent);\n end else begin\n Ndx := Node.FChildren.IndexOf(Lst.Strings[i]);\n if Ndx >= 0 then\n Node := Node.GetChild(Ndx)\n else begin\n NotFound := True;\n Break;\n end;\n end;\n end;\n finally\n Lst.Free;\n end;\n if NotFound = false then\n FCurrentNode := Node;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiTree.DeleteNode(const Key : AnsiString) : Boolean;\n {- If node found, deletes the node & returns true, else returns false}\nbegin\n Result := False;\n if CurrentNode <> nil then\n if CurrentNode.Contains(Key) then begin\n Result := CurrentNode.DeleteChildByName(Key);\n Dec(FCount);\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiTree.GetNode(const Key : AnsiString) : TMultiNode;\n {- Returns the node if found, else returns nil}\nbegin\n Result := nil;\n if CurrentNode <> nil then\n if CurrentNode.Contains(Key) then\n Result := CurrentNode.GetChildByName(Key);\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiTree.Insert(ParentNode : TMultiNode;\n const Key : AnsiString) : TMultiNode;\n {- Adds child node to specified ParentNode}\nvar\n NewNode : TMultiNode;\nbegin\n Result := nil;\n if CurrentNode = nil then begin\n {adding root node}\n NewNode := TMultiNode.Create(Key);\n FRoot := NewNode;\n FCurrentNode := NewNode;\n Result := NewNode;\n end else begin\n if not CurrentNode.Contains(Key) then begin\n Result := CurrentNode.AddChild(Key);\n Result.Parent := CurrentNode;\n end;\n end;\n Inc(FCount);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.ParseDirStr(const Key : AnsiString; Lst : TStringList);\n {- parses Key into individual dir commands adding each to Lst}\nvar\n LocKey : AnsiString;\n Counter : integer;\nbegin\n LocKey := Key;\n Lst.Clear;\n if LocKey = '' then\n LocKey := '\\';\n\n {- are we to start from the root folder}\n Counter := 0;\n while LocKey[Counter+1] = '\\' do\n inc(Counter);\n\n if Counter = 1 then\n Lst.Add('\\');\n\n {- begin parsing}\n while Length(LocKey) > 0 do begin\n while LocKey[1] = '\\' do\n begin\n Delete(LocKey, 1, 1);\n if Length(LocKey) = 0 then\n exit;\n end;\n\n if pos(SepChar,LocKey) > 0 then begin\n Lst.Add(string(copy(LocKey, 1, Pos(SepChar, LocKey) - 1)));\n Delete(LocKey, 1, Pos(SepChar, LocKey));\n end else\n if Length(LocKey) > 0 then begin\n Lst.Add(string(LocKey));\n LocKey := '';\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.PopulateSubNodes(ParentNode : TMultiNode;\n TreeView : TTreeView; TreeNode : TTreeNode);\n {- Visits sub-nodes recursively - pre order}\nvar\n Curr : TMultiNode;\n i : Integer;\n Node : TTreeNode;\nbegin\n Node := TreeView.Items.AddChild(TreeNode, string(ParentNode.Key));\n Curr := ParentNode;\n if Curr <> nil then begin\n if Curr.HasChildren then begin\n for i := 0 to Curr.ChildCount -1 do\n PopulateSubNodes(Curr.Children[i], TreeView, Node);\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TMultiTree.PopulateTreeView(TreeView : TTreeView) : Integer;\n{- Populates a user-supplied TTreeView with multiway tree nodes}\nvar\n i : Integer;\n TreeNode : TTreeNode;\nbegin\n TreeView.Items.Clear;\n if Root <> nil then begin\n TreeNode := TreeView.Items.Add(nil, string(Root.Key));\n if Root.HasChildren then begin\n for i := 0 to Root.ChildCount - 1 do\n PopulateSubNodes(Root.Children[i], TreeView, TreeNode);\n end;\n end;\n Result := TreeView.Items.Count\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.TraversePost(ID : Integer);\n {- Traverses tree post-order - CurrentNode after traversal will be the node\n whose EntryID = ID}\nvar\n i : Integer;\nbegin\n if Root <> nil then begin\n if Root.HasChildren then begin\n for i := 0 to Root.ChildCount - 1 do\n VisitSubNodesPost(Root.Children[i], ID);\n end;\n if (TAbDirectoryEntry(Root.FData).FEntryID = ID) then\n FCurrentNode := Root;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.TraversePre(Strm : TStream);\n {- Traverses tree pre-order}\nvar\n i : Integer;\nbegin\n if Root <> nil then begin\n FIDCount := 1;\n TAbDirectoryEntry(Root.Data).FEntryID := FIDCount;\n\n VisitNode(Root, Strm);\n if Root.HasChildren then begin\n for i := 0 to Root.ChildCount - 1 do\n VisitSubNodesPre(Root.Children[i], Strm);\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.VisitNode(Node : TMultiNode; Strm : TStream);\n {- Called recursively from VisitSubNodesPre. Assigns unique entry ID's for\n each directory entry to maintain hierarchy}\nbegin\n if Node.Parent = nil then\n TAbDirectoryEntry(Node.Data).ParentFolder := -1\n else\n TAbDirectoryEntry(Node.Data).ParentFolder :=\n TAbDirectoryEntry(TMultiNode(Node.Parent).Data).FEntryID;\n\n TAbDirectoryEntry(Node.Data).WriteToStream(TMemoryStream(Strm));\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.VisitSubNodesPost(Node : TMultiNode; ID : Integer);\n {- Visits sub-nodes recursively - post order}\nvar\n Curr : TMultiNode;\n i : Integer;\nbegin\n Curr := Node;\n if Curr <> nil then begin\n if Curr.HasChildren then begin\n for i := 0 to Curr.ChildCount -1 do\n VisitSubNodesPost(Curr.Children[i], ID);\n end;\n if (TAbDirectoryEntry(Curr.FData).FEntryID = ID) then\n FCurrentNode := Curr;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TMultiTree.VisitSubNodesPre(Node : TMultiNode; Strm : TStream);\n {- Visits sub-nodes recursively - pre order}\nvar\n Curr : TMultiNode;\n i : Integer;\nbegin\n Curr := Node;\n if Curr <> nil then begin\n Inc(FIDCount);\n TAbDirectoryEntry(Curr.Data).FEntryID := FIDCount;\n\n VisitNode(Curr, Strm);\n if Curr.HasChildren then begin\n for i := 0 to Curr.ChildCount -1 do\n VisitSubNodesPre(Curr.Children[i], Strm);\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TAbSystemBlock}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TAbSystemBlock.Create(const VolLabel : AnsiString; AllocationSz : Integer);\n{- Creates the System block structure of the compound file}\nbegin\n inherited Create;\n FSignature := 'AbCompoundFile';\n FVolumeLabel := VolLabel;\n FAllocationSize := AllocationSz;\n FVersion := AbCompoundFileVersion;\n FUpdating := False;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbSystemBlock.BeginUpdate;\n {- Sets updating to true - temporarily blocking other actions}\nbegin\n FUpdating := True;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbSystemBlock.EndUpdate;\n {- Clears updating flag & allows for other actions}\nbegin\n FUpdating := False;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbSystemBlock.WriteToStream(Strm : TMemoryStream);\n {- writes the contents to the stream parameter}\nvar\n Sig : Array[0..sbSignatureSize - 1] of AnsiChar;\n VolLabel : Array[0..sbVolumeLabelSize - 1] of AnsiChar;\n AllocSize : Integer;\n Version : Array[0..sbVersionSize - 1] of AnsiChar;\n Updt : Byte;\nbegin\n FillChar(Sig, sbSignatureSize, #0);\n AbStrPCopy(Sig, FSignature);\n\n FillChar(VolLabel[0], sbVolumeLabelSize, #0);\n AbStrPCopy(VolLabel, FVolumeLabel);\n\n AllocSize := FAllocationSize;\n\n FillChar(Version[0], sbVersionSize, #0);\n AbStrPCopy(Version, FVersion);\n\n if FUpdating then\n Updt := $01\n else\n Updt := $00;\n\n Strm.Write(Sig[0], sbSignatureSize);\n Strm.Write(VolLabel[0], sbVolumeLabelSize);\n Strm.Write(AllocSize, SizeOf(Integer));\n Strm.Write(Version[0], sbVersionSize);\n Strm.Write(Updt, sbUpdateSize);\nend;\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TAbDirectoryEntry}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TAbDirectoryEntry.Create(AsFile : Boolean);\n {- Creates & initializes a new TAbDirectoryEntry}\nbegin\n inherited Create;\n FName := '';\n FParentFolder := rdUnused;\n if AsFile then begin\n FEntryType := etFile;\n {$WARN SYMBOL_PLATFORM OFF}\n FAttributes := faArchive;\n {$WARN SYMBOL_PLATFORM ON}\n end else begin\n FEntryType := etFolder;\n FAttributes := faDirectory;\n end;\n FStartBlock := rdUnused;\n FLastModified := 0;\n FSize := rdUnused;\n FCompressedSize := rdUnused;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.GetIsFree : Boolean;\n {- returns true if the entry has been marked for deletion}\nbegin\n Result := (FName = '');\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.IsArchive : Boolean;\n {- returns true if the entry is an archive}\nbegin\n{$WARN SYMBOL_PLATFORM OFF}\n Result := ((FAttributes and faArchive) > 0);\n{$WARN SYMBOL_PLATFORM ON}\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.IsDirectory : Boolean;\n {- returns true if the entry is a directory}\nbegin\n Result := ((FAttributes and faDirectory) > 0);\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.IsHidden : Boolean;\n {- returns true if the entry is hidden}\nbegin\n{$WARN SYMBOL_PLATFORM OFF}\n Result := ((FAttributes and faHidden) > 0);\n{$WARN SYMBOL_PLATFORM ON}\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.IsReadOnly : Boolean;\n {- returns true if the entry is read-only}\nbegin\n{$WARN SYMBOL_PLATFORM OFF}\n Result := ((FAttributes and faReadOnly) > 0);\n{$WARN SYMBOL_PLATFORM ON}\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.IsSysFile : Boolean;\n {- returns true if the entry is a system file}\nbegin\n{$WARN SYMBOL_PLATFORM OFF}\n Result := ((FAttributes and faSysFile) > 0);\n{$WARN SYMBOL_PLATFORM ON}\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbDirectoryEntry.IsVolumeID : Boolean;\n {- returns true if the entry is a volume ID}\nbegin\n{$WARN SYMBOL_DEPRECATED OFF}\n{$WARN SYMBOL_PLATFORM OFF}\n Result := ((FAttributes and faVolumeID) > 0);\n{$WARN SYMBOL_PLATFORM ON}\n{$WARN SYMBOL_DEPRECATED ON}\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbDirectoryEntry.WriteToStream(Strm : TMemoryStream);\n {- writes properties to stream}\nvar\n EntryName : Array[0..rdEntryNameSize] of AnsiChar;\n FType : Integer;\nbegin\n FillChar(EntryName, rdEntryNameSize - 1, #0);\n AbStrPCopy(EntryName, FName);\n\n Strm.Write(EntryName[0], rdEntryNameSize);\n\n Strm.Write(FEntryID, rdEntryIDSize);\n Strm.Write(FParentFolder, rdParentFolderSize);\n\n if EntryType = etFolder then\n FType := $00000000\n else\n FType := $00000001;\n Strm.Write(FType, rdEntryTypeSize);\n Strm.Write(FAttributes, rdAttributesSize);\n Strm.Write(FStartBlock, rdStartBlockSize);\n Strm.Write(FLastModified, rdLastModifiedSize);\n Strm.Write(FSize, rdSizeSize);\n Strm.Write(FCompressedSize, rdCompressedSizeSize);\nend;\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TAbRootDir}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TAbRootDir.Create(VolLabel : AnsiString; AllocSize : Integer);\n {- Creates a single-entry (vol-label) root directory structure}\nbegin\n inherited Create;\n fAllocSize := AllocSize;\n if VolLabel <> '' then\n AddFolder(VolLabel);\nend;\n{-----------------------------------------------------------------------------}\ndestructor TAbRootDir.Destroy;\n {- Destroys the root dir.}\nbegin\n inherited Destroy;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbRootDir.AddFile(FileName : AnsiString) : TAbDirectoryEntry;\n {- Adds a file to the current directory of the compound file}\nvar\n NewNode : TMultiNode;\n NewData : TAbDirectoryEntry;\nbegin\n NewData := nil;\n NewNode := Insert(CurrentNode, FileName);\n if NewNode <> nil then begin\n NewData := TAbDirectoryEntry.Create(True);\n NewData.FName := FileName;\n NewData.ParentFolder := 1;\n{$WARN SYMBOL_PLATFORM OFF}\n NewData.Attributes := faArchive;\n{$WARN SYMBOL_PLATFORM ON}\n NewData.StartBlock := 3;\n NewData.LastModified := Now;\n NewData.Size := 4;\n NewData.CompressedSize := 5;\n NewData.EntryType := etFile;\n NewNode.Data := NewData;\n end;\n Result := NewData;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbRootDir.AddFolder(FolderName : AnsiString) : TAbDirectoryEntry;\n {- Adds a folder to the current directory of the compound file}\nvar\n NewNode : TMultiNode;\n NewData : TAbDirectoryEntry;\nbegin\n Result := nil;\n NewNode := Insert(CurrentNode, FolderName);\n if NewNode <> nil then begin\n NewData := TAbDirectoryEntry.Create(False);\n NewData.FName := FolderName;\n NewData.ParentFolder := 1;\n NewData.Attributes := faDirectory;\n NewData.StartBlock := rdUnUsed;\n NewData.LastModified := Now;\n NewData.Size := 0;\n NewData.CompressedSize := 0;\n NewData.EntryType := etFolder;\n NewNode.Data := NewData;\n Result :=NewData;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbRootDir.DeleteFile(FileName : AnsiString);\n {- Deletes the specified file if found}\nbegin\n DeleteNode(FileName);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbRootDir.DeleteFolder(FolderName : AnsiString);\n {- Deletes the specifed folder if found & empty}\nbegin\n if not CurrentNode.Contains(FolderName) then\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n if CurrentNode.ChildCount > 0 then\n raise ECompoundFileError.Create(AbCmpndFolderNotEmpty);\n DeleteFolder(FolderName);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbRootDir.WriteToStream(Strm : TMemoryStream);\n {- Streams and writes the root directory entries to the stream parameter}\nbegin\n TraversePre(Strm);\nend;\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TAbFATTable}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TAbFATTable.Create(AllocSize : Integer);\n {- Creates the FAT table structure}\nvar\n i : Integer;\nbegin\n {Sets FAT length equal to one allocation block}\n fAllocSize := AllocSize;\n SetLength(fFATArray, AllocSize div SizeOf(Integer));\n for i := 0 to High(fFATArray) do\n fFATArray[i] := ftUnusedBlock;\n for i := 0 to 2 do\n fFATArray[i] := ftEndOfBlock;\nend;\n{-----------------------------------------------------------------------------}\ndestructor TAbFATTable.Destroy;\n {- Destroys the FAT table}\nbegin\n Finalize(fFATArray);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.ClearExistingChain(StartNdx : Integer);\n {- Sets all of the FAT entries pertaining to the sequence starting at StartNds\n to ftUnUsedBlock}\nvar\n ChainArray : TFATChainArray;\n i : Integer;\nbegin\n SetLength(ChainArray, 0);\n GetExistingChain(StartNdx, ChainArray);\n for i := 0 to High(ChainArray) do\n fFATArray[ChainArray[i]] := ftUnUsedBlock;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.ClearFATChain;\n {- Sets the FAT entries pertaining to the FAT table to unused}\nbegin\n ClearExistingChain(2);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.ClearRootDirChain;\n {- Sets the FAT entries pertaining the the RootDir to unused}\nbegin\n ClearExistingChain(1);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.GetExistingChain(StartNdx : Integer;\n var ChainArray : TFATChainArray);\n {- Walks the FAT table starting at the index specified, and populates the\n chain array parameter with the results}\nvar\n BlkCount, i, ChainNdx : Integer;\nbegin\n if fFATArray[StartNdx] = ftUnUsedBlock then begin\n SetLength(ChainArray, 0);\n exit;\n end;\n\n {determine count}\n if StartNdx < 1 then\n SetLength(ChainArray, 0)\n else begin\n BlkCount := 1;\n i := StartNdx;\n while fFATArray[i] <> ftEndOfBlock do begin\n i := fFATArray[i];\n Inc(BlkCount);\n end;\n\n {set up array}\n SetLength(ChainArray, BlkCount);\n for i := 0 to High(ChainArray) do\n ChainArray[i] := ftUnusedBlock;\n\n {walk FAT & populate array}\n ChainNdx := 0;\n ChainArray[ChainNdx] := StartNdx;\n i := StartNdx;\n while fFATArray[i] <> ftEndOfBlock do begin\n Inc(ChainNdx);\n ChainArray[ChainNdx] := fFATArray[i];\n i := fFATArray[i];\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.GetFATChain(var ChainArray : TFATChainArray);\n {- Returns the sequence of FAT blocks used by the FAT table in the\n ChainArray parameter}\nbegin\n GetExistingChain(2, ChainArray);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.GetNewChain(NumBytes : Integer;\n var ChainArray : TFATChainArray);\n {- Finds sequence of free blocks required of a file of size NumBytes\n The new FAT chain is commited and passed back in the ChainArray parameter}\nvar\n FirstBlock : Integer;\n TotalBlocksRequired : Integer;\n i, j, BlocksFound : Integer;\nbegin\n if ((NumBytes mod fAllocSize) <> 0) then\n TotalBlocksRequired := (NumBytes div fAllocSize) + 1\n else\n TotalBlocksRequired := (NumBytes div fAllocSize);\n\n if TotalBlocksRequired = 0 then\n exit;\n\n FirstBlock := GetNextUnusedBlock;\n\n {set up array}\n SetLength(ChainArray, TotalBlocksRequired);\n for i := 0 to High(ChainArray) do\n ChainArray[i] := ftUnusedBlock;\n\n ChainArray[0] := FirstBlock;\n BlocksFound := 1;\n i := FirstBlock + 1;\n\n while BlocksFound < TotalBlocksRequired do begin\n if ((fFATArray[i] = ftUnusedBlock) and (i > 2)) then begin\n ChainArray[BlocksFound] := i;\n inc(BlocksFound);\n end;\n Inc(i);\n\n if i > High(fFATArray) then begin\n {grow FAT (allocate another block)}\n SetLength(fFATArray, Length(fFATArray) + (fAllocSize div SizeOf(Integer)));\n for j := High(fFATArray) downto (Length(fFATArray) -\n (fAllocSize div SizeOf(Integer))) do\n fFATArray[j] := ftUnUsedBlock;\n end;\n end;\n\n {Update FAT}\n for i := 0 to High(ChainArray) do begin\n if i = High(ChainArray) then\n fFATArray[ChainArray[i]] := -1\n else\n fFATArray[ChainArray[i]] := ChainArray[i+1];\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.GetNewFATChain(NumBytes : Integer;\n var ChainArray : TFATChainArray);\n {- Finds and commits a new chain starting at the 3rd block. The new chain is\n returned in the ChainArray parameter}\nvar\n FirstBlock : Integer;\n TotalBlocksRequired : Integer;\n i, j, BlocksFound : Integer;\nbegin\n if ((NumBytes mod fAllocSize) <> 0) then\n TotalBlocksRequired := (NumBytes div fAllocSize) + 1\n else\n TotalBlocksRequired := (NumBytes div fAllocSize);\n\n if TotalBlocksRequired = 0 then\n exit;\n\n FirstBlock := 2;\n\n {set up array}\n SetLength(ChainArray, TotalBlocksRequired);\n for i := 0 to High(ChainArray) do\n ChainArray[i] := ftUnusedBlock;\n\n ChainArray[0] := FirstBlock;\n BlocksFound := 1;\n i := FirstBlock + 1;\n\n while BlocksFound < TotalBlocksRequired do begin\n if ((fFATArray[i] = ftUnusedBlock) and (i > 2)) then begin\n ChainArray[BlocksFound] := i;\n inc(BlocksFound);\n end;\n Inc(i);\n\n if i > High(fFATArray) then begin\n {grow FAT (allocate another block)}\n SetLength(fFATArray, Length(fFATArray) + (fAllocSize div SizeOf(Integer)));\n for j := High(fFATArray) downto (Length(fFATArray) -\n (fAllocSize div SizeOf(Integer))) do\n fFATArray[j] := ftUnUsedBlock;\n end;\n end;\n\n {Update FAT}\n for i := 0 to High(ChainArray) do begin\n if i = High(ChainArray) then\n fFATArray[ChainArray[i]] := -1\n else\n fFATArray[ChainArray[i]] := ChainArray[i+1];\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.GetNewRootDirChain(NumBytes : Integer;\n var ChainArray : TFATChainArray);\n {- Finds and commits a new chain starting at the 2nd block. The new chain is\n returned in the ChainArray parameter}\nvar\n FirstBlock : Integer;\n TotalBlocksRequired : Integer;\n i, j, BlocksFound : Integer;\nbegin\n if ((NumBytes mod fAllocSize) <> 0) then\n TotalBlocksRequired := (NumBytes div fAllocSize) + 1\n else\n TotalBlocksRequired := (NumBytes div fAllocSize);\n\n if TotalBlocksRequired = 0 then\n exit;\n\n FirstBlock := 1;\n\n {set up array}\n SetLength(ChainArray, TotalBlocksRequired);\n for i := 0 to High(ChainArray) do\n ChainArray[i] := ftUnusedBlock;\n\n ChainArray[0] := FirstBlock;\n BlocksFound := 1;\n i := FirstBlock + 1;\n\n while BlocksFound < TotalBlocksRequired do begin\n if ((fFATArray[i] = ftUnusedBlock) and (i > 2)) then begin\n ChainArray[BlocksFound] := i;\n inc(BlocksFound);\n end;\n Inc(i);\n\n if i > High(fFATArray) then begin\n {grow FAT (allocate another block)}\n SetLength(fFATArray, Length(fFATArray) + (fAllocSize div SizeOf(Integer)));\n for j := High(fFATArray) downto (Length(fFATArray) -\n (fAllocSize div SizeOf(Integer))) do\n fFATArray[j] := ftUnUsedBlock;\n end;\n end;\n\n {Update FAT}\n for i := 0 to High(ChainArray) do begin\n if i = High(ChainArray) then\n fFATArray[ChainArray[i]] := -1\n else\n fFATArray[ChainArray[i]] := ChainArray[i+1];\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbFATTable.GetNextUnusedBlock : Integer;\n {- Returns the index into the FAT table of the next block marked as unused}\nvar\n i, j : Integer;\nbegin\n if Length(fFATArray) = 0 then\n Result := -1\n else begin\n Result := -1;\n i := 3;\n while i <= High(fFATArray) do begin\n if fFATArray[i] = ftUnusedBlock then begin\n Result := i;\n exit;\n end;\n inc(i);\n\n if i > High(fFATArray) then begin\n {grow FAT (allocate another block)}\n SetLength(fFATArray, Length(fFATArray) +\n (fAllocSize div SizeOf(Integer)));\n for j := High(fFATArray) downto (Length(fFATArray) -\n (fAllocSize div SizeOf(Integer))) do\n fFATArray[j] := ftUnUsedBlock;\n end;\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.GetRootDirChain(var ChainArray : TFATChainArray);\n {- Returns the sequence of FAT blocks used by the RootDir in the\n ChainArray parameter}\nbegin\n GetExistingChain(1, ChainArray);\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbFATTable.IsEndOfFile(Ndx : Integer) : Boolean;\n {- Returns true if Ndx into FAT signifies end of file}\nbegin\n if ((Ndx < 0) or (Ndx > High(fFATArray)) or\n (Length(fFATArray) = 0)) then\n raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds)\n else\n Result := (fFATArray[Ndx] = ftEndOfBlock);\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbFATTable.IsUnUsed(Ndx : Integer) : Boolean;\n {- Returns true if Ndx into FAT signifies an unused block}\nbegin\n if ((Ndx < 0) or (Ndx > High(fFATArray)) or\n (Length(fFATArray) = 0)) then\n raise ECompoundFileError.Create(AbCmpndIndexOutOfBounds)\n else\n Result := (fFATArray[Ndx] = ftUnUsedBlock);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbFATTable.WriteToStream(Strm : TMemoryStream);\n {- Streams and writes the FAT entries to the stream parameter}\nbegin\n Strm.Write(fFATArray[0], Length(fFATArray) * SizeOf(Integer));\nend;\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\n {TAbCompoundFile}\n{-----------------------------------------------------------------------------}\n{-----------------------------------------------------------------------------}\nconstructor TAbCompoundFile.Create(const FileName : string; const VolLabel : AnsiString;\n AllocSize : Integer);\n {- Creates a new instance}\nvar\n Buff : Array of Byte;\nbegin\n inherited Create;\n FSystemBlock := TAbSystemBlock.Create(VolLabel, AllocSize);\n FFATTable := TAbFATTable.Create(AllocSize);\n FRootDir := TAbRootDir.Create(VolLabel, AllocSize);\n {create file}\n\n if FileName <> '' then begin\n FDiskFile := FileName;\n FStream := TFileStream.Create(FileName, fmOpenReadWrite or\n fmCreate or fmShareDenyNone);\n\n {fill first 3 blocks of file}\n SetLength(Buff, 3 * AllocSize);\n FStream.Write(Buff, 3 * AllocSize);\n\n {write System, RootDir, and FAT blocks}\n PersistSystemBlock;\n PersistRootDirBlock;\n PersistFATBlock;\n\n if Assigned(FOnAfterOpen) then\n FOnAfterOpen(self);\n end;\nend;\n\nconstructor TAbCompoundFile.Create(const FileName : string; const VolLabel : AnsiString;\n AllocSize : Integer; const Signature: AnsiString);\n {- Creates a new instance}\nvar\n Buff : Array of Byte;\nbegin\n inherited Create;\n FSystemBlock := TAbSystemBlock.Create(VolLabel, AllocSize);\n FSystemBlock.Signature := AbLeftStr(Signature, sbSignatureSize);\n FFATTable := TAbFATTable.Create(AllocSize);\n FRootDir := TAbRootDir.Create(VolLabel, AllocSize);\n {create file}\n\n if FileName <> '' then begin\n FDiskFile := FileName;\n FStream := TFileStream.Create(FileName, fmOpenReadWrite or\n fmCreate or fmShareDenyNone);\n\n {fill first 3 blocks of file}\n SetLength(Buff, 3 * AllocSize);\n FStream.Write(Buff, 3 * AllocSize);\n\n {write System, RootDir, and FAT blocks}\n PersistSystemBlock;\n PersistRootDirBlock;\n PersistFATBlock;\n\n if Assigned(FOnAfterOpen) then\n FOnAfterOpen(self);\n end;\nend;\n\n{-----------------------------------------------------------------------------}\ndestructor TAbCompoundFile.Destroy;\n {- Persists and then destroys the instance of the compound file}\nbegin\n PersistSystemBlock;\n PersistRootDirBlock;\n PersistFATBlock;\n\n if Assigned(FOnBeforeClose) then\n FOnBeforeClose(self);\n\n FSystemBlock.Free;\n FFATTable.Free;\n FRootDir.Free;\n FStream.Free;\n inherited;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.AddFile(FName : AnsiString; FileData : TStream;\n FileSize : Integer);\n function JustFilename(const PathName : AnsiString) : AnsiString;\n {-Return just the filename and extension of a pathname.}\n var\n I : Cardinal;\n begin\n Result := '';\n if PathName = '' then Exit;\n I := Succ(Word(Length(PathName)));\n repeat\n Dec(I);\n until (PathName[I] in ['\\',':']) or (I = 0);\n Result := System.Copy(PathName, Succ(I), rdEntryNameSize);\n end;\n\n {- Compresses, adds & persists the data (FileData)}\nvar\n DirEntry : TAbDirectoryEntry;\n CompStream : TStream;\n CompHelper : TAbDeflateHelper;\n ChainArray : TFATChainArray;\nbegin\n FName := JustFileName(FName);\n if ((FStream.Size + FileData.Size +\n (4 * FSystemBlock.AllocationSize)) >= MaxLongInt) then\n raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize);\n\n if FSystemBlock.Updating then\n raise ECompoundFileError.Create(AbCmpndBusyUpdating);\n FSystemBlock.BeginUpdate;\n CompStream := TMemoryStream.Create;\n CompHelper := TAbDeflateHelper.Create;\n try\n DirEntry := FRootDir.AddFile(FName);\n if DirEntry <> nil then begin\n DirEntry.FSize := FileSize;\n\n {compress & update dir entry's compressed size}\n FileData.Seek(0, soBeginning);\n Deflate(FileData, CompStream, CompHelper);\n DirEntry.FCompressedSize := CompStream.Size;\n\n {Get new FAT chain & persist the data}\n SetLength(ChainArray, 0);\n FFATTable.GetNewChain(CompStream.Size, ChainArray);\n DirEntry.FStartBlock := ChainArray[0];\n PersistFileData(CompStream, ChainArray);\n PersistRootDirBlock;\n PersistFATBlock;\n end;\n finally\n CompStream.Free;\n CompHelper.Free;\n FSystemBlock.EndUpdate;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.AddDirEntriesFromList(Lst : TStringList);\n {- Add individual root directory entries to RootDir structure maintaining seq.}\nvar\n i : Integer;\n LstEntry : TAbDirectoryEntry;\n Entry : TAbDirectoryEntry;\nbegin\n for i := 0 to Lst.Count - 1 do begin\n LstEntry := (Lst.Objects[i] as TAbDirectoryEntry);\n\n {locate parent folder}\n FRootDir.GoToEntryID(LstEntry.FParentFolder);\n\n {Add file or folder}\n if LstEntry.EntryType = etFolder then\n Entry := FRootDir.AddFolder(LstEntry.FName)\n else\n Entry := FRootDir.AddFile(LstEntry.FName);\n\n {assign values}\n Entry.FName := LstEntry.FName;\n Entry.FEntryID := LstEntry.FEntryID;\n Entry.FParentFolder := LstEntry.FParentFolder;\n Entry.FEntryType := LstEntry.FEntryType;\n Entry.FAttributes := LstEntry.FAttributes;\n Entry.FStartBlock := LstEntry.FStartBlock;\n Entry.FLastModified := LstEntry.FLastModified;\n Entry.FSize := LstEntry.FSize;\n Entry.FCompressedSize := LstEntry.FCompressedSize;\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.AddFolder(FName : AnsiString) : Boolean;\n {- Adds a new folder (directory) to the compound file}\nvar\n EntryCount : Integer;\nbegin\n if ((FStream.Size + FSystemBlock.AllocationSize) >= MaxLongInt) then\n raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize);\n\n EntryCount := FRootDir.Count;\n FSystemBlock.BeginUpdate;\n try\n FRootDir.AddFolder(FName);\n PersistRootDirBlock;\n PersistFATBlock;\n finally\n FSystemBlock.EndUpdate;\n end;\n Result := ((FRootDir.Count - EntryCount) = 1);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.BuildFat;\n {- Extracts FAT from this string, writes it to DestStrm(TMemoryStream) and\n ultimately updates/persists the FAT table}\nvar\n Buff : Array of Integer;\n IntBuff : Array[0..0] of Integer;\n DestStrm : TMemoryStream;\n i, CurrPos : Integer;\n NextBlock : Integer;\nbegin\n DestStrm := TMemoryStream.Create;\n try\n {Dim Buff to allocation block size}\n SetLength(Buff, FSystemBlock.AllocationSize div SizeOf(Integer));\n\n {Clear Buff}\n for i := Low(Buff) to High(Buff) do\n Buff[i] := ftUnusedBlock;\n\n {read 1st FAT block into Buff -> Write Buff to DestStrm}\n FStream.Seek(2 * FSystemBlock.AllocationSize, soBeginning);\n FStream.Read(Buff[0], FSystemBlock.AllocationSize);\n DestStrm.Write(Buff[0], FSystemBlock.AllocationSize);\n\n {Determine next block of FAT chain}\n NextBlock := Buff[2];\n\n {read remaining FAT blocks if they exist}\n While NextBlock <> ftEndOfBlock do begin\n FStream.Seek((NextBlock) * FSystemBlock.AllocationSize, soBeginning);\n\n {Clear buff}\n for i := Low(Buff) to High(Buff) do\n Buff[i] := ftUnusedBlock;\n\n FStream.Read(Buff[0], FSystemBlock.AllocationSize);\n DestStrm.Write(Buff[0], FSystemBlock.AllocationSize);\n\n {Determine the next FAT block - we'll return to this position in stream}\n CurrPos := DestStrm.Position;\n DestStrm.Seek((NextBlock - 1) * SizeOf(Integer), soBeginning);\n DestStrm.Read(IntBuff[0], SizeOf(Integer));\n NextBlock := IntBuff[0];\n DestStrm.Seek(CurrPos, soBeginning);\n end;\n\n {Set length of and populate the FFATTable.fFATArray in mem structure}\n DestStrm.Seek(0, soBeginning);\n SetLength(FFATTable.fFATArray, DestStrm.Size div SizeOf(Integer));\n for i := 1 to DestStrm.Size div SizeOf(Integer) do begin\n DestStrm.Read(IntBuff[0], SizeOf(Integer));\n FFATTable.fFATArray[i-1] := IntBuff[0];\n end;\n finally\n DestStrm.Free;\n end;\n PersistFATBlock;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.BuildRootDir;\n {- Builds list of root directory entries & passes list to AddDirEntriesFromList}\nvar\n ChainArray : TFATChainArray;\n DestStrm : TMemoryStream;\n Buff : Array of Byte;\n i : Integer;\n Entry : TAbDirectoryEntry;\n Lst : TStringList;\n\n {RootDirEntry buffers}\n EName : Array[0..rdEntryNameSize - 1] of AnsiChar;\n EID : Array[0..0] of Integer;\n EPF : Array[0..0] of Integer;\n EType : Array[0..0] of Integer;\n EAttrib : Array[0..0] of Integer;\n EStartBlk : Array[0..0] of Integer;\n EMod : Array[0..0] of TDateTime;\n ESz : Array[0..0] of Integer;\n ECompSz : Array[0..0] of Integer;\nbegin\n {Get RootDir FAT chain}\n FFATTable.GetRootDirChain(ChainArray);\n SetLength(Buff, FSystemBlock.AllocationSize);\n DestStrm := TMemoryStream.Create;\n Lst := TStringList.Create;\n Lst.Duplicates := dupAccept;\n Lst.Sorted := False;\n try\n {Read entire RotDir block to DestStrm}\n for i := 0 to High(ChainArray) do begin\n FStream.Seek(FSystemBlock.AllocationSize * ChainArray[i], soBeginning);\n FStream.Read(Buff[0], FSystemBlock.AllocationSize);\n DestStrm.Write(Buff[0], FSystemBlock.AllocationSize);\n end;\n\n {Reset DestStrm}\n DestStrm.Seek(0, soBeginning);\n\n {For all directory entries, read entry, create object, & add to Lst}\n for i := 0 to (DestStrm.Size div rdSizeOfDirEntry) - 1 do begin\n {read a single directory entry}\n DestStrm.Read(EName[0], rdEntryNameSize);\n if EName = '' then\n continue;\n DestStrm.Read(EID[0], SizeOf(Integer));\n DestStrm.Read(EPF[0], SizeOf(Integer));\n DestStrm.Read(EType[0], SizeOf(Integer));\n DestStrm.Read(EAttrib[0], SizeOf(Integer));\n DestStrm.Read(EStartBlk[0], SizeOf(Integer));\n DestStrm.Read(EMod[0], SizeOf(TDateTime));\n DestStrm.Read(ESz[0], SizeOf(Integer));\n DestStrm.Read(ECompSz[0], SizeOf(Integer));\n\n if EType[0] = 0 then\n Entry := TAbDirectoryEntry.Create(False)\n else\n Entry := TAbDirectoryEntry.Create(True);\n\n Entry.FName := EName;\n Entry.FEntryID := EID[0];\n Entry.FParentFolder := EPF[0];\n if EType[0] = 0 then\n Entry.FEntryType := etFolder\n else\n Entry.FEntryType := etFile;\n Entry.FAttributes := EAttrib[0];\n Entry.FStartBlock := EStartBlk[0];\n Entry.FLastModified := EMod[0];\n Entry.FSize := ESz[0];\n Entry.FCompressedSize := ECompSz[0];\n\n {Don't add an empty dir entry}\n if Entry.FName <> '' then\n Lst.AddObject(IntToStr(i), TObject(Entry));\n end;\n\n {Add individual root directory entries to RootDir structure maintaining seq.}\n AddDirEntriesFromList(Lst);\n finally\n DestStrm.Free;\n for i := 0 to Lst.Count - 1 do\n if Lst.Objects[i] <> nil then\n TAbDirectoryEntry(Lst.Objects[i]).Free;\n Lst.Free;\n end;\n\n {Save updates}\n PersistRootDirBlock;\n PersistFATBlock;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.BuildSysBlock;\n {- Constructs System block from the contents of FStream\n (used when opening an existing compound file)}\nvar\n Sig : Array[0..sbSignatureSize - 1] of AnsiChar;\n VolLabel : Array[0..sbVolumeLabelSize - 1] of AnsiChar;\n Version : Array[0..sbVersionSize - 1] of AnsiChar;\n AllocationSz : Array[0..0] of Integer;\nbegin\n FStream.Seek(0, soBeginning);\n FStream.Read(Sig[0], sbSignatureSize);\n FStream.Read(VolLabel[0], sbVolumeLabelSize);\n FStream.Read(AllocationSz[0], sbAllocationSizeSize);\n FStream.Read(Version[0], sbVersionSize);\n\n FSystemBlock.Signature := Sig;\n FSystemBlock.VolumeLabel := VolLabel;\n FSystemBlock.AllocationSize := AllocationSz[0];\n FSystemBlock.FVersion := Version;\n PersistSystemBlock;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.Defrag;\n {- Optimizes disk storage}\nbegin\n{ not implemeneted }\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.DeleteFile(FName : AnsiString);\n {- Deletes the file from the RootDirectory and FAT blocks (data remains)}\nvar\n StartBlock : Integer;\n Allow : Boolean;\n AllowDirMod : Boolean;\nbegin\n Allow := True;\n AllowDirMod := True;\n\n if not FRootDir.CurrentNode.Contains(FName) then\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n\n if Assigned(FOnBeforeFileDelete) then\n FOnBeforeFileDelete(self, FName, Allow);\n\n if Assigned(FOnBeforeDirModified) then\n FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,\n AllowDirMod);\n\n if (Allow and AllowDirMod) then begin\n StartBlock := TAbDirectoryEntry(FRootDir.GetNode(FName).FData).StartBlock;\n FFATTable.ClearExistingChain(StartBlock);\n\n FRootDir.DeleteFile(FName);\n PersistRootDirBlock;\n PersistFATBlock;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.DeleteFolder(FName : AnsiString);\n {- Deletes the folder from the RootDirectory block}\nvar\n Allow : Boolean;\n AllowDirMod : Boolean;\nbegin\n Allow := True;\n AllowDirMod := True;\n\n if not FRootDir.CurrentNode.Contains(FName) then\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n\n if Assigned(FOnBeforeDirDelete) then\n FOnBeforeDirDelete(self, FName, Allow);\n\n if Assigned(FOnBeforeDirModified) then\n FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,\n AllowDirMod);\n\n if (Allow and AllowDirMod) then begin\n FRootDir.DeleteFolder(FName);\n PersistRootDirBlock;\n PersistFATBlock;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.EnumerateFiles(Lst : TStringList);\nvar\n i : Integer;\nbegin\n Lst.Clear;\n for i := 0 to FRootDir.CurrentNode.ChildCount - 1 do begin\n if (FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryType = etFile then\n Lst.Add(string((FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryName));\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.EnumerateFolders(Lst : TStringList);\nvar\n i : Integer;\nbegin\n Lst.Clear;\n for i := 0 to FRootDir.CurrentNode.ChildCount - 1 do begin\n if (FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryType = etFolder then\n Lst.Add(string((FRootDir.CurrentNode.Children[i].Data as TAbDirectoryEntry).EntryName));\n end;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.GetAllocationSize : Integer;\n {- Returns the block allocation size used by the compound file}\nbegin\n result := FSystemBlock.AllocationSize;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.GetCurrentDirectory : AnsiString;\n {- Returns the current directory}\nbegin\n Result := FRootDir.CurrentNode.Key;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.GetDirectoryEntries : Integer;\n {- Returns the total number of directory entries (files and folders)}\nbegin\n Result := FRootDir.Count;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.GetSizeOnDisk : Integer;\n {- Returns the compound file size (FStream.Size)}\nbegin\n Result := FStream.Size;\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.GetVolumeLabel : AnsiString;\n {- Returns the volume label of the compound file}\nbegin\n Result := FSystemBlock.VolumeLabel;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbRootDir.GoToEntryID(ID : Integer);\n {- Traverses tree and sets the current node to the node whose EntryID = ID}\nbegin\n TraversePost(ID);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.Open(const FName : string);\n{- Opens an existing compound file and builds Sys, Root Dir, and FAT blocks}\nvar\n Sig : Array[0..sbSignatureSize - 1] of AnsiChar;\nbegin\n if FStream <> nil then\n FStream.Free;\n FStream := TFileStream.Create(FName, fmOpenReadWrite or fmShareDenyNone);\n\n {Ensure valid signature}\n FStream.Read(Sig[0], sbSignatureSize);\n if Sig <> AbLeftStr(FSystemBlock.Signature, sbSignatureSize) then begin\n raise ECompoundFileError.Create(AbCmpndInvalidFile);\n exit;\n end;\n\n FDiskFile := FName;\n {populate Compound File structure}\n BuildSysBlock;\n BuildFat;\n BuildRootDir;\n\n if Assigned(FOnAfterOpen) then\n FOnAfterOpen(self);\nend;\n\nprocedure TAbCompoundFile.Open(const FName : string; const Signature: AnsiString);\n{- Opens an existing compound file and builds Sys, Root Dir, and FAT blocks}\nvar\n Sig : Array[0..sbSignatureSize - 1] of AnsiChar;\nbegin\n if FStream <> nil then\n FStream.Free;\n FStream := TFileStream.Create(FName, fmOpenReadWrite or fmShareDenyNone);\n\n {Ensure valid signature}\n FStream.Read(Sig[0], sbSignatureSize);\n if Sig <> AbLeftStr(Signature, sbSignatureSize) then begin\n raise ECompoundFileError.Create(AbCmpndInvalidFile);\n exit;\n end;\n\n FDiskFile := FName;\n {populate Compound File structure}\n BuildSysBlock;\n BuildFat;\n BuildRootDir;\n\n if Assigned(FOnAfterOpen) then\n FOnAfterOpen(self);\nend;\n{-----------------------------------------------------------------------------}\nfunction TAbCompoundFile.OpenFile(FileName : AnsiString; var Strm : TStream)\n : Integer;\n {- Opens the file and writes the file contents to Strm}\nvar\n ChainArray : TFatChainArray;\n i, j : Integer;\n Buff : Array of Byte;\n RemainingBytes : Integer;\n CompStream : TStream;\n CompHelper : TAbDeflateHelper;\nbegin\n if not FRootDir.CurrentNode.Contains(FileName) then\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n\n CompStream := TMemoryStream.Create;\n CompHelper := TAbDeflateHelper.Create;\n\n try\n {Read the existing (compressed) file into CompStream}\n FFATTable.GetExistingChain((FRootDir.GetNode(FileName).FData\n as TAbDirectoryEntry).StartBlock, ChainArray);\n SetLength(Buff, FSystemBlock.AllocationSize);\n for i := 0 to high(ChainArray) do begin\n for j := 0 to Pred(FSystemBlock.AllocationSize) do\n Buff[j] := Byte(chr(0));\n FStream.Seek((ChainArray[i]) * FSystemBlock.AllocationSize, soBeginning);\n if i <> High(ChainArray) then begin\n FStream.Read(buff[0], FSystemBlock.AllocationSize);\n CompStream.Write(Buff[0], FSystemBlock.AllocationSize);\n end else begin\n {read less than entire block}\n RemainingBytes := (FRootDir.GetNode(FileName).FData as TAbDirectoryEntry).\n CompressedSize mod FSystemBlock.AllocationSize;\n FStream.Read(Buff[0], RemainingBytes);\n CompStream.Write(Buff[0], RemainingBytes);\n end;\n end;\n\n {CompStream now contains the entire compressed file stream}\n CompStream.Seek(0, soBeginning);\n Inflate(CompStream, Strm, CompHelper);\n finally\n CompStream.Free;\n CompHelper.Free;\n end;\n Result := Strm.Size;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.PersistFATBlock;\n {- Saves the FAT table to disk}\nvar\n FATStrm : TMemoryStream;\n Buff : Array of Byte;\n i : Integer;\n ChainArray : TFATChainArray;\nbegin\n {Init Buffer}\n SetLength(Buff, FSystemBlock.AllocationSize);\n\n {Init & fill RootDir stream}\n FATStrm := TMemoryStream.Create;\n\n try\n FFATTable.WriteToStream(FATStrm);\n\n {prep FAT Table}\n fFATTable.ClearFATChain;\n fFATTable.GetNewFATChain(FATStrm.Size, ChainArray);\n\n FATStrm.Seek(0, soBeginning);\n for i := 0 to High(ChainArray) do begin\n\n {Clear block contents}\n FillChar(Buff[0], FSystemBlock.AllocationSize, #0);\n FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning);\n FStream.Write(Buff[0], FSystemBlock.AllocationSize);\n\n {write new contents}\n FATStrm.Read(Buff[0], FSystemBlock.AllocationSize);\n FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning);\n FStream.Write(Buff[0], FSystemBlock.AllocationSize);\n end;\n finally\n FATStrm.Free;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.PersistFileData(FileData : TStream;\n var ChainArray : TFATChainArray);\n {- Walks FAT chain and persists data (FileData) to the corresponding blocks}\nvar\n Buff : Array of Byte;\n i : Integer;\n j : Integer;\nbegin\n if FileData <> nil then begin\n FileData.Seek(0, soBeginning);\n SetLength(Buff, FSystemBlock.AllocationSize);\n for i := 0 to High(ChainArray) do begin\n for j := 0 to FSystemBlock.AllocationSize - 1 do\n Buff[j] := Byte(chr(0));\n FileData.Read(Buff[0], FSystemBlock.AllocationSize);\n FStream.Seek(FSystemBlock.AllocationSize * ChainArray[i], soBeginning);\n\n FStream.Write(Buff[0],FSystemBlock.AllocationSize);\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.PersistRootDirBlock;\n {- Saves the RootDirectory block to disk}\nvar\n RdStrm : TMemoryStream;\n Buff : Array of Byte;\n i : Integer;\n ChainArray : TFATChainArray;\nbegin\n {Init Buffer}\n SetLength(Buff, FSystemBlock.AllocationSize);\n\n {Init & fill RootDir stream}\n RdStrm := TMemoryStream.Create;\n try\n FRootDir.WriteToStream(RdStrm);\n\n {prep FAT Table}\n fFATTable.ClearRootDirChain;\n fFATTable.GetNewRootDirChain(RdStrm.Size, ChainArray);\n\n RdStrm.Seek(0, soBeginning);\n for i := 0 to High(ChainArray) do begin\n {Clear block contents}\n FillChar(Buff[0], FSystemBlock.AllocationSize, #0);\n FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning);\n FStream.Write(Buff[0], FSystemBlock.AllocationSize);\n\n {write new contents}\n RdStrm.Read(Buff[0], FSystemBlock.AllocationSize);\n FStream.Seek(FSystemBlock.FAllocationSize * ChainArray[i], soBeginning);\n FStream.Write(Buff[0], FSystemBlock.AllocationSize);\n end;\n finally\n RdStrm.Free;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.PersistSystemBlock;\n {- Saves the System block to disk}\nvar\n Strm : TMemoryStream;\n Buff : Array of Byte;\nbegin\n SetLength(Buff, FSystemBlock.AllocationSize);\n Strm := TMemoryStream.Create;\n try\n FSystemBlock.WriteToStream(Strm);\n Strm.Seek(0, soBeginning);\n Strm.Read(Buff[0], Strm.Size);\n FStream.Seek(0, soBeginning);\n FStream.Write(Buff[0], FSystemBlock.AllocationSize);\n finally\n Strm.Free;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.SetCurrentDirectory(val : AnsiString);\n {- Changes the current directory to the val parameter}\nbegin\n FRootDir.ChangeDir(Val);\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.SetVolumeLabel(Val : AnsiString);\n {- Sets the volume label of the compound file}\nbegin\n FSystemBlock.VolumeLabel := Val;\n PersistSystemBlock;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.UpdateFile(FName : AnsiString; FData : TStream);\nvar\n StartBlk : Integer;\n ChainArray : TFATChainArray;\n DirEntry : TAbDirectoryEntry;\n CompStream : TStream;\n CompHelper : TAbDeflateHelper;\n Allow : Boolean;\n AllowDirMod : Boolean;\nbegin\n Allow := True;\n AllowDirMod := True;\n if not FRootDir.CurrentNode.Contains(FName) then\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n\n if ((FStream.Size + FData.Size +\n (4 * FSystemBlock.AllocationSize)) >= MaxLongInt) then\n raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize);\n\n if Assigned(FOnBeforeFileModified) then\n FOnBeforeFileModified(self, FName, Allow);\n\n if Assigned(FOnBeforeDirModified) then\n FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,\n AllowDirMod);\n\n if (Allow and AllowDirMod) then begin\n {get dir entry & start block}\n DirEntry := TAbDirectoryEntry(FRootDir.CurrentNode.GetChildByName(FName).Data);\n StartBlk := DirEntry.StartBlock;\n CompStream := TMemoryStream.Create;\n CompHelper := TAbDeflateHelper.Create;\n\n try\n {clear existing FAT chain}\n FFATTable.ClearExistingChain(StartBlk);\n SetLength(ChainArray, 0);\n\n {Deflate data}\n FData.Seek(0, soBeginning);\n Deflate(FData, CompStream, CompHelper);\n\n {Commit new FAT chain}\n FFATTable.GetNewChain(CompStream.Size, ChainArray);\n\n {update start block, size, compressed size}\n DirEntry.FStartBlock := ChainArray[0];\n DirEntry.Size := FData.Size;\n DirEntry.CompressedSize := CompStream.Size;\n\n {persist changes}\n PersistFileData(CompStream, ChainArray);\n PersistRootDirBlock;\n PersistFATBlock;\n finally\n CompStream.Free;\n CompHelper.Free;\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\n\n\n\nfunction TAbCompoundFile.PopulateTreeView(TreeView : TTreeView) : Integer;\n {- Populates the tree view parameter with all root directory entries}\nvar\n i : Integer;\n TreeNode : TTreeNode;\nbegin\n TreeView.Items.Clear;\n if FRootDir.Root <> nil then begin\n TreeNode := TreeView.Items.Add(nil, string(FRootDir.Root.Key));\n TreeNode.ImageIndex := 0;\n TreeNode.SelectedIndex := 0;\n if FRootDir.Root.HasChildren then begin\n for i := 0 to FRootDir.Root.ChildCount - 1 do\n PopulateSubNodes(FRootDir.Root.Children[i], TreeView, TreeNode);\n end;\n end;\n Result := TreeView.Items.Count;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.PopulateSubNodes(ParentNode : TMultiNode;\n TreeView : TTreeView; TreeNode : TTreeNode);\n {- Visits sub-nodes recursively - pre order}\nvar\n Curr : TMultiNode;\n i : Integer;\n Node : TTreeNode;\nbegin\n Node := TreeView.Items.AddChild(TreeNode, string(ParentNode.Key));\n if TAbDirectoryEntry(ParentNode.Data).EntryType = etFolder then begin\n Node.ImageIndex := 0;\n Node.SelectedIndex := 0;\n end else begin\n Node.ImageIndex := 1;\n Node.SelectedIndex := 1;\n end;\n Curr := ParentNode;\n if Curr <> nil then begin\n if Curr.HasChildren then begin\n for i := 0 to Curr.ChildCount -1 do\n PopulateSubNodes(Curr.Children[i], TreeView, Node);\n end;\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.RenameFile(OrigName, NewName : AnsiString);\n {- Renames the file if file is found}\nvar\n MultNode : TMultiNode;\n Allow : Boolean;\n AllowDirMod : Boolean;\nbegin\n Allow := True;\n AllowDirMod := True;\n\n {confirm valid names}\n if ((OrigName = '') or (NewName = '')) then exit;\n\n {prevent duplicate names}\n if ((FRootDir.FCurrentNode.Contains(NewName)) or\n (FRootDir.FCurrentNode.Key = NewName)) then exit;\n\n if Assigned(FOnBeforeFileModified) then\n FOnBeforeFileModified(self, OrigName, Allow);\n\n if Assigned(FOnBeforeDirModified) then\n FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,\n AllowDirMod);\n\n if (Allow and AllowDirMod) then begin\n if FRootDir.FCurrentNode.Contains(OrigName) then begin\n MultNode := FRootDir.FCurrentNode.GetChildByName(OrigName);\n MultNode.Key := NewName;\n TAbDirectoryEntry(MultNode.Data).FName := NewName;\n PersistRootDirBlock;\n end else if FRootDir.FCurrentNode.Key = OrigName then begin\n MultNode := FRootDir.FCurrentNode;\n MultNode.Key := NewName;\n TAbDirectoryEntry(MultNode.Data).FName := NewName;\n PersistRootDirBlock;\n end else\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n end;\nend;\n{-----------------------------------------------------------------------------}\nprocedure TAbCompoundFile.RenameFolder(OrigName, NewName : AnsiString);\n {- Renames the folder if the folder is found}\nvar\n MultNode : TMultiNode;\n Allow : Boolean;\n AllowDirMod : Boolean;\nbegin\n Allow := True;\n AllowDirMod := True;\n\n {confirm valid names}\n if ((OrigName = '') or (NewName = '')) then exit;\n\n {prevent duplicate names}\n if ((FRootDir.FCurrentNode.Contains(NewName)) or\n (FRootDir.FCurrentNode.Key = NewName)) then exit;\n\n\n if Assigned(FOnBeforeFileModified) then\n FOnBeforeFileModified(self, OrigName, Allow);\n\n if Assigned(FOnBeforeDirModified) then\n FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,\n AllowDirMod);\n\n if (Allow and AllowDirMod) then begin\n if FRootDir.FCurrentNode.Contains(OrigName) then begin\n MultNode := FRootDir.FCurrentNode.GetChildByName(OrigName);\n if (TAbDirectoryEntry(MultNode.Data).EntryType <> etFolder) then\n exit;\n MultNode.Key := NewName;\n TAbDirectoryEntry(MultNode.Data).FName := NewName;\n PersistRootDirBlock;\n end else if FRootDir.FCurrentNode.Key = OrigName then begin\n MultNode := FRootDir.FCurrentNode;\n if (TAbDirectoryEntry(MultNode.Data).EntryType <> etFolder) then\n exit;\n MultNode.Key := NewName;\n TAbDirectoryEntry(MultNode.Data).FName := NewName;\n PersistRootDirBlock;\n end else\n raise ECompoundFileError.Create(AbCmpndFileNotFound);\n end;\nend;\n{-----------------------------------------------------------------------------}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbConst.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbConst.pas *}\n{*********************************************************}\n{* Abbrevia: Constants *}\n{*********************************************************}\n\nunit AbConst;\n\n{$I AbDefine.inc}\n\ninterface\n\nconst\n AbVersion = 5.0;\n AbVersionS = '5.0';\n Ab_MessageLen = 255;\n Ab_CaptionLen = 80;\n AB_ZIPPATHDELIM = '/';\n\nconst\n AbZipVersionNeeded = 1;\n AbUnknownCompressionMethod = 2;\n AbNoExtractionMethod = 3;\n AbInvalidPassword = 4;\n AbNoInsertionMethod = 5;\n AbInvalidFactor = 6;\n AbDuplicateName = 7;\n AbUnsupportedCompressionMethod = 8;\n AbUserAbort = 9;\n AbArchiveBusy = 10;\n AbBadSpanStream = 11;\n AbNoOverwriteSpanStream = 12;\n AbNoSpannedSelfExtract = 13;\n AbStreamFull = 14;\n AbNoSuchDirectory = 15;\n AbInflateBlockError = 16;\n AbBadStreamType = 17;\n AbTruncateError = 18;\n AbZipBadCRC = 19;\n AbZipBadStub = 20;\n AbFileNotFound = 21;\n AbInvalidLFH = 22;\n AbNoArchive = 23;\n AbErrZipInvalid = 24;\n AbReadError = 25;\n AbInvalidIndex = 26;\n AbInvalidThreshold = 27;\n AbUnhandledFileType = 28;\n AbSpanningNotSupported = 29;\n\n AbBBSReadTooManyBytes = 40;\n AbBBSSeekOutsideBuffer = 41;\n AbBBSInvalidOrigin = 42;\n AbBBSWriteTooManyBytes = 43;\n\n AbNoCabinetDllError = 50;\n AbFCIFileOpenError = 51;\n AbFCIFileReadError = 52;\n AbFCIFileWriteError = 53;\n AbFCIFileCloseError = 54;\n AbFCIFileSeekError = 55;\n AbFCIFileDeleteError = 56;\n AbFCIAddFileError = 57;\n AbFCICreateError = 58;\n AbFCIFlushCabinetError = 59;\n AbFCIFlushFolderError = 60;\n AbFDICopyError = 61;\n AbFDICreateError = 62;\n AbInvalidCabTemplate = 63;\n AbInvalidCabFile = 64;\n\n AbSWSNotEndofStream = 80;\n AbSWSSeekFailed = 81;\n AbSWSWriteFailed = 82;\n AbSWSInvalidOrigin = 83;\n AbSWSInvalidNewOrigin = 84;\n\n AbVMSReadTooManyBytes = 100;\n AbVMSInvalidOrigin = 101;\n AbVMSErrorOpenSwap = 102;\n AbVMSSeekFail = 103;\n AbVMSReadFail = 104;\n AbVMSWriteFail = 105;\n AbVMSWriteTooManyBytes = 106;\n\n AbGZipInvalid = 200;\n AbGzipBadCRC = 201;\n AbGzipBadFileSize = 202;\n\n AbTarInvalid = 220;\n AbTarBadFileName = 221;\n AbTarBadLinkName = 222;\n AbTarBadOp = 223;\n\n\nfunction AbStrRes(Index : Integer) : string;\n\nimplementation\n\nuses\n AbResString;\n\ntype\n AbStrRec = record\n ID: Integer;\n Str: string;\n end;\n\nconst\n AbStrArray : array [0..66] of AbStrRec = (\n (ID: AbZipVersionNeeded; Str: AbZipVersionNeededS),\n (ID: AbUnknownCompressionMethod; Str: AbUnknownCompressionMethodS),\n (ID: AbNoExtractionMethod; Str: AbNoExtractionMethodS),\n (ID: AbInvalidPassword; Str: AbInvalidPasswordS),\n (ID: AbNoInsertionMethod; Str: AbNoInsertionMethodS),\n (ID: AbInvalidFactor; Str: AbInvalidFactorS),\n (ID: AbDuplicateName; Str: AbDuplicateNameS),\n (ID: AbUnsupportedCompressionMethod; Str: AbUnsupportedCompressionMethodS),\n (ID: AbUserAbort; Str: AbUserAbortS),\n (ID: AbArchiveBusy; Str: AbArchiveBusyS),\n (ID: AbBadSpanStream; Str: AbBadSpanStreamS),\n (ID: AbNoOverwriteSpanStream; Str: AbNoOverwriteSpanStreamS),\n (ID: AbNoSpannedSelfExtract; Str: AbNoSpannedSelfExtractS),\n (ID: AbStreamFull; Str: AbStreamFullS),\n (ID: AbNoSuchDirectory; Str: AbNoSuchDirectoryS),\n (ID: AbInflateBlockError; Str: AbInflateBlockErrorS),\n (ID: AbBadStreamType; Str: AbBadStreamTypeS),\n (ID: AbTruncateError; Str: AbTruncateErrorS),\n (ID: AbZipBadCRC; Str: AbZipBadCRCS),\n (ID: AbZipBadStub; Str: AbZipBadStubS),\n (ID: AbFileNotFound; Str: AbFileNotFoundS),\n (ID: AbInvalidLFH; Str: AbInvalidLFHS),\n (ID: AbNoArchive; Str: AbNoArchiveS),\n (ID: AbErrZipInvalid; Str: AbErrZipInvalidS),\n (ID: AbReadError; Str: AbReadErrorS),\n (ID: AbInvalidIndex; Str: AbInvalidIndexS),\n (ID: AbInvalidThreshold; Str: AbInvalidThresholdS),\n (ID: AbUnhandledFileType; Str: AbUnhandledFileTypeS),\n (ID: AbSpanningNotSupported; Str: AbSpanningNotSupportedS),\n\n (ID: AbBBSReadTooManyBytes; Str: AbBBSReadTooManyBytesS),\n (ID: AbBBSSeekOutsideBuffer; Str: AbBBSSeekOutsideBufferS),\n (ID: AbBBSInvalidOrigin; Str: AbBBSInvalidOriginS),\n (ID: AbBBSWriteTooManyBytes; Str: AbBBSWriteTooManyBytesS),\n\n (ID: AbNoCabinetDllError; Str: AbNoCabinetDllErrorS),\n (ID: AbFCIFileOpenError; Str: AbFCIFileOpenErrorS),\n (ID: AbFCIFileReadError; Str: AbFCIFileReadErrorS),\n (ID: AbFCIFileWriteError; Str: AbFCIFileWriteErrorS),\n (ID: AbFCIFileCloseError; Str: AbFCIFileCloseErrorS),\n (ID: AbFCIFileSeekError; Str: AbFCIFileSeekErrorS),\n (ID: AbFCIFileDeleteError; Str: AbFCIFileDeleteErrorS),\n (ID: AbFCIAddFileError; Str: AbFCIAddFileErrorS),\n (ID: AbFCICreateError; Str: AbFCICreateErrorS),\n (ID: AbFCIFlushCabinetError; Str: AbFCIFlushCabinetErrorS),\n (ID: AbFCIFlushFolderError; Str: AbFCIFlushFolderErrorS),\n (ID: AbFDICopyError; Str: AbFDICopyErrorS),\n (ID: AbFDICreateError; Str: AbFDICreateErrorS),\n (ID: AbInvalidCabTemplate; Str: AbInvalidCabTemplateS),\n (ID: AbInvalidCabFile; Str: AbInvalidCabFileS),\n\n (ID: AbSWSNotEndofStream; Str: AbSWSNotEndofStreamS),\n (ID: AbSWSSeekFailed; Str: AbSWSSeekFailedS),\n (ID: AbSWSWriteFailed; Str: AbSWSWriteFailedS),\n (ID: AbSWSInvalidOrigin; Str: AbSWSInvalidOriginS),\n (ID: AbSWSInvalidNewOrigin; Str: AbSWSInvalidNewOriginS),\n\n (ID: AbVMSReadTooManyBytes; Str: AbVMSReadTooManyBytesS),\n (ID: AbVMSInvalidOrigin; Str: AbVMSInvalidOriginS),\n (ID: AbVMSErrorOpenSwap; Str: AbVMSErrorOpenSwapS),\n (ID: AbVMSSeekFail; Str: AbVMSSeekFailS),\n (ID: AbVMSReadFail; Str: AbVMSReadFailS),\n (ID: AbVMSWriteFail; Str: AbVMSWriteFailS),\n (ID: AbVMSWriteTooManyBytes; Str: AbVMSWriteTooManyBytesS),\n\n (ID: AbGzipInvalid; Str: AbGzipInvalidS),\n (ID: AbGzipBadCRC; Str: AbGzipBadCRCS),\n (ID: AbGzipBadFileSize; Str: AbGzipBadFileSizeS),\n\n (ID: AbTarInvalid; Str: AbTarInvalidS),\n (ID: AbTarBadFileName; Str: AbTarBadFileNameS),\n (ID: AbTarBadLinkName; Str: AbTarBadLinkNameS),\n (ID: AbTarBadOp; Str: AbTarBadOpS)\n );\n\nfunction AbStrRes(Index : Integer) : string;\nvar\n i : Integer;\nbegin\n for i := Low(AbStrArray) to High(AbStrArray) do\n if AbStrArray[i].ID = Index then\n Result := AbStrArray[i].Str;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbCrtl.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbCrtl.pas *}\n{*********************************************************}\n{* ABBREVIA: C++Builder C runtime functions *}\n{*********************************************************}\n\nunit AbCrtl;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Windows;\n\ntype\n UInt32 = LongWord;\n size_t = {$IF defined(CPUX64)}Int64{$ELSE}Integer{$IFEND}; // NativeInt is 8 bytes in Delphi 2007\n\nconst\n __turboFloat: LongInt = 0;\n _fltused: LongInt = 0;\n\nprocedure abs; cdecl;\n external 'msvcrt.dll';\nprocedure _llshl; cdecl;\n external 'msvcrt.dll';\nprocedure _llushr; cdecl;\n external 'msvcrt.dll';\nprocedure _ftol; cdecl;\n external 'msvcrt.dll' {$IFDEF BCB}name '__ftol'{$ENDIF};\n\n{ ctype.h declarations ===================================================== }\nfunction isdigit(ch: Integer): Integer; cdecl;\n\n{ string.h declarations ==================================================== }\nfunction memcpy(Dest, Src: Pointer; Count: size_t): Pointer; cdecl;\nfunction memmove(Dest, Src: Pointer; Count: size_t): Pointer; cdecl;\nfunction memset(Dest: Pointer; Value: Byte; Count: size_t): Pointer; cdecl;\nfunction strlen(P: PAnsiChar): Integer; cdecl;\nfunction strcpy(Des, Src: PAnsiChar): PAnsiChar; cdecl;\nfunction strncpy(Des, Src: PAnsiChar; MaxLen: Integer): PAnsiChar; cdecl;\n\nfunction memcmp(s1,s2: Pointer; numBytes: LongWord): integer; cdecl;\n external 'msvcrt.dll';\nfunction wcscpy(strDestination, strSource: PWideChar): PWideChar; cdecl;\n external 'msvcrt.dll';\n\n{ stdlib.h declarations ==================================================== }\nfunction malloc(Size: Integer): Pointer; cdecl;\nprocedure free(Ptr: Pointer); cdecl;\nfunction realloc(Ptr: Pointer; Size: Integer): Pointer; cdecl;\n\n{ intrin.h declarations ==================================================== }\nprocedure ___cpuid(CPUInfo: PInteger; InfoType: Integer); cdecl;\n external 'msvcrt.dll';\n\n{ stdio.h declarations ===================================================== }\nfunction sprintf(S: PChar; const Format: PChar): Integer;\n cdecl; varargs; external 'msvcrt.dll' {$IFDEF BCB}name '_sprintf'{$ENDIF};\n\n{ process.h declarations =================================================== }\nfunction _beginthreadex(security: Pointer; stack_size: Cardinal;\n start_address: Pointer; arglist: Pointer; initflag: Cardinal;\n var thrdaddr: Cardinal): THandle; cdecl;\n\n{ MSVC/Win64 declarations ================================================== }\nprocedure __C_specific_handler; cdecl; external 'msvcrt.dll';\n\nimplementation\n\n{ ctype.h declarations ===================================================== }\nfunction isdigit(ch: Integer): Integer; cdecl;\nbegin\n if AnsiChar(ch) in ['0'..'9'] then\n Result := 1\n else\n Result := 0;\nend;\n\n{ string.h declarations ==================================================== }\nfunction memcpy(Dest, Src: Pointer; Count: size_t): Pointer; cdecl;\nbegin\n System.Move(Src^, Dest^, Count);\n Result := Dest;\nend;\n{ -------------------------------------------------------------------------- }\nfunction memmove(Dest, Src: Pointer; Count: size_t): Pointer; cdecl;\nbegin\n System.Move(Src^, Dest^, Count);\n Result := Dest;\nend;\n{ -------------------------------------------------------------------------- }\nfunction memset(Dest: Pointer; Value: Byte; Count: size_t): Pointer; cdecl;\nbegin\n FillChar(Dest^, Count, Value);\n Result := Dest;\nend;\n{ -------------------------------------------------------------------------- }\nfunction strlen(P: PAnsiChar): Integer; cdecl;\n{$IF RTLVersion >= 20}\nasm\n jmp System.@PCharLen\nend;\n{$ELSE}\nbegin\n Result := 0;\n while P^ <> #0 do\n Inc(P);\nend;\n{$IFEND}\n{ -------------------------------------------------------------------------- }\nfunction strcpy(Des, Src: PAnsiChar): PAnsiChar; cdecl;\nbegin\n Result := Des;\n Move(Src^, Des^, strlen(Src) + 1);\nend;\n{ -------------------------------------------------------------------------- }\nfunction strncpy(Des, Src: PAnsiChar; MaxLen: Integer): PAnsiChar; cdecl;\nvar\n Len: Integer;\nbegin\n Len := strlen(Src);\n if Len > MaxLen then\n Len := MaxLen;\n Move(Src^, Des^, Len);\n if Len < MaxLen then\n FillChar(Des[Len], MaxLen - Len, 0);\n Result := Des;\nend;\n\n{ stdlib.h declarations ==================================================== }\nfunction malloc(Size: Integer): Pointer; cdecl;\nbegin\n GetMem(Result, Size);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure free(Ptr: Pointer); cdecl;\nbegin\n FreeMem(Ptr)\nend;\n{ -------------------------------------------------------------------------- }\nfunction realloc(Ptr: Pointer; Size: Integer): Pointer; cdecl;\nbegin\n Result := ReallocMemory(Ptr, Size);\nend;\n\n{ process.h declarations =================================================== }\nfunction _beginthreadex(security: Pointer; stack_size: Cardinal;\n start_address: Pointer; arglist: Pointer; initflag: Cardinal;\n var thrdaddr: Cardinal): THandle; cdecl;\nbegin\n Result := CreateThread(security, stack_size, start_address, arglist,\n initflag, thrdaddr);\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDefine.inc",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDefine.inc *}\n{*********************************************************}\n{* ABBREVIA: Compiler options/directives include file *}\n{*********************************************************}\n\n{NOTE: ABDEFINE.INC is included in all ABBREVIA units; hence you can\n specify global compiler options here. ABDEFINE.INC is included\n *before* each unit's own required compiler options, so options\n specified here could be overridden by hardcoded options in the\n unit source file.}\n\n\n{====Compiler options that can be changed====}\n{$A+ Force alignment on word/dword boundaries}\n{$S- No stack checking}\n\n{---Global compiler defines for 32-bit OS's---}\n{====Global fixed compiler options (do NOT change)====}\n\n{$B- Incomplete boolean evaluation}\n{$H+ Long string support}\n{$P- No open string parameters}\n{$Q- Arithmetic overflow checking} {!! - Needs to be turned on!}\n{$R- Range checking} {!! - Needs to be turned on!}\n{$T+ No type-checked pointers}\n{$V- No var string checking}\n{$X+ Extended syntax}\n{$Z1 Enumerations are byte sized}\n\n{====Platform defines================================================}\n\n{ map Delphi platform defines to FreePascal's (MSWINDOWS/UNIX/LINUX/DARWIN) }\n{$IFNDEF FPC}\n {$IF DEFINED(LINUX) AND (CompilerVersion < 15)}\n {$DEFINE KYLIX}\n {$DEFINE UNIX}\n {$IFEND}\n {$IFDEF MACOS}\n {$DEFINE DARWIN}\n {$ENDIF}\n {$IFDEF POSIX}\n {$DEFINE UNIX}\n {$ENDIF}\n{$ENDIF}\n\n{ Unix API (Kylix/Delphi/FreePascal) }\n{$IFDEF UNIX}\n {$IF DEFINED(FPC)}\n {$DEFINE FPCUnixAPI}\n {$ELSEIF DEFINED(KYLIX)}\n {$DEFINE LibcAPI}\n {$ELSE}\n {$DEFINE PosixAPI}\n {$IFEND}\n{$ENDIF}\n\n{$IFDEF FPC}\n {$MODE DELPHI}\n {$PACKRECORDS C}\n{$ENDIF}\n\n{Activate this define to show CLX/LCL dialogs for spanning media requests. The\n default behavior will abort the operation instead. This define is only safe\n when using Abbrevia from the foreground thread. If using it from a background\n thread override OnRequestLastDisk, OnRequestNthDisk, and OnRequestBlankDisk and\n synchronize to the foreground yourself. The Windows version always MessageBox\n so it's thread-safe.}\n{.$DEFINE UnixDialogs}\n\n{====RTL defines=====================================================}\n\n{$IFNDEF FPC}\n {$IF RTLVersion >= 18} // Delphi 2006\n {$DEFINE HasAdvancedRecords}\n {$IFEND}\n {$IF RTLVersion >= 20} // Delphi 2009\n {$DEFINE HasThreadFinished}\n {$DEFINE HasInline}\n {$IFEND}\n {$IF RTLVersion >= 21} // Delphi 2010\n {$DEFINE HasThreadStart}\n {$IFEND}\n {$IF RTLVersion >= 23} // Delphi XE2\n {$DEFINE HasPlatformsAttribute}\n {$IFEND}\n{$ENDIF}\n\n{====Widgetset defines===============================================}\n\n{ VCL version specific defines }\n{$IFNDEF FPC}\n {$IF RTLVersion >= 17} // Delphi 2005\n {$DEFINE HasOnMouseActivate}\n {$IFEND}\n {$IF RTLVersion >= 18} // Delphi 2006\n {$DEFINE HasOnMouseEnter}\n {$IFEND}\n {$IF RTLVersion >= 20} // Delphi 2009\n {$DEFINE HasListViewGroups}\n {$DEFINE HasListViewOnItemChecked}\n {$DEFINE HasParentDoubleBuffered}\n {$DEFINE HasTreeViewExpandedImageIndex}\n {$IFEND}\n {$IF RTLVersion >= 21} // Delphi 2010\n {$DEFINE HasGridDrawingStyle}\n {$DEFINE HasTouch}\n {$IFEND}\n {$IF RTLVersion >= 24} // Delphi XE3\n {$DEFINE HasUITypes}\n {$IFEND}\n {$IF RTLVersion >= 25} // Delphi XE4\n {$DEFINE HasAnsiStrings}\n {$IFEND}\n{$ENDIF}\n\n{====General defines=================================================}\n\n{Activate the following define to include extra code to get rid of all\n hints and warnings. Parts of ABBREVIA are written in such a way\n that the hint/warning algorithms of the Delphi compilers are\n fooled and report things like variables being used before\n initialisation and so on when in reality the problem does not exist.}\n{$DEFINE DefeatWarnings}\n\n{ Disable warnings for explicit string casts }\n{$IFDEF UNICODE}\n {$WARN EXPLICIT_STRING_CAST OFF}\n {$WARN EXPLICIT_STRING_CAST_LOSS OFF}\n{$ENDIF}\n\n{ Disable hints on Delphi XE2/Mac to prevent unexpanded inline messages }\n{$IFDEF POSIX}\n {$HINTS OFF}\n{$ENDIF}\n\n{====Bzip2 defines===================================================}\n\n{Activate this define to statically link bzip2 .obj files into the application.\n Curerntly only supported by Delphi/Win32.}\n{.$DEFINE Bzip2Static}\n\n{Activate this define to dynamically link to a libbz2.dll/libbbz2.so.1}\n{.$DEFINE Bzip2Dynamic}\n\n{Activate this define to load libbz2.dll/libbz2.so.1 at runtime using LoadLibrary}\n{.$DEFINE Bzip2Runtime}\n\n{Pick an appropriate linking method if none of the above are activate}\n{$IF NOT DEFINED(Bzip2Static) AND NOT DEFINED(Bzip2Dynamic) AND NOT DEFINED(Bzip2Runtime)}\n {$IFDEF FPC}\n {$DEFINE Bzip2Runtime}\n {$ELSE}\n {$IFDEF MSWINDOWS}\n {$DEFINE Bzip2Static}\n {$ELSE}\n {$DEFINE Bzip2Dynamic}\n {$ENDIF}\n {$ENDIF}\n{$IFEND}\n\n{====Zip defines=====================================================}\n\n{Activate the following define when you don't want Visual parts of\nthe VCL library included for a program using a TAbArchive or\nTAbZipArchive}\n{.$DEFINE BuildingStub}\n\n{Activate the following define to include support for extracting files\nusing PKzip compatible unShrink.}\n\n{.$DEFINE UnzipShrinkSupport}\n\n{Activate the following define to include support for extracting files\nusing PKZip compatible unReduce.}\n\n{.$DEFINE UnzipReduceSupport}\n\n{Activate the following define to include support for extracting files\nusing PKZip compatible unImplode.}\n\n{.$DEFINE UnzipImplodeSupport}\n\n{Activate the following to include support for extracting files using\nall older PKZip compatible methods (Shrink, Reduce, Implode}\n\n{$DEFINE UnzipBackwardSupport}\n\n{Activate the following to include support for extracting files using\nBZIP2 compression. Added in AppNote.txt v4.6. }\n\n{.$DEFINE UnzipBzip2Support}\n\n{Activate the following to include support for extracting files using\n7-zip compatible Lzma compression. Added in AppNote.txt v6.3.}\n\n{.$DEFINE UnzipLzmaSupport}\n\n{Activate the following to include support for extracting files using\nzipx PPMd I compression. Added in AppNote.txt v6.3.}\n\n{.$DEFINE UnzipPPMdSupport}\n\n{Activate the following to include support for extracting .wav files\nusing zipx WavPack compression. Requires copyright notice in your\ndocumentation. Check \"WavPack License.txt\" for details.\nAdded in AppNote.txt v6.3. }\n\n{.$DEFINE UnzipWavPackSupport}\n\n{Activate the following to include support for extracting files using\nall newer (zipx) compatible methods (Bzip2, Lzma, PPMd, WavPack)}\n\n{$DEFINE UnzipZipxSupport}\n\n{Activate the following to include logging support in the deflate/\n inflate code. Since this logging support is a by-product of assertion\n checking, you should only activate it if that is also on: $C+}\n{$IFOPT C+} //if Assertions are on\n{.$DEFINE UseLogging}\n{$ENDIF}\n\n{\n According to\n http://www.gzip.org/zlib/rfc1952.txt\n\n A compliant gzip compressor should calculate and set the CRC32 and ISIZE.\n However, a compliant decompressor should not check these values.\n\n If you want to check the the values of the CRC32 and ISIZE in a GZIP file\n when decompressing enable the STRICTGZIP define below. }\n\n{.$DEFINE STRICTGZIP}\n\n{ The following define is ONLY used for Abbrevia Unit Tests.\n It has no effect on the Abbrevia Library.\n\n If defined it uses Winzip to create and test archives for compatability.\n The winzip tests require Systools stSpawn.pas\n It can be downloaded at http://sf.net/projects/tpsystools }\n\n{$IFDEF MSWINDOWS}\n {.$DEFINE WINZIPTESTS}\n{$ENDIF}\n\n\n{-------- !! DO NOT CHANGE DEFINES BELOW THIS LINE !! --------}\n\n{$IFDEF UnzipBackwardSupport}\n {$DEFINE UnzipShrinkSupport}\n {$DEFINE UnzipReduceSupport}\n {$DEFINE UnzipImplodeSupport}\n{$ENDIF}\n\n{$IFDEF UnzipZipxSupport}\n {$DEFINE UnzipBzip2Support}\n {$DEFINE UnzipLzmaSupport}\n {$DEFINE UnzipPPMdSupport}\n {$DEFINE UnzipWavPackSupport}\n{$ENDIF}\n\n{ Linking .obj files isn't currently supported in Kylix or FPC }\n{$IF DEFINED(FPC) OR NOT DEFINED(MSWINDOWS)}\n {$UNDEF UnzipLzmaSupport}\n {$UNDEF UnzipPPMdSupport}\n {$UNDEF UnzipWavPackSupport}\n{$IFEND}\n\n"
},
{
"path": "lib/abbrevia/source/AbDfBase.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfBase.pas *}\n{*********************************************************}\n{* Deflate base unit *}\n{*********************************************************}\n\nunit AbDfBase;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils,\n Classes;\n\ntype\n PAbDfLongintList = ^TAbDfLongintList;\n TAbDfLongintList =\n array [0..pred(MaxInt div sizeof(longint))] of longint;\n\nconst\n dfc_CodeLenCodeLength = 7;\n dfc_LitDistCodeLength = 15;\n dfc_MaxCodeLength = 15;\n\nconst\n dfc_MaxMatchLen = 258; {lengths are 3..258 for deflate}\n dfc_MaxMatchLen64 = 64 * 1024; {lengths are 3..65536 for deflate64}\n\nconst\n dfc_LitExtraOffset = 257;\n dfc_LitExtraBits : array [0..30] of byte =\n (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3,\n 4, 4, 4, 4, 5, 5, 5, 5, 16, 99, 99);\n { note: the last two are required to avoid going beyond the end}\n { of the array when generating static trees}\n\n dfc_DistExtraOffset = 0;\n dfc_DistExtraBits : array [0..31] of byte =\n (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9,\n 10, 10, 11, 11, 12, 12, 13, 13, 14, 14);\n { note: the last two are only use for deflate64}\n\n dfc_LengthBase : array [0..28] of word =\n (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, 35, 43,\n 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 3);\n { note: the final 3 is correct for deflate64; for symbol 285,}\n { lengths are stored as (length - 3)}\n { for deflate it's very wrong, but there's special code in}\n { the (de)compression code to cater for this}\n\n dfc_DistanceBase : array [0..31] of word =\n (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257,\n 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, 8193, 12289,\n 16385, 24577, 32769, 49153);\n\n dfc_CodeLengthIndex : array [0..18] of byte =\n (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);\n\nconst\n dfc_CanUseStored = $01;\n dfc_CanUseStatic = $02;\n dfc_CanUseDynamic = $04;\n dfc_UseLazyMatch = $08;\n dfc_UseDeflate64 = $10;\n dfc_UseAdler32 = $20;\n dfc_CanUseHuffman = dfc_CanUseStatic or dfc_CanUseDynamic;\n dfc_TestOnly = $40000000;\n\ntype\n TAbProgressStep = procedure (aPercentDone : integer) of object;\n {-progress metering of deflate/inflate; abort with AbortProgress}\n\n TAbDeflateHelper = class\n private\n FAmpleLength : longint;\n FChainLength : longint;\n FLogFile : string;\n FMaxLazy : longint;\n FOnProgressStep : TAbProgressStep;\n FOptions : longint;\n FPartSize : Int64;\n FSizeCompressed : Int64;\n FSizeNormal : Int64;\n FStreamSize : Int64;\n FWindowSize : longint;\n FZipOption : AnsiChar;\n protected\n procedure dhSetAmpleLength(aValue : longint);\n procedure dhSetChainLength(aValue : longint);\n procedure dhSetLogFile(const aValue : string);\n procedure dhSetMaxLazy(aValue : longint);\n procedure dhSetOnProgressStep(aValue : TAbProgressStep);\n procedure dhSetOptions(aValue : longint);\n procedure dhSetWindowSize(aValue : longint);\n procedure dhSetZipOption(aValue : AnsiChar);\n public\n constructor Create;\n\n procedure Assign(aHelper : TAbDeflateHelper);\n\n property AmpleLength : longint\n read FAmpleLength write dhSetAmpleLength;\n property ChainLength : longint\n read FChainLength write dhSetChainLength;\n property LogFile : string\n read FLogFile write dhSetLogFile;\n property MaxLazyLength : longint\n read FMaxLazy write dhSetMaxLazy;\n property Options : longint\n read FOptions write dhSetOptions;\n property PartialSize : Int64\n read FPartSize write FPartSize;\n property PKZipOption : AnsiChar\n read FZipOption write dhSetZipOption;\n property StreamSize : Int64\n read FStreamSize write FStreamSize;\n property WindowSize : longint\n read FWindowSize write dhSetWindowSize;\n\n property CompressedSize : Int64\n read FSizeCompressed write FSizeCompressed;\n property NormalSize : Int64\n read FSizeNormal write FSizeNormal;\n\n property OnProgressStep : TAbProgressStep\n read FOnProgressStep write dhSetOnProgressStep;\n end;\n\ntype\n TAbLineDelimiter = (ldCRLF, ldLF);\n\n TAbLogger = class(TStream)\n private\n FBuffer : PAnsiChar;\n FCurPos : PAnsiChar;\n FLineDelim : TAbLineDelimiter;\n FStream : TFileStream;\n protected\n function logWriteBuffer : boolean;\n public\n constructor Create(const aLogName : string);\n destructor Destroy; override;\n\n function Read(var Buffer; Count : longint) : longint; override;\n function Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; override;\n function Write(const Buffer; Count : longint) : longint; override;\n procedure WriteLine(const S : string);\n procedure WriteStr(const S : string);\n\n property LineDelimiter : TAbLineDelimiter\n read FLineDelim write FLineDelim;\n end;\n\ntype\n TAbNodeManager = class\n private\n FFreeList : pointer;\n FNodeSize : cardinal;\n FNodesPerPage : cardinal;\n FPageHead : pointer;\n FPageSize : cardinal;\n protected\n function nmAllocNewPage : pointer;\n public\n constructor Create(aNodeSize : cardinal);\n destructor Destroy; override;\n\n function AllocNode : pointer;\n function AllocNodeClear : pointer;\n procedure FreeNode(aNode : pointer);\n end;\n\n{---exception classes---}\ntype\n EAbAbortProgress = class(Exception);\n EAbPartSizedInflate = class(Exception);\n EAbInflatePasswordError = class(Exception);\n EAbInternalInflateError = class(Exception);\n EAbInflateError = class(Exception)\n public\n constructor Create(const aMsg : string);\n constructor CreateUnknown(const aMsg : string;\n const aErrorMsg : string);\n end;\n EAbInternalDeflateError = class(Exception);\n EAbDeflateError = class(Exception)\n public\n constructor Create(const aMsg : string);\n constructor CreateUnknown(const aMsg : string;\n const aErrorMsg : string);\n end;\n\n{---aborting a process---}\nprocedure AbortProgress;\n\n{---calculation of checksums---}\nprocedure AbUpdateAdlerBuffer(var aAdler : longint;\n var aBuffer; aCount : integer);\nprocedure AbUpdateCRCBuffer(var aCRC : longint;\n var aBuffer; aCount : integer);\n\n\nimplementation\n\nuses\n AbUtils;\n\n{===TAbDeflateHelper=================================================}\nconstructor TAbDeflateHelper.Create;\nbegin\n inherited Create;\n FAmpleLength := 8;\n FChainLength := 32;\n {FLogFile := '';}\n FMaxLazy := 16;\n {FOnProgressStep := nil;}\n FOptions := $F;\n {FStreamSize := 0;}\n FWindowSize := 32 * 1024;\n FZipOption := 'n';\nend;\n{--------}\nprocedure TAbDeflateHelper.Assign(aHelper : TAbDeflateHelper);\nbegin\n FAmpleLength := aHelper.FAmpleLength;\n FChainLength := aHelper.FChainLength;\n FLogFile := aHelper.FLogFile;\n FMaxLazy := aHelper.FMaxLazy;\n FOnProgressStep := aHelper.FOnProgressStep;\n FOptions := aHelper.FOptions;\n FPartSize := aHelper.FPartSize;\n FStreamSize := aHelper.FStreamSize;\n FWindowSize := aHelper.FWindowSize;\n FZipOption := aHelper.FZipOption;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetAmpleLength(aValue : longint);\nbegin\n if (aValue <> AmpleLength) then begin\n if (aValue <> -1) and (aValue < 4) then\n aValue := 4;\n FAmpleLength := aValue;\n FZipOption := '?';\n end;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetChainLength(aValue : longint);\nbegin\n if (aValue <> ChainLength) then begin\n if (aValue <> -1) and (aValue < 4) then\n aValue := 4;\n FChainLength := aValue;\n FZipOption := '?';\n end;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetLogFile(const aValue : string);\nbegin\n FLogFile := aValue;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetMaxLazy(aValue : longint);\nbegin\n if (aValue <> MaxLazyLength) then begin\n if (aValue <> -1) and (aValue < 4) then\n aValue := 4;\n FMaxLazy := aValue;\n FZipOption := '?';\n end;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetOnProgressStep(aValue : TAbProgressStep);\nbegin\n FOnProgressStep := aValue;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetOptions(aValue : longint);\nbegin\n if (aValue <> Options) then begin\n FOptions := aValue;\n FZipOption := '?';\n end;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetWindowSize(aValue : longint);\nvar\n NewValue : longint;\nbegin\n if (aValue <> WindowSize) then begin\n {calculate the window size rounded to nearest 1024 bytes}\n NewValue := ((aValue + 1023) div 1024) * 1024;\n {if the new window size is greater than 32KB...}\n if (NewValue > 32 * 1024) then\n {if the Deflate64 option is set, force to 64KB}\n if ((Options and dfc_UseDeflate64) <> 0) then\n NewValue := 64 * 1024\n {otherwise, force to 32KB}\n else\n NewValue := 32 * 1024;\n {set the new window size}\n FWindowSize := NewValue;\n end;\nend;\n{--------}\nprocedure TAbDeflateHelper.dhSetZipOption(aValue : AnsiChar);\nbegin\n {notes:\n The original Abbrevia code used the following table for\n setting the equivalent values:\n Good Lazy Chain UseLazy Option\n 4 4 4 N s ^\n 4 5 8 N |\n 4 6 32 N f faster\n 4 4 16 Y slower\n 8 16 32 Y n |\n 8 16 128 Y |\n 8 32 256 Y |\n 32 128 1024 Y |\n 32 258 4096 Y x V\n The new Abbrevia 3 code follows these values to a certain extent.\n }\n\n {force to lower case}\n if ('A' <= aValue) and (aValue <= 'Z') then\n aValue := AnsiChar(ord(aValue) + ord('a') - ord('A'));\n\n {if the value has changed...}\n if (aValue <> PKZipOption) then begin\n\n {switch on the new value...}\n case aValue of\n '0' : {no compression}\n begin\n FZipOption := aValue;\n FOptions := (FOptions and (not $0F)) or dfc_CanUseStored;\n FAmpleLength := 8; { not actually needed}\n FChainLength := 32; { not actually needed}\n FMaxLazy := 16; { not actually needed}\n end;\n '2' : {hidden option: Abbrevia 2 compatibility}\n begin\n FZipOption := aValue;\n FOptions := FOptions or $0F;\n FAmpleLength := 8;\n FChainLength := 32;\n FMaxLazy := 16;\n end;\n 'f' : {fast compression}\n begin\n FZipOption := aValue;\n FOptions := FOptions or $07; { no lazy matching}\n FAmpleLength := 4;\n FChainLength := 32;\n FMaxLazy := 6;\n end;\n 'n' : {normal compression}\n begin\n FZipOption := aValue;\n FOptions := FOptions or $0F;\n FAmpleLength := 16;\n FChainLength := 32;\n FMaxLazy := 24;\n end;\n 's' : {super fast compression}\n begin\n FZipOption := aValue;\n FOptions := FOptions or $07; { no lazy matching}\n FAmpleLength := 4;\n FChainLength := 4;\n FMaxLazy := 4;\n end;\n 'x' : {maximum compression}\n begin\n FZipOption := aValue;\n FOptions := FOptions or $0F;\n FAmpleLength := 64;{32;}\n FChainLength := 4096;\n FMaxLazy := 258;\n end;\n end;\n end;\nend;\n{====================================================================}\n\n\n{===TAbLogger========================================================}\nconst\n LogBufferSize = 4096;\n{--------}\nconstructor TAbLogger.Create(const aLogName : string);\nbegin\n Assert(aLogName <> '',\n 'TAbLogger.Create: a filename must be provided for the logger');\n\n {create the ancestor}\n inherited Create;\n\n {set the default line terminator}\n {$IFDEF MSWINDOWS}\n FLineDelim := ldCRLF;\n {$ENDIF}\n {$IFDEF UNIX}\n FLineDelim := ldLF;\n {$ENDIF}\n\n {create and initialize the buffer}\n GetMem(FBuffer, LogBufferSize);\n FCurPos := FBuffer;\n\n {create the log file}\n FStream := TFileStream.Create(aLogName, fmCreate);\nend;\n{--------}\ndestructor TAbLogger.Destroy;\nbegin\n {if there is a buffer ensure that it is flushed before freeing it}\n if (FBuffer <> nil) then begin\n if (FCurPos <> FBuffer) then\n logWriteBuffer;\n FreeMem(FBuffer, LogBufferSize);\n end;\n\n {free the stream}\n FStream.Free;\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nfunction TAbLogger.logWriteBuffer : boolean;\nvar\n BytesToWrite : longint;\n BytesWritten : longint;\nbegin\n BytesToWrite := FCurPos - FBuffer;\n BytesWritten := FStream.Write(FBuffer^, BytesToWrite);\n if (BytesWritten = BytesToWrite) then begin\n Result := true;\n FCurPos := FBuffer;\n end\n else begin\n Result := false;\n if (BytesWritten <> 0) then begin\n Move(FBuffer[BytesWritten], FBuffer^, BytesToWrite - BytesWritten);\n FCurPos := FBuffer + (BytesToWrite - BytesWritten);\n end;\n end;\nend;\n{--------}\nfunction TAbLogger.Read(var Buffer; Count : longint) : longint;\nbegin\n Assert(false, 'TAbLogger.Read: loggers are write-only, no reading allowed');\n Result := 0;\nend;\n{--------}\nfunction TAbLogger.Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64;\nbegin\n case Origin of\n soBeginning :\n begin\n end;\n soCurrent :\n if (Offset = 0) then begin\n Result := FStream.Position + (FCurPos - FBuffer);\n Exit;\n end;\n soEnd :\n if (Offset = 0) then begin\n Result := FStream.Position + (FCurPos - FBuffer);\n Exit;\n end;\n end;\n\n Assert(false, 'TAbLogger.Seek: loggers are write-only, no seeking allowed');\n Result := 0;\nend;\n{--------}\nfunction TAbLogger.Write(const Buffer; Count : longint) : longint;\nvar\n UserBuf : PAnsiChar;\n BytesToGo : longint;\n BytesToWrite : longint;\nbegin\n {reference the user's buffer as a PChar}\n UserBuf := @Buffer;\n\n {start the counter for the number of bytes written}\n Result := 0;\n\n {if needed, empty the internal buffer into the underlying stream}\n if (LogBufferSize = FCurPos - FBuffer) then\n if not logWriteBuffer then\n Exit;\n\n {calculate the number of bytes to copy this time from the user's\n buffer to the internal buffer}\n BytesToGo := Count;\n BytesToWrite := LogBufferSize - (FCurPos - FBuffer);\n if (BytesToWrite > BytesToGo) then\n BytesToWrite := BytesToGo;\n\n {copy the bytes}\n Move(UserBuf^, FCurPos^, BytesToWrite);\n\n {adjust the counters}\n inc(FCurPos, BytesToWrite);\n dec(BytesToGo, BytesToWrite);\n inc(Result, BytesToWrite);\n\n {while there are still more bytes to copy, do so}\n while (BytesToGo <> 0) do begin\n {advance the user's buffer}\n inc(UserBuf, BytesToWrite);\n\n {empty the internal buffer into the underlying stream}\n if not logWriteBuffer then\n Exit;\n\n {calculate the number of bytes to copy this time from the user's\n buffer to the internal buffer}\n BytesToWrite := LogBufferSize;\n if (BytesToWrite > BytesToGo) then\n BytesToWrite := BytesToGo;\n\n {copy the bytes}\n Move(UserBuf^, FCurPos^, BytesToWrite);\n\n {adjust the counters}\n inc(FCurPos, BytesToWrite);\n dec(BytesToGo, BytesToWrite);\n inc(Result, BytesToWrite);\n end;\nend;\n{--------}\nprocedure TAbLogger.WriteLine(const S : string);\nconst\n cLF : AnsiChar = ^J;\n cCRLF : array [0..1] of AnsiChar = ^M^J;\nbegin\n if (length(S) > 0) then\n Write(S[1], length(S));\n case FLineDelim of\n ldLF : Write(cLF, sizeof(cLF));\n ldCRLF : Write(cCRLF, sizeof(cCRLF));\n end;\nend;\n{--------}\nprocedure TAbLogger.WriteStr(const S : string);\nbegin\n if (length(S) > 0) then\n Write(S[1], length(S));\nend;\n{====================================================================}\n\n\n{===Calculate checksums==============================================}\nprocedure AbUpdateAdlerBuffer(var aAdler : longint;\n var aBuffer; aCount : integer);\nvar\n S1 : LongWord;\n S2 : LongWord;\n i : integer;\n Buffer : PAnsiChar;\n BytesToUse : integer;\nbegin\n {Note: this algorithm will *only* work if the buffer is 4KB or less,\n which is why we go to such lengths to chop up the user buffer\n into usable chunks of 4KB.\n\n However, for Delphi 3 there is no proper 32-bit longword.\n Although the additions pose no problems in this situation,\n the mod operations below (especially for S2) will be signed\n integer divisions, producing an (invalid) signed result. In\n this case, the buffer is chopped up into 2KB chunks to avoid\n any signed problems.}\n\n {split the current Adler checksum into its halves}\n S1 := LongWord(aAdler) and $FFFF;\n S2 := LongWord(aAdler) shr 16;\n\n {reference the user buffer as a PChar: it makes it easier}\n Buffer := @aBuffer;\n\n {while there's still data to checksum...}\n while (aCount <> 0) do begin\n\n {calculate the number of bytes to checksum this time}\n {$IFDEF HasLongWord}\n BytesToUse := 4096;\n {$ELSE}\n BytesToUse := 2048;\n {$ENDIF}\n if (BytesToUse > aCount) then\n BytesToUse := aCount;\n\n {checksum the bytes}\n for i := 0 to pred(BytesToUse) do begin\n inc(S1, ord(Buffer^));\n inc(S2, S1);\n inc(Buffer);\n end;\n\n {recalibrate the Adler checksum halves}\n S1 := S1 mod 65521;\n S2 := S2 mod 65521;\n\n {calculate the number of bytes still to go}\n dec(aCount, BytesToUse);\n end;\n\n {join the halves to produce the complete Adler checksum}\n aAdler := longint((S2 shl 16) or S1);\nend;\n{--------}\nprocedure AbUpdateCRCBuffer(var aCRC : longint;\n var aBuffer; aCount : integer);\nvar\n i : integer;\n CRC : LongWord;\n Buffer : PAnsiChar;\nbegin\n{$R-}{$Q-}\n {reference the user buffer as a PChar: it makes it easier}\n Buffer := @aBuffer;\n\n {get the current CRC as a local variable, it's faster}\n CRC := aCRC;\n\n {checksum the bytes in the buffer}\n for i := 0 to pred(aCount) do begin\n CRC := AbCrc32Table[byte(CRC) xor byte(Buffer^)] xor (CRC shr 8);\n inc(Buffer);\n end;\n\n {return the new CRC}\n aCRC := CRC;\n{$R+}{$Q+}\nend;\n{====================================================================}\n\n\n{===EAbInflateError==================================================}\nconstructor EAbInflateError.Create(const aMsg : string);\nbegin\n inherited Create(\n 'Abbrevia inflate error, possibly a corrupted compressed stream. ' +\n '(Internal cause: ' + aMsg + ')');\nend;\n{--------}\nconstructor EAbInflateError.CreateUnknown(const aMsg : string;\n const aErrorMsg : string);\nbegin\n inherited Create(aMsg + ': ' + aErrorMsg);\nend;\n{====================================================================}\n\n\n{===EAbDeflateError==================================================}\nconstructor EAbDeflateError.Create(const aMsg : string);\nbegin\n inherited Create(\n 'Abbrevia deflate error. ' +\n '(Internal cause: ' + aMsg + ')');\nend;\n{--------}\nconstructor EAbDeflateError.CreateUnknown(const aMsg : string;\n const aErrorMsg : string);\nbegin\n inherited Create(aMsg + ': ' + aErrorMsg);\nend;\n{====================================================================}\n\n\n{===Node manager=====================================================}\nconst\n PageSize = 8 * 1024;\ntype\n PGenericNode = ^TGenericNode;\n TGenericNode = packed record\n gnNext : PGenericNode;\n gnData : record end;\n end;\n{--------}\nconstructor TAbNodeManager.Create(aNodeSize : cardinal);\nconst\n Gran = sizeof(pointer);\n Mask = not (Gran - 1);\nbegin\n {create the ancestor}\n inherited Create;\n\n {save the node size rounded to nearest 4 bytes}\n if (aNodeSize <= sizeof(pointer)) then\n aNodeSize := sizeof(pointer)\n else\n aNodeSize := (aNodeSize + Gran - 1) and Mask;\n FNodeSize := aNodeSize;\n\n {calculate the page size (default 1024 bytes) and the number of\n nodes per page; if the default page size is not large enough for\n two or more nodes, force a single node per page}\n FNodesPerPage := (PageSize - sizeof(pointer)) div aNodeSize;\n if (FNodesPerPage > 1) then\n FPageSize := PageSize\n else begin\n FNodesPerPage := 1;\n FPagesize := aNodeSize + sizeof(pointer);\n end;\nend;\n{--------}\ndestructor TAbNodeManager.Destroy;\nvar\n Temp : pointer;\nbegin\n {dispose of all the pages, if there are any}\n while (FPageHead <> nil) do begin\n Temp := PGenericNode(FPageHead)^.gnNext;\n FreeMem(FPageHead, FPageSize);\n FPageHead := Temp;\n end;\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nfunction TAbNodeManager.AllocNode : pointer;\nbegin\n Result := FFreeList;\n if (Result = nil) then\n Result := nmAllocNewPage\n else\n FFreeList := PGenericNode(Result)^.gnNext;\nend;\n{--------}\nfunction TAbNodeManager.AllocNodeClear : pointer;\nbegin\n Result := FFreeList;\n if (Result = nil) then\n Result := nmAllocNewPage\n else\n FFreeList := PGenericNode(Result)^.gnNext;\n FillChar(Result^, FNodeSize, 0);\nend;\n{--------}\nprocedure TAbNodeManager.FreeNode(aNode : pointer);\nbegin\n {add the node (if non-nil) to the top of the free list}\n if (aNode <> nil) then begin\n PGenericNode(aNode)^.gnNext := FFreeList;\n FFreeList := aNode;\n end;\nend;\n{--------}\nfunction TAbNodeManager.nmAllocNewPage : pointer;\nvar\n NewPage : PAnsiChar;\n i : integer;\n FreeList : pointer;\n NodeSize : integer;\nbegin\n {allocate a new page and add it to the front of the page list}\n GetMem(NewPage, FPageSize);\n PGenericNode(NewPage)^.gnNext := FPageHead;\n FPageHead := NewPage;\n\n {now split up the new page into nodes and push them all onto the\n free list; note that the first 4 bytes of the page is a pointer to\n the next page, so remember to skip over it}\n inc(NewPage, sizeof(pointer));\n FreeList := FFreeList;\n NodeSize := FNodeSize;\n for i := 0 to pred(FNodesPerPage) do begin\n PGenericNode(NewPage)^.gnNext := FreeList;\n FreeList := NewPage;\n inc(NewPage, NodeSize);\n end;\n\n {return the top of the list}\n Result := FreeList;\n FFreeList := PGenericNode(Result)^.gnNext;\nend;\n{====================================================================}\n\n\n{====================================================================}\nprocedure AbortProgress;\nbegin\n raise EAbAbortProgress.Create('Abort');\nend;\n{====================================================================}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDfCryS.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfCryS.pas *}\n{*********************************************************}\n{* Deflate encryption streams *}\n{*********************************************************}\n\nunit AbDfCryS;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes;\n\ntype\n TAbZipEncryptHeader = array [0..11] of byte;\n\n TAbZipDecryptEngine = class\n private\n FReady : boolean;\n FState : array [0..2] of longint;\n protected\n procedure zdeInitState(const aPassphrase : AnsiString);\n public\n constructor Create;\n\n function Decode(aCh : byte) : byte;\n {-decodes a byte}\n procedure DecodeBuffer(var aBuffer; aCount : integer);\n {-decodes a buffer}\n\n function VerifyHeader(const aHeader : TAbZipEncryptHeader;\n const aPassphrase : AnsiString;\n aCheckValue : longint) : boolean;\n {-validate an encryption header}\n end;\n\n TAbDfDecryptStream = class(TStream)\n private\n FCheckValue : longint;\n FEngine : TAbZipDecryptEngine;\n FOwnsStream : Boolean;\n FPassphrase : AnsiString;\n FReady : boolean;\n FStream : TStream;\n protected\n public\n constructor Create(aStream : TStream;\n aCheckValue : longint;\n const aPassphrase : AnsiString);\n destructor Destroy; override;\n\n function IsValid : boolean;\n\n function Read(var aBuffer; aCount : longint) : longint; override;\n function Seek(aOffset : longint; aOrigin : word) : longint; override;\n function Write(const aBuffer; aCount : longint) : longint; override;\n\n property OwnsStream : Boolean\n read FOwnsStream\n write FOwnsStream;\n end;\n\n TAbZipEncryptEngine = class\n private\n FReady : boolean;\n FState : array [0..2] of longint;\n protected\n procedure zeeInitState(const aPassphrase : AnsiString);\n public\n constructor Create;\n\n function Encode(aCh : byte) : byte;\n {-encodes a byte}\n procedure EncodeBuffer(var aBuffer; aCount : integer);\n {-encodes a buffer}\n\n procedure CreateHeader(var aHeader : TAbZipEncryptHeader;\n const aPassphrase : AnsiString;\n aCheckValue : longint);\n {-generate an encryption header}\n end;\n\n TAbDfEncryptStream = class(TStream)\n private\n FBuffer : PAnsiChar;\n FBufSize : integer;\n FEngine : TAbZipEncryptEngine;\n FStream : TStream;\n protected\n public\n constructor Create(aStream : TStream;\n aCheckValue : longint;\n const aPassphrase : AnsiString);\n destructor Destroy; override;\n\n function Read(var aBuffer; aCount : longint) : longint; override;\n function Seek(aOffset : longint; aOrigin : word) : longint; override;\n function Write(const aBuffer; aCount : longint) : longint; override;\n end;\n\nimplementation\n\n{Notes: the ZIP spec defines a couple of primitive routines for\n performing encryption. For speed Abbrevia inlines them into\n the respective methods of the encryption/decryption engines\n\n char crc32(long,char)\n return updated CRC from current CRC and next char\n\n update_keys(char):\n Key(0) <- crc32(key(0),char)\n Key(1) <- Key(1) + (Key(0) & 000000ffH)\n Key(1) <- Key(1) * 134775813 + 1\n Key(2) <- crc32(key(2),key(1) >> 24)\n end update_keys\n\n char decrypt_byte()\n local unsigned short temp\n temp <- Key(2) | 2\n decrypt_byte <- (temp * (temp ^ 1)) >> 8\n end decrypt_byte\n}\n\nuses\n AbUtils;\n\n{---magic numbers from ZIP spec---}\nconst\n StateInit1 = 305419896;\n StateInit2 = 591751049;\n StateInit3 = 878082192;\n MagicNumber = 134775813;\n\n{===internal encryption class========================================}\nconstructor TAbZipDecryptEngine.Create;\nbegin\n {create the ancestor}\n inherited Create;\n\n {we're not ready for decryption yet since a header hasn't been\n properly verified with VerifyHeader}\n FReady := false;\nend;\n{--------}\nfunction TAbZipDecryptEngine.Decode(aCh : byte) : byte;\nvar\n Temp : longint;\nbegin\n {check for programming error}\n Assert(FReady,\n 'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first');\n\n {calculate the decoded byte (uses inlined decrypt_byte)}\n Temp := (FState[2] and $FFFF) or 2;\n Result := aCh xor ((Temp * (Temp xor 1)) shr 8);\n\n {mix the decoded byte into the state (uses inlined update_keys)}\n FState[0] := AbUpdateCrc32(Result, FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\nend;\n{--------}\nprocedure TAbZipDecryptEngine.DecodeBuffer(var aBuffer; aCount : integer);\nvar\n i : integer;\n Temp : longint;\n Buffer : PAnsiChar;\n WorkState : array [0..2] of longint;\nbegin\n {check for programming error}\n Assert(FReady,\n 'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first');\n\n {move the state to a local variable--for better speed}\n WorkState[0] := FState[0];\n WorkState[1] := FState[1];\n WorkState[2] := FState[2];\n\n {reference the buffer as a PChar--easier arithmetic}\n Buffer := @aBuffer;\n\n {for each byte in the buffer...}\n for i := 0 to pred(aCount) do begin\n\n {calculate the next decoded byte (uses inlined decrypt_byte)}\n Temp := (WorkState[2] and $FFFF) or 2;\n Buffer^ := AnsiChar(\n byte(Buffer^) xor ((Temp * (Temp xor 1)) shr 8));\n\n {mix the decoded byte into the state (uses inlined update_keys)}\n WorkState[0] := AbUpdateCrc32(byte(Buffer^), WorkState[0]);\n WorkState[1] := WorkState[1] + (WorkState[0] and $FF);\n WorkState[1] := (WorkState[1] * MagicNumber) + 1;\n WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]);\n\n {move onto the next byte}\n inc(Buffer);\n end;\n\n {save the state}\n FState[0] := WorkState[0];\n FState[1] := WorkState[1];\n FState[2] := WorkState[2];\nend;\n{--------}\nfunction TAbZipDecryptEngine.VerifyHeader(const aHeader : TAbZipEncryptHeader;\n const aPassphrase : AnsiString;\n aCheckValue : longint) : boolean;\ntype\n TLongAsBytes = packed record\n L1, L2, L3, L4 : byte\n end;\nvar\n i : integer;\n Temp : longint;\n WorkHeader : TAbZipEncryptHeader;\nbegin\n {check for programming errors}\n Assert(aPassphrase <> '',\n 'TAbZipDecryptEngine.VerifyHeader: need a passphrase');\n\n {initialize the decryption state}\n zdeInitState(aPassphrase);\n\n {decrypt the bytes in the header}\n for i := 0 to 11 do begin\n\n {calculate the next decoded byte (uses inlined decrypt_byte)}\n Temp := (FState[2] and $FFFF) or 2;\n WorkHeader[i] := aHeader[i] xor ((Temp * (Temp xor 1)) shr 8);\n\n {mix the decoded byte into the state (uses inlined update_keys)}\n FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n end;\n\n {the header is valid if the twelfth byte of the decrypted header\n equals the fourth byte of the check value}\n Result := WorkHeader[11] = TLongAsBytes(aCheckValue).L4;\n\n {note: zips created with PKZIP prior to version 2.0 also checked\n that the tenth byte of the decrypted header equals the third\n byte of the check value}\n FReady := Result;\nend;\n{--------}\nprocedure TAbZipDecryptEngine.zdeInitState(const aPassphrase : AnsiString);\nvar\n i : integer;\nbegin\n {initialize the decryption state}\n FState[0] := StateInit1;\n FState[1] := StateInit2;\n FState[2] := StateInit3;\n\n {mix in the passphrase to the state (uses inlined update_keys)}\n for i := 1 to length(aPassphrase) do begin\n FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n end;\nend;\n{====================================================================}\n\n\n{====================================================================}\nconstructor TAbDfDecryptStream.Create(aStream : TStream;\n aCheckValue : longint;\n const aPassphrase : AnsiString);\nbegin\n {create the ancestor}\n inherited Create;\n\n {save the parameters}\n FStream := aStream;\n FCheckValue := aCheckValue;\n FPassphrase := aPassphrase;\n\n {create the decryption engine}\n FEngine := TAbZipDecryptEngine.Create;\nend;\n{--------}\ndestructor TAbDfDecryptStream.Destroy; {new !!.02}\nbegin\n FEngine.Free;\n if FOwnsStream then\n FStream.Free;\n inherited Destroy;\nend;\n{--------}\nfunction TAbDfDecryptStream.IsValid : boolean;\nvar\n Header : TAbZipEncryptHeader;\nbegin\n {read the header from the stream}\n FStream.ReadBuffer(Header, sizeof(Header));\n\n {check to see if the decryption engine agrees it's valid}\n Result := FEngine.VerifyHeader(Header, FPassphrase, FCheckValue);\n\n {if it isn't valid, reposition the stream, ready for the next try}\n if not Result then begin\n FStream.Seek(-sizeof(Header), soCurrent);\n FReady := false;\n end\n\n {otherwise, the stream is ready for decrypting data}\n else\n FReady := true;\nend;\n{--------}\nfunction TAbDfDecryptStream.Read(var aBuffer; aCount : longint) : longint;\nbegin\n {check for programming error}\n Assert(FReady,\n 'TAbDfDecryptStream.Read: the stream header has not been verified');\n\n {read the data from the underlying stream}\n Result := FStream.Read(aBuffer, aCount);\n\n {decrypt the data}\n FEngine.DecodeBuffer(aBuffer, Result);\nend;\n{--------}\nfunction TAbDfDecryptStream.Seek(aOffset : longint; aOrigin : word) : longint;\nbegin\n Result := FStream.Seek(aOffset, aOrigin);\nend;\n{--------}\nfunction TAbDfDecryptStream.Write(const aBuffer; aCount : longint) : longint;\nbegin\n {check for programming error}\n Assert(false,\n 'TAbDfDecryptStream.Write: the stream is read-only');\n Result := 0;\nend;\n{====================================================================}\n\n\n{===TAbZipEncryptEngine==============================================}\nconstructor TAbZipEncryptEngine.Create;\nbegin\n {create the ancestor}\n inherited Create;\n\n {we're not ready for encryption yet since a header hasn't been\n properly generated with CreateHeader}\n FReady := false;\nend;\n{--------}\nprocedure TAbZipEncryptEngine.CreateHeader(\n var aHeader : TAbZipEncryptHeader;\n const aPassphrase : AnsiString;\n aCheckValue : longint);\ntype\n TLongAsBytes = packed record\n L1, L2, L3, L4 : byte\n end;\nvar\n Ch : byte;\n i : integer;\n Temp : longint;\n WorkHeader : TAbZipEncryptHeader;\nbegin\n {check for programming errors}\n Assert(aPassphrase <> '',\n 'TAbZipEncryptEngine.CreateHeader: need a passphrase');\n\n {set the first ten bytes of the header with random values (in fact,\n we use a random value for each byte and mix it in with the state)}\n\n {initialize the decryption state}\n zeeInitState(aPassphrase);\n\n {for the first ten bytes...}\n for i := 0 to 9 do begin\n\n {get a random value}\n Ch := Random( 256 );\n\n {calculate the XOR encoding byte (uses inlined decrypt_byte)}\n Temp := (FState[2] and $FFFF) or 2;\n Temp := (Temp * (Temp xor 1)) shr 8;\n\n {mix the unencoded byte into the state (uses inlined update_keys)}\n FState[0] := AbUpdateCrc32(Ch, FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n\n {set the current byte of the header}\n WorkHeader[i] := Ch xor Temp;\n end;\n\n {now encrypt the first ten bytes of the header (this merely sets up\n the state so that we can encrypt the last two bytes)}\n\n {reinitialize the decryption state}\n zeeInitState(aPassphrase);\n\n {for the first ten bytes...}\n for i := 0 to 9 do begin\n\n {calculate the XOR encoding byte (uses inlined decrypt_byte)}\n Temp := (FState[2] and $FFFF) or 2;\n Temp := (Temp * (Temp xor 1)) shr 8;\n\n {mix the unencoded byte into the state (uses inlined update_keys)}\n FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n\n {set the current byte of the header}\n WorkHeader[i] := WorkHeader[i] xor Temp;\n end;\n\n {now initialize byte 10 of the header, and encrypt it}\n Ch := TLongAsBytes(aCheckValue).L3;\n Temp := (FState[2] and $FFFF) or 2;\n Temp := (Temp * (Temp xor 1)) shr 8;\n FState[0] := AbUpdateCrc32(Ch, FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n WorkHeader[10] := Ch xor Temp;\n\n {now initialize byte 11 of the header, and encrypt it}\n Ch := TLongAsBytes(aCheckValue).L4;\n Temp := (FState[2] and $FFFF) or 2;\n Temp := (Temp * (Temp xor 1)) shr 8;\n FState[0] := AbUpdateCrc32(Ch, FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n WorkHeader[11] := Ch xor Temp;\n\n {we're now ready to encrypt}\n FReady := true;\n\n {return the header}\n aHeader := WorkHeader;\nend;\n{--------}\nfunction TAbZipEncryptEngine.Encode(aCh : byte) : byte;\nvar\n Temp : longint;\nbegin\n {check for programming error}\n Assert(FReady,\n 'TAbZipEncryptEngine.Encode: must call CreateHeader first');\n\n {calculate the encoded byte (uses inlined decrypt_byte)}\n Temp := (FState[2] and $FFFF) or 2;\n Result := aCh xor (Temp * (Temp xor 1)) shr 8;\n\n {mix the unencoded byte into the state (uses inlined update_keys)}\n FState[0] := AbUpdateCrc32(aCh, FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\nend;\n{--------}\nprocedure TAbZipEncryptEngine.EncodeBuffer(var aBuffer; aCount : integer);\nvar\n Ch : byte;\n i : integer;\n Temp : longint;\n Buffer : PAnsiChar;\n WorkState : array [0..2] of longint;\nbegin\n {check for programming error}\n Assert(FReady,\n 'TAbZipEncryptEngine.EncodeBuffer: must call CreateHeader first');\n\n {move the state to a local variable--for better speed}\n WorkState[0] := FState[0];\n WorkState[1] := FState[1];\n WorkState[2] := FState[2];\n\n {reference the buffer as a PChar--easier arithmetic}\n Buffer := @aBuffer;\n\n {for each byte in the buffer...}\n for i := 0 to pred(aCount) do begin\n\n {calculate the next encoded byte (uses inlined decrypt_byte)}\n Temp := (WorkState[2] and $FFFF) or 2;\n Ch := byte(Buffer^);\n Buffer^ := AnsiChar(Ch xor ((Temp * (Temp xor 1)) shr 8));\n\n {mix the decoded byte into the state (uses inlined update_keys)}\n WorkState[0] := AbUpdateCrc32(Ch, WorkState[0]);\n WorkState[1] := WorkState[1] + (WorkState[0] and $FF);\n WorkState[1] := (WorkState[1] * MagicNumber) + 1;\n WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]);\n\n {move onto the next byte}\n inc(Buffer);\n end;\n\n {save the state}\n FState[0] := WorkState[0];\n FState[1] := WorkState[1];\n FState[2] := WorkState[2];\nend;\n{--------}\nprocedure TAbZipEncryptEngine.zeeInitState(const aPassphrase : AnsiString);\nvar\n i : integer;\nbegin\n {initialize the decryption state}\n FState[0] := StateInit1;\n FState[1] := StateInit2;\n FState[2] := StateInit3;\n\n {mix in the passphrase to the state (uses inlined update_keys)}\n for i := 1 to length(aPassphrase) do begin\n FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]);\n FState[1] := FState[1] + (FState[0] and $FF);\n FState[1] := (FState[1] * MagicNumber) + 1;\n FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);\n end;\nend;\n{====================================================================}\n\n\n{===TAbDfEncryptStream===============================================}\nconstructor TAbDfEncryptStream.Create(aStream : TStream;\n aCheckValue : longint;\n const aPassphrase : AnsiString);\nvar\n Header : TAbZipEncryptHeader;\nbegin\n {create the ancestor}\n inherited Create;\n\n {save the stream parameter}\n FStream := aStream;\n\n {create the encryption engine}\n FEngine := TAbZipEncryptEngine.Create;\n\n {generate the encryption header, write it to the stream}\n FEngine.CreateHeader(Header, aPassphrase, aCheckValue);\n aStream.WriteBuffer(Header, sizeof(Header));\nend;\n{--------}\ndestructor TAbDfEncryptStream.Destroy;\nbegin\n {free the internal buffer if used}\n if (FBuffer <> nil) then\n FreeMem(FBuffer);\n\n {free the engine}\n FEngine.Free;\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nfunction TAbDfEncryptStream.Read(var aBuffer; aCount : longint) : longint;\nbegin\n {check for programming error}\n Assert(false,\n 'TAbDfEncryptStream.Read: the stream is write-only');\n Result := 0;\nend;\n{--------}\nfunction TAbDfEncryptStream.Seek(aOffset : longint; aOrigin : word) : longint;\nbegin\n Result := FStream.Seek(aOffset, aOrigin);\nend;\n{--------}\nfunction TAbDfEncryptStream.Write(const aBuffer; aCount : longint) : longint;\nbegin\n {note: since we cannot alter a const parameter, we should copy the\n data to our own buffer, encrypt it and then write it}\n\n {check that our buffer is large enough}\n if (FBufSize < aCount) then begin\n if (FBuffer <> nil) then\n FreeMem(FBuffer);\n GetMem(FBuffer, aCount);\n FBufSize := aCount;\n end;\n\n {copy the data to our buffer}\n Move(aBuffer, FBuffer^, aCount);\n\n {encrypt the data in our buffer}\n FEngine.EncodeBuffer(FBuffer^, aCount);\n\n {write the data in our buffer to the underlying stream}\n Result := FStream.Write(FBuffer^, aCount);\nend;\n{====================================================================}\n\n\nend.\n\n\n\n"
},
{
"path": "lib/abbrevia/source/AbDfDec.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfDec.pas *}\n{*********************************************************}\n{* Deflate decoding unit *}\n{*********************************************************}\n\nunit AbDfDec;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbDfBase;\n\nfunction Inflate(aSource : TStream; aDest : TStream;\n aHelper : TAbDeflateHelper) : longint;\n\nimplementation\n\nuses\n SysUtils,\n AbDfStrm,\n AbDfHufD,\n AbDfOutW,\n AbDfCryS;\n\n\n{===Helper routines==================================================}\nprocedure ReadLitDistCodeLengths(aInStrm : TAbDfInBitStream;\n aCodeLenTree : TAbDfDecodeHuffmanTree;\n var aCodeLens : array of integer;\n aCount : integer;\n var aTotalBits : integer);\nvar\n i : integer;\n SymbolCount : integer;\n LookupValue : integer;\n EncodedSymbol : longint;\n Symbol : integer;\n SymbolCodeLen : integer;\n RepeatCount : integer;\n BitBuffer : TAb32bit;\n BitCount : integer;\nbegin\n {$IFDEF UseLogging}\n {we need to calculate the total number of bits in the code lengths\n for reporting purposes, so zero the count}\n aTotalBits := 0;\n {$ENDIF}\n\n {clear the code lengths array}\n FillChar(aCodeLens, sizeof(aCodeLens), 0);\n\n {read all the Symbols required in the bit stream}\n SymbolCount := 0;\n while (SymbolCount < aCount) do begin\n {grab the lookup set of bits}\n BitCount := aCodeLenTree.LookupBitLength + 7;\n {$IFOPT C+}\n BitBuffer := aInStrm.PeekBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n BitBuffer := aInStrm.PeekMoreBits(BitCount)\n else\n BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount];\n {$ENDIF}\n LookupValue :=\n BitBuffer and AbExtractMask[aCodeLenTree.LookupBitLength];\n\n {get the encoded Symbol}\n {$IFOPT C+} {if Assertions are on}\n EncodedSymbol := aCodeLenTree.Decode(LookupValue);\n {$ELSE}\n EncodedSymbol := aCodeLenTree.Decodes^[LookupValue];\n {$ENDIF}\n\n {extract the data}\n Symbol := EncodedSymbol and $FFFF;\n SymbolCodeLen := (EncodedSymbol shr 16) and $FF;\n\n {$IFDEF UseLogging}\n {keep count of the total number of bits read}\n inc(aTotalBits, SymbolCodeLen);\n {$ENDIF}\n\n {check that the symbol is between 0 and 18}\n if not ((0 <= Symbol) and (Symbol <= 18)) then\n raise EAbInternalInflateError.Create(\n 'decoded a symbol not between 0 and 18 {ReadLitDistCodeLengths}');\n\n {check that the codelength is in range}\n if not ((0 < SymbolCodeLen) and\n (SymbolCodeLen <= aCodeLenTree.LookupBitLength)) then\n raise EAbInternalInflateError.Create(\n 'decoded a code length out of range {ReadLitDistCodeLengths}');\n\n {for a Symbol of 0..15, just save the value}\n if (Symbol <= 15) then begin\n aCodeLens[SymbolCount] := Symbol;\n inc(SymbolCount);\n {$IFOPT C+}\n aInStrm.DiscardBits(SymbolCodeLen);\n {$ELSE}\n if (aInStrm.BitsLeft < SymbolCodeLen) then\n aInStrm.DiscardMoreBits(SymbolCodeLen)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;\n aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;\n end;\n {$ENDIF}\n end\n\n {for a Symbol of 16, get two more bits and copy the previous\n code length that many times + 3}\n else if (Symbol = 16) then begin\n RepeatCount := 3 + ((BitBuffer shr SymbolCodeLen) and $3);\n Symbol := aCodeLens[SymbolCount-1];\n for i := 0 to pred(RepeatCount) do\n aCodeLens[SymbolCount+i] := Symbol;\n inc(SymbolCount, RepeatCount);\n BitCount := SymbolCodeLen + 2;\n {$IFOPT C+}\n aInStrm.DiscardBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n aInStrm.DiscardMoreBits(BitCount)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount;\n aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount;\n end;\n {$ENDIF}\n {$IFDEF UseLogging}\n inc(aTotalBits, 2);\n {$ENDIF}\n end\n\n {for a Symbol of 17, get three more bits and copy a zero code\n length that many times + 3}\n else if (Symbol = 17) then begin\n RepeatCount := 3 + ((BitBuffer shr SymbolCodeLen) and $7);\n {note: the codelengths array was aet to zeros at the start so\n the following two lines are not needed\n for i := 0 to pred(RepeatCount) do\n aCodeLens[SymbolCount+i] := 0;}\n inc(SymbolCount, RepeatCount);\n BitCount := SymbolCodeLen + 3;\n {$IFOPT C+}\n aInStrm.DiscardBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n aInStrm.DiscardMoreBits(BitCount)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount;\n aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount;\n end;\n {$ENDIF}\n {$IFDEF UseLogging}\n inc(aTotalBits, 3);\n {$ENDIF}\n end\n\n {for a Symbol of 18, get seven more bits and copy a zero code\n length that many times + 11}\n else if (Symbol = 18) then begin\n RepeatCount := 11 + ((BitBuffer shr SymbolCodeLen) and $7F);\n {note: the codelengths array was aet to zeros at the start so\n the following two lines are not needed\n for i := 0 to pred(RepeatCount) do\n aCodeLens[SymbolCount+i] := 0;}\n inc(SymbolCount, RepeatCount);\n BitCount := SymbolCodeLen + 7;\n {$IFOPT C+}\n aInStrm.DiscardBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n aInStrm.DiscardMoreBits(BitCount)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount;\n aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount;\n end;\n {$ENDIF}\n {$IFDEF UseLogging}\n inc(aTotalBits, 7);\n {$ENDIF}\n end;\n end;\nend;\n{--------}\nprocedure DecodeData(aInStrm : TAbDfInBitStream;\n aOutWindow : TAbDfOutputWindow;\n aLiteralTree : TAbDfDecodeHuffmanTree;\n aDistanceTree : TAbDfDecodeHuffmanTree;\n aDeflate64 : boolean);\nvar\n LookupValue : integer;\n EncodedSymbol : longint;\n Symbol : integer;\n SymbolCodeLen : integer;\n ExtraBitCount : integer;\n Length : integer;\n Distance : integer;\n BitBuffer : TAb32bit;\n BitCount : integer;\nbegin\n {extract the first symbol (it's got to be a literal/length symbol)}\n {..grab the lookup set of bits}\n if aDeflate64 then\n BitCount := aLiteralTree.LookupBitLength + 16\n else\n BitCount := aLiteralTree.LookupBitLength + 5;\n {$IFOPT C+}\n BitBuffer := aInStrm.PeekBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n BitBuffer := aInStrm.PeekMoreBits(BitCount)\n else\n BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount];\n {$ENDIF}\n LookupValue :=\n BitBuffer and AbExtractMask[aLiteralTree.LookupBitLength];\n {..get the encoded symbol}\n {$IFOPT C+} {if Assertions are on}\n EncodedSymbol := aLiteralTree.Decode(LookupValue);\n {$ELSE}\n EncodedSymbol := aLiteralTree.Decodes^[LookupValue];\n {$ENDIF}\n {..extract the data}\n Symbol := EncodedSymbol and $FFFF;\n SymbolCodeLen := (EncodedSymbol shr 16) and $FF;\n// ExtraBitCount := EncodedSymbol shr 24;\n\n {repeat until we get the end-of-block symbol}\n while ((Symbol <> 256) {and (ExtraBitCount <> 15)}) do begin\n {for a literal, just output it to the sliding window}\n if (Symbol < 256) then begin\n aOutWindow.AddLiteral(AnsiChar(Symbol));\n {$IFOPT C+}\n aInStrm.DiscardBits(SymbolCodeLen);\n {$ELSE}\n if (aInStrm.BitsLeft < SymbolCodeLen) then\n aInStrm.DiscardMoreBits(SymbolCodeLen)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;\n aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;\n end;\n {$ENDIF}\n end\n\n {for a length value, we need to get any extra bits, and then the\n distance (plus any extra bits for that), and then add the\n duplicated characters to the sliding window}\n else begin\n\n {check that the length symbol is less than or equal to 285}\n if (Symbol > 285) then\n raise EAbInternalInflateError.Create(\n 'decoded an invalid length symbol: greater than 285 [DecodeData]');\n\n {calculate the length (if need be, by calculating the number of\n extra bits that encode the length)}\n if (not aDeflate64) and (Symbol = 285) then begin\n Length := 258;\n {$IFOPT C+}\n aInStrm.DiscardBits(SymbolCodeLen);\n {$ELSE}\n if (aInStrm.BitsLeft < SymbolCodeLen) then\n aInStrm.DiscardMoreBits(SymbolCodeLen)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;\n aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;\n end;\n {$ENDIF}\n end\n else begin\n ExtraBitCount := EncodedSymbol shr 24;\n if (ExtraBitCount = 0) then begin\n Length := dfc_LengthBase[Symbol - 257];\n {$IFOPT C+}\n aInStrm.DiscardBits(SymbolCodeLen);\n {$ELSE}\n if (aInStrm.BitsLeft < SymbolCodeLen) then\n aInStrm.DiscardMoreBits(SymbolCodeLen)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;\n aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;\n end;\n {$ENDIF}\n end\n else begin\n Length := dfc_LengthBase[Symbol - 257] +\n ((BitBuffer shr SymbolCodeLen) and\n AbExtractMask[ExtraBitCount]);\n BitCount := SymbolCodeLen + ExtraBitCount;\n {$IFOPT C+}\n aInStrm.DiscardBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n aInStrm.DiscardMoreBits(BitCount)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount;\n aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount;\n end;\n {$ENDIF}\n end;\n end;\n\n {extract the distance}\n {..grab the lookup set of bits}\n BitCount := aDistanceTree.LookupBitLength + 14;\n {$IFOPT C+}\n BitBuffer := aInStrm.PeekBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n BitBuffer := aInStrm.PeekMoreBits(BitCount)\n else\n BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount];\n {$ENDIF}\n LookupValue :=\n BitBuffer and AbExtractMask[aDistanceTree.LookupBitLength];\n {..get the encoded symbol}\n {$IFOPT C+} {if Assertions are on}\n EncodedSymbol := aDistanceTree.Decode(LookupValue);\n {$ELSE}\n EncodedSymbol := aDistanceTree.Decodes^[LookupValue];\n {$ENDIF}\n {..extract the data}\n Symbol := EncodedSymbol and $FFFF;\n SymbolCodeLen := (EncodedSymbol shr 16) and $FF;\n\n {check that the distance symbol is less than or equal to 29}\n if (not aDeflate64) and (Symbol > 29) then\n raise EAbInternalInflateError.Create(\n 'decoded an invalid distance symbol: greater than 29 [DecodeData]');\n\n {..calculate the extra bits for the distance}\n ExtraBitCount := EncodedSymbol shr 24;\n {..calculate the distance}\n if (ExtraBitCount = 0) then begin\n Distance := dfc_DistanceBase[Symbol];\n {$IFOPT C+}\n aInStrm.DiscardBits(SymbolCodeLen);\n {$ELSE}\n if (aInStrm.BitsLeft < SymbolCodeLen) then\n aInStrm.DiscardMoreBits(SymbolCodeLen)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;\n aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;\n end;\n {$ENDIF}\n end\n else begin\n Distance := dfc_DistanceBase[Symbol] +\n ((BitBuffer shr SymbolCodeLen) and\n AbExtractMask[ExtraBitCount]);\n BitCount := SymbolCodeLen + ExtraBitCount;\n {$IFOPT C+}\n aInStrm.DiscardBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n aInStrm.DiscardMoreBits(BitCount)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr BitCount;\n aInStrm.BitsLeft := aInStrm.BitsLeft - BitCount;\n end;\n {$ENDIF}\n end;\n\n {duplicate the characters in the sliding window}\n aOutWindow.AddLenDist(Length, Distance);\n end;\n\n {extract the next symbol}\n {..grab the lookup set of bits}\n if aDeflate64 then\n BitCount := aLiteralTree.LookupBitLength + 16\n else\n BitCount := aLiteralTree.LookupBitLength + 5;\n {$IFOPT C+}\n BitBuffer := aInStrm.PeekBits(BitCount);\n {$ELSE}\n if (aInStrm.BitsLeft < BitCount) then\n BitBuffer := aInStrm.PeekMoreBits(BitCount)\n else\n BitBuffer := aInStrm.BitBuffer and AbExtractMask[BitCount];\n {$ENDIF}\n LookupValue :=\n BitBuffer and AbExtractMask[aLiteralTree.LookupBitLength];\n {..get the encoded symbol}\n {$IFOPT C+} {if Assertions are on}\n EncodedSymbol := aLiteralTree.Decode(LookupValue);\n {$ELSE}\n EncodedSymbol := aLiteralTree.Decodes^[LookupValue];\n {$ENDIF}\n {..extract the data}\n Symbol := EncodedSymbol and $FFFF;\n SymbolCodeLen := (EncodedSymbol shr 16) and $FF;\n end;\n\n {discard the bits for the end-of-block marker}\n {$IFOPT C+}\n aInStrm.DiscardBits(SymbolCodeLen);\n {$ELSE}\n if (aInStrm.BitsLeft < SymbolCodeLen) then\n aInStrm.DiscardMoreBits(SymbolCodeLen)\n else begin\n aInStrm.BitBuffer := aInStrm.BitBuffer shr SymbolCodeLen;\n aInStrm.BitsLeft := aInStrm.BitsLeft - SymbolCodeLen;\n end;\n {$ENDIF}\nend;\n{--------}\nprocedure InflateStoredBlock(aInStrm : TAbDfInBitStream;\n aOutWindow : TAbDfOutputWindow;\n aLog : TAbLogger);\nconst\n BufferSize = 16 * 1024;\nvar\n LenNotLen : packed record\n Len : word;\n NotLen : word;\n end;\n BytesToGo : integer;\n BytesToWrite : integer;\n Buffer : pointer;\nbegin\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then\n aLog.WriteLine('....a stored block');\n {$ENDIF}\n\n {align the input bit stream to the nearest byte boundary}\n aInStrm.AlignToByte;\n\n {read the length of the stored data and the notted length}\n aInStrm.ReadBuffer(LenNotLen, sizeof(LenNotLen));\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then\n aLog.WriteLine(Format('..block length: %d (%-4x, NOT %-4x)',\n [LenNotLen.Len, LenNotLen.Len, LenNotLen.NotLen]));\n {$ENDIF}\n\n {check that NOT of the length equals the notted length}\n if ((not LenNotLen.Len) <> LenNotLen.NotLen) then\n raise EAbInternalInflateError.Create(\n 'invalid stored block (length and NOT length do not match) [InflateStoredBlock]');\n\n {calculate the number of bytes to copy from the stored block}\n BytesToGo := LenNotLen.Len;\n\n {allocate a large buffer}\n GetMem(Buffer, BufferSize);\n\n {copy all the data in the stored block to the output window}\n try\n {while there are still some bytes to copy...}\n while (BytesToGo <> 0) do begin\n {calculate the number of bytes this time}\n if (BytesToGo > BufferSize) then\n BytesToWrite := BufferSize\n else\n BytesToWrite := BytesToGo;\n\n {read that many bytes and write them to the output window}\n aInStrm.ReadBuffer(Buffer^, BytesToWrite);\n aOutWindow.AddBuffer(Buffer^, BytesToWrite);\n\n {calculate the number of bytes still to copy}\n dec(BytesToGo, BytesToWrite);\n end;\n finally\n FreeMem(Buffer);\n end;\nend;\n{--------}\nprocedure InflateStaticBlock(aInStrm : TAbDfInBitStream;\n aOutWindow : TAbDfOutputWindow;\n aLog : TAbLogger;\n aDeflate64 : boolean);\nbegin\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then\n aLog.WriteLine('....a static huffman tree block');\n {$ENDIF}\n\n {decode the data with the static trees}\n DecodeData(aInStrm, aOutWindow,\n AbStaticLiteralTree, AbStaticDistanceTree, aDeflate64);\nend;\n{--------}\nprocedure InflateDynamicBlock(aInStrm : TAbDfInBitStream;\n aOutWindow : TAbDfOutputWindow;\n aLog : TAbLogger;\n aDeflate64 : boolean);\nvar\n i : integer;\n LitCount : integer;\n DistCount : integer;\n CodeLenCount : integer;\n CodeLens : array [0..285+32] of integer;\n CodeLenTree : TAbDfDecodeHuffmanTree;\n LiteralTree : TAbDfDecodeHuffmanTree;\n DistanceTree : TAbDfDecodeHuffmanTree;\n TotalBits : integer;\nbegin\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then\n aLog.WriteLine('....a dynamic huffman tree block');\n {$ENDIF}\n\n {prepare for the try..finally}\n CodeLenTree := nil;\n LiteralTree := nil;\n DistanceTree := nil;\n\n try\n {decode the number of literal, distance and codelength codes}\n LitCount := aInStrm.ReadBits(5) + 257;\n DistCount := aInStrm.ReadBits(5) + 1;\n CodeLenCount := aInStrm.ReadBits(4) + 4;\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then begin\n aLog.WriteLine(Format('Count of literals: %d', [LitCount]));\n aLog.WriteLine(Format('Count of distances: %d', [DistCount]));\n aLog.WriteLine(Format('Count of code lengths: %d', [CodeLenCount]));\n end;\n {$ENDIF}\n\n {verify that the counts are valid}\n if (LitCount > 286) then\n raise EAbInternalInflateError.Create(\n 'count of literal codes in dynamic block is greater than 286 [InflateDynamicBlock]');\n if (not aDeflate64) and (DistCount > 30) then\n raise EAbInternalInflateError.Create(\n 'count of distance codes in dynamic block is greater than 30 [InflateDynamicBlock]');\n\n {read the codelengths}\n FillChar(CodeLens, 19 * sizeof(integer), 0);\n for i := 0 to pred(CodeLenCount) do\n CodeLens[dfc_CodeLengthIndex[i]] := aInStrm.ReadBits(3);\n\n {$IFDEF UseLogging}\n {log them}\n if (aLog <> nil) then begin\n aLog.WriteLine('CodeLength Huffman tree: code lengths');\n for i := 0 to 18 do\n aLog.WriteStr(Format('%-3d', [CodeLens[i]]));\n aLog.WriteLine('');\n aLog.WriteLine(Format('..total bits: %d', [CodeLenCount * 3]));\n end;\n {$ENDIF}\n\n {create the codelength huffman tree}\n CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huDecoding);\n CodeLenTree.Build(CodeLens, 0, 19, [0], $FFFF);\n\n {$IFDEF UseLogging}\n {log the tree}\n if (aLog <> nil) then begin\n aLog.WriteLine('Code lengths tree');\n CodeLenTree.DebugPrint(aLog);\n end;\n {$ENDIF}\n\n {read the codelengths for both the literal/length and distance\n huffman trees}\n ReadLitDistCodeLengths(aInStrm, CodeLenTree, CodeLens,\n LitCount + DistCount, TotalBits);\n\n {$IFDEF UseLoggingx}\n {log them}\n if (aLog <> nil) then begin\n aLog.WriteLine('Literal/length & Dist Huffman trees: code lengths');\n for i := 0 to pred(LitCount + DistCount) do\n aLog.WriteLine(Format('%3d: %3d', [i, CodeLens[i]]));\n aLog.WriteLine('');\n aLog.WriteLine(Format('..total bits: %d', [TotalBits]));\n end;\n {$ENDIF}\n\n {create the literal huffman tree}\n LiteralTree := TAbDfDecodeHuffmanTree.Create(286, 15, huDecoding);\n LiteralTree.Build(CodeLens, 0, LitCount,\n dfc_LitExtraBits, dfc_LitExtraOffset);\n\n {$IFDEF UseLogging}\n {log the tree}\n if (aLog <> nil) then begin\n aLog.WriteLine('Literal/length tree');\n LiteralTree.DebugPrint(aLog);\n end;\n {$ENDIF}\n\n {create the distance huffman tree}\n if aDeflate64 then\n DistanceTree := TAbDfDecodeHuffmanTree.Create(32, 15, huDecoding)\n else\n DistanceTree := TAbDfDecodeHuffmanTree.Create(30, 15, huDecoding);\n DistanceTree.Build(CodeLens, LitCount, DistCount,\n dfc_DistExtraBits, dfc_DistExtraOffset);\n\n {$IFDEF UseLogging}\n {log the tree}\n if (aLog <> nil) then begin\n aLog.WriteLine('Distance tree');\n DistanceTree.DebugPrint(aLog);\n end;\n {$ENDIF}\n\n {using the literal and distance trees, decode the bit stream}\n DecodeData(aInStrm, aOutWindow,\n LiteralTree, DistanceTree, aDeflate64);\n finally\n CodeLenTree.Free;\n LiteralTree.Free;\n DistanceTree.Free;\n end;\nend;\n{====================================================================}\n\n\n{===Interfaced routine===============================================}\nfunction Inflate(aSource : TStream; aDest : TStream;\n aHelper : TAbDeflateHelper) : longint;\nvar\n Helper : TAbDeflateHelper;\n InBitStrm : TAbDfInBitStream;\n OutWindow : TAbDfOutputWindow;\n Log : TAbLogger;\n UseDeflate64 : boolean;\n UseCRC32 : boolean;\n IsFinalBlock : boolean;\n BlockType : integer;\n TestOnly : boolean;\n SourceStartPos : longint;\n DestStartPos : longint;\n {$IFDEF UseLogging}\n StartPosn : longint;\n {$ENDIF}\nbegin\n {$IFDEF DefeatWarnings}\n Result := 0;\n SourceStartPos := 0;\n DestStartPos := 0;\n TestOnly := False;\n {$ENDIF}\n\n {$IFDEF UseLogging}\n StartPosn := 0;\n {$ENDIF}\n\n {pre-conditions: streams must be allocated of course}\n Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil');\n Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil');\n\n {prepare for the try..finally}\n Helper := nil;\n InBitStrm := nil;\n OutWindow := nil;\n Log := nil;\n\n try {finally}\n try {except}\n {create our helper; assign the passed one to it}\n Helper := TAbDeflateHelper.Create;\n if (aHelper <> nil) then\n Helper.Assign(aHelper);\n\n {get the initial start positions of both streams}\n SourceStartPos := aSource.Position;\n DestStartPos := aDest.Position;\n\n {if the helper's stream size is -1, and it has a progress event\n handler, calculate the stream size from the stream itself}\n if Assigned(Helper.OnProgressStep) then begin\n if (Helper.StreamSize = -1) then\n Helper.StreamSize := aSource.Size;\n end\n \n {otherwise we certainly can't do any progress reporting}\n else begin\n Helper.OnProgressStep := nil;\n Helper.StreamSize := 0;\n end;\n\n {create the logger, if requested}\n if (Helper.LogFile <> '') then begin\n Log := TAbLogger.Create(Helper.LogFile);\n Log.WriteLine('INFLATING STREAM...');\n {$IFNDEF UseLogging}\n Log.WriteLine('Need to recompile the app with UseLogging turned on');\n {$ENDIF}\n end;\n\n InBitStrm := TAbDfInBitStream.Create(aSource,\n Helper.OnProgressStep,\n Helper.StreamSize);\n\n {create the output sliding window}\n UseDeflate64 := (Helper.Options and dfc_UseDeflate64) <> 0;\n UseCRC32 := (Helper.Options and dfc_UseAdler32) = 0;\n TestOnly := (Helper.Options and dfc_TestOnly) <> 0;\n OutWindow := TAbDfOutputWindow.Create(\n aDest, UseDeflate64, UseCRC32, Helper.PartialSize,\n TestOnly, Log);\n\n {start decoding the deflated stream}\n repeat\n {read the final block flag and the block type}\n IsFinalBlock := InBitStrm.ReadBit;\n BlockType := InBitStrm.ReadBits(2);\n\n {$IFDEF UseLogging}\n {log it}\n if (Log <> nil) then begin\n Log.WriteLine('');\n Log.WriteLine('Starting new block');\n Log.WriteLine(Format('..final block? %d', [ord(IsFinalBlock)]));\n Log.WriteLine(Format('..block type? %d', [BlockType]));\n StartPosn := OutWindow.Position;\n end;\n {$ENDIF}\n\n case BlockType of\n 0 : InflateStoredBlock(InBitStrm, OutWindow, Log);\n 1 : InflateStaticBlock(InBitStrm, OutWindow, Log, UseDeflate64);\n 2 : InflateDynamicBlock(InBitStrm, OutWindow, Log, UseDeflate64);\n else\n raise EAbInternalInflateError.Create(\n 'starting new block, but invalid block type [Inflate]');\n end;\n\n {$IFDEF UseLogging}\n {log it}\n if (Log <> nil) then\n Log.WriteLine(Format('---block end--- (decoded size %d bytes)',\n [OutWindow.Position - StartPosn]));\n {$ENDIF}\n until IsFinalBlock;\n\n {get the uncompressed stream's checksum}\n Result := OutWindow.Checksum;\n if TestOnly and (aHelper <> nil) then\n aHelper.NormalSize := OutWindow.Position;\n {$IFDEF UseLogging}\n {log it}\n if (Log <> nil) then\n Log.WriteLine(Format('End of compressed stream, checksum %-8x',\n [Result]));\n {$ENDIF}\n except\n on E : EAbPartSizedInflate do begin\n {nothing, just swallow the exception}\n Result := 0;\n end;\n on E : EAbAbortProgress do begin\n {nothing, just swallow the exception}\n Result := 0;\n end;\n on E : EAbInternalInflateError do begin\n if (Log <> nil) then\n Log.WriteLine(Format('Internal exception raised: %s',\n [E.Message]));\n raise EAbInflateError.Create(E.Message);\n end;\n end;\n finally\n Helper.Free;\n OutWindow.Free;\n InBitStrm.Free;\n Log.Free;\n end;\n\n {if there's a helper return the compressed and uncompressed sizes}\n if (aHelper <> nil) then begin\n if not TestOnly then\n aHelper.NormalSize := aDest.Position - DestStartPos;\n aHelper.CompressedSize := aSource.Position - SourceStartPos;\n end;\n\n {WARNING NOTE: the compiler will warn that the return value of this\n function might be undefined. However, it is wrong: it\n has been fooled by the code. If you don't want to see\n this warning again, enable the DefeatWarnings\n compiler define in AbDefine.inc.}\nend;\n{====================================================================}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDfEnc.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfEnc.pas *}\n{*********************************************************}\n{* Deflate encoding unit *}\n{*********************************************************}\n\nunit AbDfEnc;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbDfBase;\n\nfunction Deflate(aSource : TStream; aDest : TStream;\n aHelper : TAbDeflateHelper) : longint;\n\nimplementation\n\nuses\n AbDfInW,\n AbDfHufD,\n AbDfStrm,\n AbDfCryS,\n AbDfPkMg;\n\n{====================================================================}\nfunction CalcDynamicBitCount(aUseDeflate64: boolean;\n aLitBuckets : PAbDfLitBuckets;\n aDistBuckets : PAbDfDistBuckets;\n aCodeBuckets : PAbDfCodeLenBuckets;\n const aCodeLens : array of integer;\n const aCLCodeLens : array of integer;\n aLitCount : integer;\n aDistCount : integer;\n aCodeCount : integer) : longint;\nvar\n Symbol : integer;\n LastSymbol : integer;\n Inx : integer;\nbegin\n {note: this routine calculates the number of bits required to\n compress a given block}\n\n {a dynamic block starts off with 5 bits of literal symbol count, 5\n bits of distance symbol count, 4 bits of codelength symbol count,\n and then 3 bits for every codelength symbol used}\n Result := 5 + 5 + 4 +\n (aCodeCount * 3);\n\n {add in the bits needed to compress the literal and distance trees}\n inc(Result, aCodeBuckets^[16] * (aCLCodeLens[16] + 2));\n inc(Result, aCodeBuckets^[17] * (aCLCodeLens[16] + 3));\n inc(Result, aCodeBuckets^[18] * (aCLCodeLens[16] + 7));\n for Symbol := 3 to pred(aCodeCount) do begin\n Inx := dfc_CodeLengthIndex[Symbol];\n Assert(Inx <=15,\n 'CalcDynamicBitCount: the index array of codelengths is corrupted');\n inc(Result, aCodeBuckets^[Inx] * aCLCodeLens[Inx])\n end;\n\n {make the literal symbol 285 a special case}\n LastSymbol := pred(aLitCount);\n if (LastSymbol = 285) then\n LastSymbol := 284;\n\n {add in all the bits needed to compress the literals (except 285)}\n for Symbol := 0 to LastSymbol do\n if (Symbol < dfc_LitExtraOffset) then\n inc(Result, aLitBuckets^[Symbol] * aCodeLens[Symbol])\n else\n inc(Result, aLitBuckets^[Symbol] *\n (aCodeLens[Symbol] +\n dfc_LitExtraBits[Symbol - dfc_LitExtraOffset]));\n\n {add in all the bits needed to compress the literal symbol 285}\n if (pred(aLitCount) = 285) then\n if (not aUseDeflate64) then\n inc(Result, aLitBuckets^[285] * aCodeLens[285])\n else\n inc(Result, aLitBuckets^[285] * (aCodeLens[285] + 16));\n\n {add in all the bits needed to compress the distances}\n for Symbol := 0 to pred(aDistCount) do\n inc(Result, aDistBuckets^[Symbol] *\n (aCodeLens[aLitCount + Symbol] +\n dfc_DistExtraBits[Symbol]));\nend;\n{====================================================================}\n\n\n{====================================================================}\nprocedure OutputEndOfBlock(aBitStrm : TAbDfOutBitStream;\n aLitTree : TAbDfDecodeHuffmanTree);\nvar\n Code : longint;\nbegin\n {note: this routine encodes the end-of-block character (symbol 256)\n and then writes out the code to the bit stream}\n\n {encode the end-of-block character as a symbol}\n {$IFOPT C+} {if Assertions are on }\n Code := aLitTree.Encode(256);\n {$ELSE}\n Code := aLitTree.Encodes^[256];\n {$ENDIF}\n\n {write the code out to the bit stream}\n aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);\nend;\n{--------}\nprocedure EncodeLZStreamStored(aFinalBlock : boolean;\n aStream : TAbDfLZStream;\n aBitStrm : TAbDfOutBitStream;\n aDataSize : integer;\n aLog : TAbLogger);\nvar\n BlockHeader : packed record\n bhSize : word;\n bhNotSize : word;\n end;\n Buffer : pointer;\n Code : integer;\n BlockSize : integer;\nbegin\n {note: this routine writes out an incompressible block to the bit\n stream (the store algorithm)}\n\n {allocate the maximum buffer we can write at once}\n GetMem(Buffer, 64 * 1024);\n try\n\n {while there's more incompressible data to store...}\n while (aDataSize <> 0) do begin\n\n {calculate the block size to write this time}\n if (aDataSize > $FFFF) then begin\n BlockSize := $FFFF;\n dec(aDataSize, $FFFF);\n end\n else begin\n BlockSize := aDataSize;\n aDataSize := 0;\n end;\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then begin\n aLog.WriteLine('..Writing new block...');\n aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));\n aLog.WriteLine('..block type? 0');\n aLog.WriteLine(Format('..block size: %d', [BlockSize]));\n end;\n {$ENDIF}\n\n {output the block information to the bit stream}\n if aFinalBlock then\n Code := 1 + (0 shl 1)\n else\n Code := 0 + (0 shl 1);\n aBitStrm.WriteBits(Code, 3);\n\n {align the bit stream to the nearest byte}\n aBitStrm.AlignToByte;\n\n {write the stored block header}\n BlockHeader.bhSize := BlockSize;\n BlockHeader.bhNotSize := not BlockHeader.bhSize;\n aBitStrm.WriteBuffer(BlockHeader, sizeof(BlockHeader));\n\n {get and write this block}\n aStream.ReadStoredBuffer(Buffer^, BlockSize);\n aBitStrm.WriteBuffer(Buffer^, BlockSize);\n end;\n finally\n FreeMem(Buffer);\n end;\n\n {clear the stream, ready for the next block}\n aStream.Clear;\nend;\n{--------}\nprocedure EncodeLZStreamStatic(aFinalBlock : boolean;\n aUseDeflate64 : boolean;\n aStream : TAbDfLZStream;\n aBitStrm : TAbDfOutBitStream;\n aLog : TAbLogger);\nvar\n Code : integer;\nbegin\n {note: this routine writes out the stream of LZ77 tokens for the\n current block to the bit stream, using the static huffman\n trees to encode the token symbols}\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then begin\n aLog.WriteLine('..Writing new block...');\n aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));\n aLog.WriteLine('..block type? 1');\n end;\n {$ENDIF}\n\n {output the block information to the bit stream}\n if aFinalBlock then\n Code := 1 + (1 shl 1)\n else\n Code := 0 + (1 shl 1);\n aBitStrm.WriteBits(Code, 3);\n\n {encode the LZ77 stream}\n aStream.Encode(aBitStrm,\n AbStaticLiteralTree, AbStaticDistanceTree,\n aUseDeflate64);\n\n {output the end-of-block marker to the bit stream}\n OutputEndOfBlock(aBitStrm, AbStaticLiteralTree);\n {$IFDEF UseLogging}\n if (aLog <> nil) then\n aLog.WriteLine('Char: end-of-block marker (#256)');\n {$ENDIF}\nend;\n{--------}\nprocedure EncodeLZStreamDynamic(aFinalBlock : boolean;\n aUseDeflate64 : boolean;\n aUseBest : boolean;\n aStream : TAbDfLZStream;\n aBitStrm : TAbDfOutBitStream;\n aLog : TAbLogger);\nvar\n i : integer;\n LitTree : TAbDfDecodeHuffmanTree;\n DistTree : TAbDfDecodeHuffmanTree;\n CodeLenTree : TAbDfDecodeHuffmanTree;\n CodeLenStream : TAbDfCodeLenStream;\n CodeLens : array [0..285+32] of integer;\n CLCodeLens : array [0..18] of integer;\n LitCodeCount : integer;\n DistCodeCount : integer;\n LenCodeCount : integer;\n BitCount : integer;\n Code : integer;\n StaticSize : integer;\n StoredSize : integer;\nbegin\n {note: this routine writes out the stream of LZ77 tokens for the\n current block to the bit stream, using the dynamic huffman\n trees to encode the token symbols; if the routine determines\n that the data can better be compressed using the static\n huffman trees or should be stored as is, it'll switch\n algorithms}\n\n {prepare for the try..finally}\n LitTree := nil;\n DistTree := nil;\n CodeLenTree := nil;\n CodeLenStream := nil;\n\n try\n\n {calculate the code lengths for the literal symbols}\n GenerateCodeLengths(15, aStream.LitBuckets^, CodeLens, 0, aLog);\n\n {calculate the number of the used codelengths for the literals}\n LitCodeCount := 286;\n repeat\n dec(LitCodeCount);\n until (CodeLens[LitCodeCount] <> 0);\n inc(LitCodeCount);\n\n {calculate the code lengths for the distance symbols}\n GenerateCodeLengths(15, aStream.DistBuckets^, CodeLens,\n LitCodeCount, aLog);\n\n {calculate the number of the used codelengths for the distances}\n DistCodeCount := 32;\n repeat\n dec(DistCodeCount);\n until (CodeLens[DistCodeCount + LitCodeCount] <> 0);\n inc(DistCodeCount);\n\n {calculate the code lengths array as a stream of items}\n CodeLenStream := TAbDfCodeLenStream.Create(aLog);\n CodeLenStream.Build(CodeLens, LitCodeCount + DistCodeCount);\n\n {calculate the codelengths for the code lengths}\n GenerateCodeLengths(7, CodeLenStream.Buckets^, CLCodeLens, 0, nil);\n\n {calculate the number of the used codelengths for the code lengths}\n LenCodeCount := 19;\n repeat\n dec(LenCodeCount);\n until (CLCodeLens[dfc_CodeLengthIndex[LenCodeCount]] <> 0);\n inc(LenCodeCount);\n {..there's a minimum of four, though}\n if (LenCodeCount < 4) then\n LenCodeCount := 4;\n\n {if we have to work out and use the best method...}\n if aUseBest then begin\n\n {calculate the number of bits required for the compressed data\n using dynamic huffman trees}\n BitCount := CalcDynamicBitCount(aUseDeflate64,\n aStream.LitBuckets,\n aStream.DistBuckets,\n CodeLenStream.Buckets,\n CodeLens,\n CLCodeLens,\n LitCodeCount,\n DistCodeCount,\n LenCodeCount);\n\n {choose the algorithm with the smallest size}\n StaticSize := aStream.StaticSize;\n StoredSize := (aStream.StoredSize + 4) * 8;\n if (StaticSize < BitCount) then begin\n if (StoredSize < StaticSize) then\n EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm,\n (StoredSize div 8) - 4, aLog)\n else\n EncodeLZStreamStatic(aFinalBlock, aUseDeflate64,\n aStream, aBitStrm, aLog);\n Exit;\n end\n else if (StoredSize < BitCount) then begin\n EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm,\n (StoredSize div 8) - 4, aLog);\n Exit;\n end;\n end;\n\n {create the code lengths tree}\n CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huEncoding);\n CodeLenTree.Build(CLCodeLens, 0, 19, [0], $FFFF);\n\n {$IFDEF UseLogging}\n {log the tree}\n if (aLog <> nil) then begin\n aLog.WriteLine('Code lengths tree');\n CodeLenTree.DebugPrint(aLog);\n end;\n {$ENDIF}\n\n {calculate the literal encoding tree}\n LitTree := TAbDfDecodeHuffmanTree.Create(286, 15, huEncoding);\n LitTree.Build(CodeLens, 0, LitCodeCount,\n dfc_LitExtraBits, dfc_LitExtraOffset);\n\n {$IFDEF UseLogging}\n {log the tree}\n if (aLog <> nil) then begin\n aLog.WriteLine('Literal/length tree');\n LitTree.DebugPrint(aLog);\n end;\n {$ENDIF}\n\n {calculate the distance tree}\n if aUseDeflate64 then\n DistTree := TAbDfDecodeHuffmanTree.Create(32, 15, huEncoding)\n else\n DistTree := TAbDfDecodeHuffmanTree.Create(30, 15, huEncoding);\n DistTree.Build(CodeLens, LitCodeCount, DistCodeCount,\n dfc_DistExtraBits, dfc_DistExtraOffset);\n\n {$IFDEF UseLogging}\n if (aLog <> nil) then begin\n {log the tree}\n aLog.WriteLine('Distance tree');\n DistTree.DebugPrint(aLog);\n\n {log the new block}\n aLog.WriteLine('..Writing new block...');\n aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));\n aLog.WriteLine('..block type? 2');\n aLog.WriteLine(Format('Count of literals: %d', [LitCodeCount]));\n aLog.WriteLine(Format('Count of distances: %d', [DistCodeCount]));\n aLog.WriteLine(Format('Count of code lengths: %d', [LenCodeCount]));\n end;\n {$ENDIF}\n\n {output the block information to the bit stream}\n if aFinalBlock then\n Code := 1 + (2 shl 1)\n else\n Code := 0 + (2 shl 1);\n aBitStrm.WriteBits(Code, 3);\n\n {output the various counts to the bit stream}\n Code := (LitCodeCount - 257) +\n ((DistCodeCount - 1) shl 5) +\n ((LenCodeCount - 4) shl 10);\n aBitStrm.WriteBits(Code, 14);\n\n {output the code length codelengths to the bit stream}\n for i := 0 to pred(LenCodeCount) do\n aBitStrm.WriteBits(CLCodeLens[dfc_CodeLengthIndex[i]], 3);\n\n {encode and write the codelength stream to the bit stream}\n CodeLenStream.Encode(aBitStrm, CodeLenTree);\n\n {encode and write the LZ77 stream to the bit stream}\n aStream.Encode(aBitStrm, LitTree, DistTree, aUseDeflate64);\n\n {output the end-of-block marker to the bit stream}\n OutputEndOfBlock(aBitStrm, LitTree);\n {$IFDEF UseLogging}\n if (aLog <> nil) then\n aLog.WriteLine('Char: end-of-block marker (#256)');\n {$ENDIF}\n\n finally\n LitTree.Free;\n DistTree.Free;\n CodeLenTree.Free;\n CodeLenStream.Free;\n end;\nend;\n{====================================================================}\n\n\n{===Single algorithm Static/Dynamic Huffman tree deflate=============}\nfunction DeflateStaticDynamic(aStatic : boolean;\n aUseBest: boolean;\n aSource : TStream; aDest : TStream;\n aHelper : TAbDeflateHelper;\n aLog : TAbLogger) : longint;\nvar\n i : integer;\n SlideWin : TAbDfInputWindow;\n BitStrm : TAbDfOutBitStream;\n LZ77Stream : TAbDfLZStream;\n KeyLen : integer;\n Match : TAbDfMatch;\n PrevMatch : TAbDfMatch;\n UseDeflate64 : boolean;\n UseCRC32 : boolean;\n GotMatch : boolean;\n LZStrmIsFull : boolean;\n TestForBinary: boolean;\nbegin\n {note: turn on the following define to see when and how the lazy\n matching algorithm works}\n {$IFDEF UseLogging}\n {$DEFINE UseLazyMatchLogging}\n {$ENDIF}\n\n {$IFDEF UseLogging}\n if (aLog <> nil) then\n if aStatic then\n aLog.WriteLine('..compressing source data with static huffman trees')\n else\n aLog.WriteLine('..compressing source data with dynamic huffman trees');\n {$ENDIF}\n\n {prepare for the try..finally}\n SlideWin := nil;\n BitStrm := nil;\n LZ77Stream := nil;\n try\n\n {create the sliding window}\n UseDeflate64 := (aHelper.Options and dfc_UseDeflate64) <> 0;\n UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0;\n SlideWin := TAbDfInputWindow.Create(aSource,\n aHelper.StreamSize,\n aHelper.WindowSize,\n aHelper.ChainLength,\n UseDeflate64, UseCRC32);\n SlideWin.OnProgress := aHelper.OnProgressStep;\n\n {create the bit stream}\n BitStrm := TAbDfOutBitStream.Create(aDest);\n\n {create the LZ77 stream}\n LZ77Stream := TAbDfLZStream.Create(SlideWin, UseDeflate64, aLog);\n LZStrmIsFull := false;\n TestForBinary := true;\n\n {set the previous match to be a literal character: this will\n ensure that no lazy matching goes on with the first key read}\n PrevMatch.maLen := 0;\n\n {get the first key length}\n KeyLen := SlideWin.GetNextKeyLength;\n\n {while the current key is three characters long...}\n while (KeyLen = 3) do begin\n\n {tweak for binary/text}\n {note: the test for whether a stream is binary or not is to\n check whether there are any #0 characters in the first\n 1024 bytes: if there are the stream is binary.\n this test and tweaking is based on experimentation\n compression ratios for binary and text files based on the\n PKZIP 'n' option.}\n if TestForBinary and (LZ77Stream.StoredSize = 1024) then begin\n if (aHelper.PKZipOption = 'n') then\n if (LZ77Stream.LitBuckets^[0] = 0) then begin\n aHelper.AmpleLength := aHelper.AmpleLength * 2;\n aHelper.MaxLazyLength := aHelper.MaxLazyLength * 2;\n aHelper.ChainLength := aHelper.ChainLength * 2;\n SlideWin.ChainLen := aHelper.ChainLength;\n end;\n TestForBinary := false;\n end;\n\n {if the LZ77 stream is full, empty it}\n if LZStrmIsFull then begin\n if aStatic then\n EncodeLZStreamStatic(false, UseDeflate64,\n LZ77Stream, BitStrm, aLog)\n else\n EncodeLZStreamDynamic(false, UseDeflate64, aUseBest,\n LZ77Stream, BitStrm, aLog);\n LZ77Stream.Clear;\n LZStrmIsFull := false;\n end;\n\n {try and find a match of three or more characters (note: this\n has the side effect of adding the current key to the internal\n hash table); this routine will only return true if it finds a\n match greater than the previous match}\n GotMatch := SlideWin.FindLongestMatch(aHelper.AmpleLength,\n Match, PrevMatch);\n\n {if the maximum match length were three and the distance exceeds\n 4096 bytes, it's most likely that we'll get better compression\n by outputting the three literal bytes rather than by outputting\n a length symbol, a distance symbol, and at least ten extra\n bits for the extra distance value}\n if (Match.maLen = 3) and (Match.maDist > 4096) then\n GotMatch := false;\n\n {if we found a match...}\n if GotMatch then begin\n\n {if there were no previous match, we can't do any lazy match\n processing now, so save the current match details ready for\n lazy matching the next time through, and advance the sliding\n window}\n if (PrevMatch.maLen = 0) then begin\n PrevMatch.maLen := Match.maLen;\n PrevMatch.maDist := Match.maDist;\n PrevMatch.maLit := Match.maLit;\n SlideWin.AdvanceByOne;\n end\n\n {otherwise the previous match is smaller than this one, so\n we're going to accept this match in preference; throw away\n the previous match, output the previous literal character\n instead and save these match details}\n else begin\n {$IFDEF UseLazyMatchLogging}\n if (aLog <> nil) then\n aLog.WriteLine(\n Format(\n '..this match longer, rejecting previous one (%d,%d)',\n [PrevMatch.maLen, PrevMatch.maDist]));\n {$ENDIF}\n LZStrmIsFull := LZ77Stream.AddLiteral(PrevMatch.maLit);\n PrevMatch.maLen := Match.maLen;\n PrevMatch.maDist := Match.maDist;\n PrevMatch.maLit := Match.maLit;\n SlideWin.AdvanceByOne;\n end;\n\n {if, by this point, we're storing up a match, check to see\n if it equals or exceeds the maximum lazy match length; if\n it does then output the match right now and avoid checking\n for a lazy match}\n if (PrevMatch.maLen >= aHelper.MaxLazyLength) then begin\n {$IFDEF UseLazyMatchLogging}\n if (aLog <> nil) then\n if ((aHelper.Options and dfc_UseLazyMatch) <> 0) then\n aLog.WriteLine('..match longer than max lazy match, using it');\n {$ENDIF}\n LZStrmIsFull :=\n LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);\n SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 1);\n PrevMatch.maLen := 0;\n end;\n end\n\n {otherwise, we don't have a match at all: so we possibly just\n need to output a literal character}\n else begin\n {if there was a previous match, output it and discard the\n results of this match}\n if (PrevMatch.maLen <> 0) then begin\n LZStrmIsFull :=\n LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);\n SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 2);\n PrevMatch.maLen := 0;\n end\n\n {otherwise there was no previous match or it's already been\n output, so output this literal}\n else begin\n LZStrmIsFull := LZ77Stream.AddLiteral(Match.maLit);\n SlideWin.AdvanceByOne;\n PrevMatch.maLen := 0;\n end;\n end;\n\n {get the next key}\n KeyLen := SlideWin.GetNextKeyLength;\n end;\n\n {if the last key read were one or two characters in length, save\n them as literal character encodings}\n if (KeyLen > 0) then begin\n {if there's a match pending, it'll be of length 3: output it}\n if (PrevMatch.maLen <> 0) then begin\n Assert(PrevMatch.maLen = 3,\n 'DeflateStaticDynamic: previous match should be length 3');\n LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);\n end\n {otherwise, output the one or two final literals}\n else\n for i := 1 to KeyLen do\n LZ77Stream.AddLiteral(SlideWin.GetNextChar);\n end;\n\n {empty the LZ77 stream}\n if aStatic then\n EncodeLZStreamStatic(true, UseDeflate64,\n LZ77Stream, BitStrm, aLog)\n else\n EncodeLZStreamDynamic(true, UseDeflate64, aUseBest,\n LZ77Stream, BitStrm, aLog);\n\n {calculate the checksum of the input stream}\n Result := SlideWin.Checksum;\n finally\n {free the objects}\n SlideWin.Free;\n BitStrm.Free;\n LZ77Stream.Free;\n end;{try..finally}\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then\n aLog.WriteLine(Format('..checksum: %8x', [Result]))\n {$ENDIF}\nend;\n{====================================================================}\n\n\n{===Simple storing===================================================}\nfunction DeflateStored(aSource : TStream; aDest : TStream;\n aHelper : TAbDeflateHelper;\n aLog : TAbLogger) : longint;\nconst\n StoredBlockSize = $FFFF;\nvar\n Buffer : PAnsiChar;\n BytesRead : LongWord;\n ByteCount : Int64;\n BytesToGo : Int64;\n CurPos : Int64;\n Size : Int64;\n Percent : longint;\n CheckSum : longint;\n UseCRC32 : boolean;\n BlockHeader : packed record\n bhInfo : byte;\n bhSize : word;\n bhNotSize : word;\n end;\nbegin\n {note: this routine merely stores the aSource stream data, no\n compression is attempted or done}\n {$IFDEF UseLogging}\n if (aLog <> nil) then\n aLog.WriteLine('..storing source data to destination, no compression');\n {$ENDIF}\n\n {initialize}\n ByteCount := 0;\n UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0;\n if UseCRC32 then\n Checksum := -1 { CRC32 starts off with all bits set}\n else\n CheckSum := 1; { Adler32 starts off with a value of 1}\n if (aHelper.StreamSize > 0) then\n BytesToGo := aHelper.StreamSize\n else begin\n CurPos := aSource.Seek(0, soCurrent);\n Size := aSource.Seek(0, soEnd);\n aSource.Seek(CurPos, soBeginning);\n BytesToGo := Size - CurPos;\n end;\n\n {get a buffer}\n GetMem(Buffer, StoredBlockSize);\n try\n\n {while there is still data to be stored...}\n while (BytesToGo <> 0) do begin\n\n {read the next block}\n BytesRead := aSource.Read(Buffer^, StoredBlockSize);\n\n {fire the progress event}\n if Assigned(aHelper.OnProgressStep) then begin\n inc(ByteCount, BytesRead);\n Percent := Round((100.0 * ByteCount) / aHelper.StreamSize);\n aHelper.OnProgressStep(Percent);\n end;\n\n {update the checksum}\n if UseCRC32 then\n AbUpdateCRCBuffer(Checksum, Buffer^, BytesRead)\n else\n AbUpdateAdlerBuffer(Checksum, Buffer^, BytesRead);\n\n {write the block header}\n if (BytesRead = BytesToGo) then\n BlockHeader.bhInfo := 1 {ie, final block, stored}\n else\n BlockHeader.bhInfo := 0; {ie, not final block, stored}\n BlockHeader.bhSize := BytesRead;\n BlockHeader.bhNotSize := not BlockHeader.bhSize;\n aDest.WriteBuffer(BlockHeader, sizeof(BlockHeader));\n\n {write the block of data}\n aDest.WriteBuffer(Buffer^, BytesRead);\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then begin\n if (BlockHeader.bhInfo = 0) then\n aLog.WriteLine(Format('..block size: %d', [BytesRead]))\n else\n aLog.WriteLine(Format('..block size: %d (final block)',\n [BytesRead]));\n end;\n {$ENDIF}\n\n {decrement the number of bytes to go}\n dec(BytesToGo, BytesRead);\n end;\n finally\n FreeMem(Buffer);\n end;\n\n {return the checksum}\n {note: the CRC32 checksum algorithm requires a post-conditioning\n step after being calculated (the result is NOTted), whereas\n Adler32 does not}\n if UseCRC32 then\n Result := not Checksum\n else\n Result := Checksum;\n\n {$IFDEF UseLogging}\n {log it}\n if (aLog <> nil) then\n aLog.WriteLine(Format('..checksum: %8x', [Result]))\n {$ENDIF}\nend;\n{====================================================================}\n\n\n{===Interfaced routine===============================================}\nfunction Deflate(aSource : TStream; aDest : TStream;\n aHelper : TAbDeflateHelper) : longint;\nvar\n Helper : TAbDeflateHelper;\n Log : TAbLogger;\n SourceStartPos : longint;\n DestStartPos : longint;\nbegin\n {pre-conditions: streams are allocated,\n options enable some kind of archiving}\n Assert(aSource <> nil, 'Deflate: aSource stream cannot be nil');\n Assert(aDest <> nil, 'Deflate: aDest stream cannot be nil');\n Assert((aHelper = nil) or ((aHelper.Options and $07) <> 0),\n 'Deflate: aHelper.Options must enable some kind of archiving');\n\n {$IFDEF DefeatWarnings}\n Result := 0;\n {$ENDIF}\n\n {prepare for the try..finally}\n Helper := nil;\n Log := nil;\n\n try {finally}\n try {except}\n {create our helper; assign the passed one to it}\n Helper := TAbDeflateHelper.Create;\n if (aHelper <> nil) then\n Helper.Assign(aHelper);\n\n {save the current positions of both streams}\n SourceStartPos := aSource.Position;\n DestStartPos := aDest.Position;\n\n {if the helper's stream size is -1, and it has a progress event\n handler, calculate the stream size from the stream itself}\n if Assigned(Helper.OnProgressStep) then begin\n if (Helper.StreamSize = -1) then\n Helper.StreamSize := aSource.Size;\n end\n\n {otherwise we certainly can't do any progress reporting}\n else begin\n Helper.OnProgressStep := nil;\n Helper.StreamSize := 0;\n end;\n\n {if lazy matching is not requested, ensure the maximum lazy\n match length is zero: this make the LZ77 code a little easier\n to understand}\n if ((Helper.Options and dfc_UseLazyMatch) = 0) then\n Helper.MaxLazyLength := 0;\n\n {patch up the various lengths in the helper if they specify the\n maximum (that is, are equal to -1)}\n if (Helper.AmpleLength = -1) then\n Helper.AmpleLength := MaxLongInt;\n if (Helper.MaxLazyLength = -1) then\n Helper.MaxLazyLength := MaxLongInt;\n if (Helper.ChainLength = -1) then\n Helper.ChainLength := MaxLongInt;\n\n {create the logger, if requested}\n if (Helper.LogFile <> '') then begin\n Log := TAbLogger.Create(Helper.LogFile);\n Log.WriteLine('DEFLATING STREAM...');\n {$IFNDEF UseLogging}\n Log.WriteLine('Need to recompile the app with UseLogging turned on');\n {$ENDIF}\n end;\n\n {use the helper's options property to decide what to do}\n case (Helper.Options and $07) of\n dfc_CanUseStored :\n Result := DeflateStored(aSource, aDest, Helper, Log);\n dfc_CanUseStatic :\n Result := DeflateStaticDynamic(true, false, aSource, aDest, Helper, Log);\n dfc_CanUseDynamic :\n Result := DeflateStaticDynamic(false, false, aSource, aDest, Helper, Log);\n else\n Result := DeflateStaticDynamic(false, true, aSource, aDest, Helper, Log);\n end;\n\n {save the uncompressed and compressed sizes}\n if (aHelper <> nil) then begin\n aHelper.NormalSize := aSource.Position - SourceStartPos;\n aHelper.CompressedSize := aDest.Position - DestStartPos;\n end;\n except\n on E : EAbInternalDeflateError do begin\n {$IFDEF UseLogging}\n if (Log <> nil) then\n Log.WriteLine(Format('Internal exception raised: %s',\n [E.Message]));\n {$ENDIF}\n raise EAbDeflateError.Create(E.Message);\n end;\n end;\n finally\n Helper.Free;\n Log.Free;\n end;\n {WARNING NOTE: the compiler will warn that the return value of this\n function might be undefined. However, it is wrong: it\n has been fooled by the code. If you don't want to see\n this warning again, enable the DefeatWarnings\n compiler define in AbDefine.inc.}\nend;\n{====================================================================}\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbDfHufD.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfHufD.pas *}\n{*********************************************************}\n{* Deflate Huffman tree for decoder *}\n{*********************************************************}\n\nunit AbDfHufD;\n\n{$I AbDefine.inc}\n\n{Activate this compiler define and rebuild if you want the complete\n huffman tree output to print to the current log. The output is\n voluminous to say the least...}\n{$IFDEF UseLogging}\n{.$DEFINE EnableMegaLog}\n{$ENDIF}\n\n{Notes:\n\nThe object of this class is to build a decoder array, not to build a\nHuffman tree particularly. We don't want to decode huffman strings bit\nby bit. moving down the Huffman tree sometimes left, sometimes right.\nInstead we want to grab a set of bits and look them up in an array.\nSometimes we'll grab too many bits, sure, but we can deal with that\nlater. So, the object of the exercise is to calculate the code for a\nsymbol, reverse it ('cos that's how the input bit stream will present\nit to us) and set that element of the array to the decoded symbol\nvalue (plus some extra information: bit lengths).\n\nIf the alphabet size were 19 (the codelengths huffman tree) and the\nmaximum code length 5, for example, the decoder array would be 2^5\nelements long, much larger than the alphabet size. The user of this\nclass will be presenting sets of 5 bits for us to decode. We would\nlike to look up these 5 bits in the array (as an index) and have the\nsymbol returned. Now, since the alphabet size is much less than the\nnumber of elements in the decoder array, we must set the other\nelements in the array as well. Consider a symbol that has a code of\n110 in this scenario. The reversed code is 011, or 3, so we'd be\nsetting element 3. However we should also be setting elements 01011,\n10011, and 11011 to this symbol information as well, since the lookup\nwill be 5 bits long.\n\nBecause the code is a huffman code from a prefix tree, we won't get\nany index clashes between actual codes by this \"filling in\" process.\n\nFor the codelength Huffman tree, the maximum code length is at most 7.\nThis equates to a 128 element array. For the literal and distance\ntrees, the max code length is at most 15. This equates to a 32768\nelement array.\n\nFor a given lookup value the decoder will return a 32-bit value. The\nlower 16 bits is the decoded symbol, the next 8 bits is the code\nlength for that symbol, the last 8 bits (the most significant) are the\nnumber of extra bits that must be extracted from the input bit stream.\n}\n\ninterface\n\nuses\n AbDfBase;\n\ntype\n TAbDfHuffmanUsage = ( {usage of a huffman decoder..}\n huEncoding, {..encoding}\n huDecoding, {..decoding}\n huBoth); {..both (used for static trees)}\n\n TAbDfDecodeHuffmanTree = class\n private\n FAlphaSize : integer;\n FDecodes : PAbDfLongintList;\n FDefMaxCodeLen : integer;\n FEncodes : PAbDfLongintList;\n {$IFOPT C+}\n FMask : integer;\n {$ENDIF}\n FMaxCodeLen : integer;\n FUsage : TAbDfHuffmanUsage;\n protected\n public\n constructor Create(aAlphabetSize : integer;\n aDefMaxCodeLen: integer;\n aUsage : TAbDfHuffmanUsage);\n destructor Destroy; override;\n\n procedure Build(const aCodeLengths : array of integer;\n aStartInx : integer;\n aCount : integer;\n const aExtraBits : array of byte;\n aExtraOffset : integer);\n function Decode(aLookupBits : integer) : longint;\n function Encode(aSymbol : integer) : longint;\n\n {$IFDEF UseLogging}\n procedure DebugPrint(aLog : TAbLogger);\n {$ENDIF}\n\n property LookupBitLength : integer read FMaxCodeLen;\n property Decodes : PAbDfLongintList read FDecodes;\n property Encodes : PAbDfLongintList read FEncodes;\n end;\n\nvar\n AbStaticLiteralTree : TAbDfDecodeHuffmanTree;\n AbStaticDistanceTree : TAbDfDecodeHuffmanTree;\n\nimplementation\n\nuses\n SysUtils;\n\nconst\n PowerOfTwo : array [0..dfc_MaxCodeLength] of integer =\n (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048,\n 4096, 8192, 16384, 32768);\n\n{===Debug helper routine=============================================}\n{$IFDEF EnableMegaLog}\nfunction CodeToStr(aCode : longint; aLen : integer) : string;\nvar\n i : integer;\nbegin\n if (aLen = 0) then\n Result := 'no code'\n else begin\n SetLength(Result, 32);\n FillChar(Result[1], 32, ' ');\n for i := 32 downto (33-aLen) do begin\n if Odd(aCode) then\n Result[i] := '1'\n else\n Result[i] := '0';\n aCode := aCode shr 1;\n end;\n end;\nend;\n{$ENDIF}\n{====================================================================}\n\n\n{===TAbDfDecodeHuffmanTree===========================================}\nconstructor TAbDfDecodeHuffmanTree.Create(\n aAlphabetSize : integer;\n aDefMaxCodeLen: integer;\n aUsage : TAbDfHuffmanUsage);\nbegin\n {protect against dumb programming mistakes}\n Assert(aAlphabetSize >= 2,\n 'TAbDfDecodeHuffmanTree.Create: a huffman tree must be for at least two symbols');\n\n {let the ancestor initialize}\n inherited Create;\n\n {save the alphabet size, etc}\n FAlphaSize := aAlphabetSize;\n FDefMaxCodeLen := aDefMaxCodeLen;\n FUsage := aUsage;\n\n {allocate the encoder array (needs to be initialized to zeros)}\n if (aUsage <> huDecoding) then\n FEncodes := AllocMem(FAlphaSize * sizeof(longint));\nend;\n{--------}\ndestructor TAbDfDecodeHuffmanTree.Destroy;\nbegin\n {destroy the codes arrays}\n if (FDecodes <> nil) then\n FreeMem(FDecodes);\n if (FEncodes <> nil) then\n FreeMem(FEncodes);\n\n {let the ancestor die}\n inherited Destroy;\nend;\n{--------}\nprocedure TAbDfDecodeHuffmanTree.Build(\n const aCodeLengths : array of integer;\n aStartInx : integer;\n aCount : integer;\n const aExtraBits : array of byte;\n aExtraOffset : integer);\nconst\n ByteRevTable : array [0..255] of byte = (\n $00, $80, $40, $C0, $20, $A0, $60, $E0, $10, $90, $50, $D0,\n $30, $B0, $70, $F0, $08, $88, $48, $C8, $28, $A8, $68, $E8,\n $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84, $44, $C4,\n $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4,\n $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC,\n $3C, $BC, $7C, $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2,\n $12, $92, $52, $D2, $32, $B2, $72, $F2, $0A, $8A, $4A, $CA,\n $2A, $AA, $6A, $EA, $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA,\n $06, $86, $46, $C6, $26, $A6, $66, $E6, $16, $96, $56, $D6,\n $36, $B6, $76, $F6, $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE,\n $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1,\n $21, $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1,\n $09, $89, $49, $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9,\n $39, $B9, $79, $F9, $05, $85, $45, $C5, $25, $A5, $65, $E5,\n $15, $95, $55, $D5, $35, $B5, $75, $F5, $0D, $8D, $4D, $CD,\n $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD,\n $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53, $D3,\n $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB,\n $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7,\n $27, $A7, $67, $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7,\n $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, $1F, $9F, $5F, $DF,\n $3F, $BF, $7F, $FF);\nvar\n i : integer;\n Symbol : integer;\n LengthCount : array [0..dfc_MaxCodeLength] of integer;\n NextCode : array [0..dfc_MaxCodeLength] of integer;\n Code : longint;\n CodeLen : integer;\n CodeData : longint;\n DecoderLen : integer;\n CodeIncr : integer;\n Decodes : PAbDfLongintList;\n Encodes : PAbDfLongintList;\n {$IFDEF CPU386}\n DecodesEnd : pointer;\n {$ENDIF}\n TablePtr : pointer;\nbegin\n {count the number of instances of each code length and calculate the\n maximum code length at the same time}\n FillChar(LengthCount, sizeof(LengthCount), 0);\n FMaxCodeLen := 0;\n for i := 0 to pred(aCount) do begin\n CodeLen := aCodeLengths[i + aStartInx];\n Assert((CodeLen <= FDefMaxCodeLen),\n Format('TAbDfDecodeHuffmanTree.Build: a code length is greater than %d',\n [FDefMaxCodeLen]));\n if (CodeLen > FMaxCodeLen) then\n FMaxCodeLen := CodeLen;\n inc(LengthCount[CodeLen]);\n end;\n\n {now we know the maximum code length we can allocate our decoder\n array}\n {$IFNDEF CPU386}\n DecoderLen := 0;\n {$ENDIF}\n if (FUsage <> huEncoding) then begin\n DecoderLen := PowerOfTwo[FMaxCodeLen];\n GetMem(FDecodes, DecoderLen * sizeof(longint));\n {$IFDEF CPU386}\n DecodesEnd := PAnsiChar(FDecodes) + (DecoderLen * sizeof(longint));\n {$ENDIF}\n {$IFOPT C+}\n FillChar(FDecodes^, DecoderLen * sizeof(longint), $FF);\n FMask := not (DecoderLen - 1);\n {$ENDIF}\n end;\n\n {calculate the start codes for each code length}\n Code := 0;\n LengthCount[0] := 0;\n for i := 1 to FDefMaxCodeLen do begin\n Code := (Code + LengthCount[i-1]) shl 1;\n NextCode[i] := Code;\n end;\n\n {for speed and convenience}\n Decodes := FDecodes;\n Encodes := FEncodes;\n TablePtr := @ByteRevTable;\n\n {for each symbol...}\n for Symbol := 0 to pred(aCount) do begin\n {calculate the code length}\n CodeLen := aCodeLengths[Symbol + aStartInx];\n\n {if the code length were zero, just set the relevant entry in the\n encoder array; the decoder array doesn't need anything}\n if (CodeLen = 0) then begin\n if (FUsage <> huDecoding) then\n Encodes^[Symbol] := -1\n end\n\n {otherwise we need to fill elements in both the encoder and\n decoder arrays}\n else begin\n {calculate *reversed* code}\n Code := NextCode[CodeLen];\n {$IFDEF CPU386}\n asm\n push esi\n mov eax, Code\n mov esi, TablePtr\n xor ecx, ecx\n xor edx, edx\n mov cl, ah\n mov dl, al\n mov al, [esi+ecx]\n mov ah, [esi+edx]\n mov ecx, 16\n pop esi\n sub ecx, CodeLen\n shr eax, cl\n mov Code, eax\n end;\n {$ELSE}\n CodeData:= Code;\n LongRec(Code).Bytes[1]:= ByteRevTable[LongRec(CodeData).Bytes[0]];\n LongRec(Code).Bytes[0]:= ByteRevTable[LongRec(CodeData).Bytes[1]];\n Code:= Code shr (16-CodeLen);\n {$ENDIF}\n\n {set the code data (bit count, extra bits required, symbol),\n everywhere the reversed code would appear in the decoder array;\n set the code data in the encoder array as well}\n if (Symbol >= aExtraOffset) then begin\n if (FUsage <> huEncoding) then\n CodeData := Symbol + { symbol}\n (CodeLen shl 16) + { code length}\n (aExtraBits[Symbol-aExtraOffset] shl 24);\n { extra bits required}\n if (FUsage <> huDecoding) then\n Encodes^[Symbol] := Code + { code}\n (CodeLen shl 16) + { code length}\n (aExtraBits[Symbol-aExtraOffset] shl 24)\n { extra bits required}\n end\n else begin\n if (FUsage <> huEncoding) then\n CodeData := Symbol + { symbol}\n (CodeLen shl 16); { code length}\n if (FUsage <> huDecoding) then\n Encodes^[Symbol] := Code + { code}\n (CodeLen shl 16); { code length}\n end;\n\n {OPTIMIZATION NOTE: the following code\n\n CodeIncr := PowerOfTwo[CodeLen];\n while Code < DecoderLen do begin\n Decodes^[Code] := CodeData;\n inc(Code, CodeIncr);\n end;\n\n was replaced by the asm code below to improve the speed. The\n code in the loop is the big time sink in this routine so it was\n best to replace it.}\n if (FUsage <> huEncoding) then begin\n {$IFDEF CPU386}\n CodeIncr := PowerOfTwo[CodeLen] * sizeof(longint);\n asm\n push edi { save edi}\n mov eax, Decodes { get the Decodes array}\n mov edi, DecodesEnd { get the end of the Decodes array}\n mov edx, Code { get Code and..}\n shl edx, 1 { ..multiply by 4}\n shl edx, 1\n add eax, edx { eax => first element to be set}\n mov edx, CodeData { get the CodeData}\n mov ecx, CodeIncr { get the increment per loop}\n @@1:\n mov [eax], edx { set the element}\n add eax, ecx { move to the next element}\n cmp eax, edi { if we haven't gone past the end..}\n jl @@1 { ..go back for the next one}\n pop edi { retrieve edi}\n end;\n {$ELSE}\n CodeIncr := PowerOfTwo[CodeLen];\n while Code < DecoderLen do begin\n Decodes^[Code] := CodeData;\n inc(Code, CodeIncr);\n end;\n {$ENDIF}\n end;\n\n {we've used this code up for this symbol, so increment for the\n next symbol at this code length}\n inc(NextCode[CodeLen]);\n end;\n end;\nend;\n{--------}\n{$IFDEF UseLogging}\nprocedure TAbDfDecodeHuffmanTree.DebugPrint(aLog : TAbLogger);\n{$IFDEF EnableMegaLog}\nvar\n i : integer;\n Code : longint;\n{$ENDIF}\nbegin\n {to print the huffman tree, we must have a logger...}\n Assert(aLog <> nil,\n 'TAbDfDecodeHuffmanTree.DebugPrint needs a logger object to which to print');\n\n if (FUsage <> huEncoding) then begin\n aLog.WriteLine('Huffman decoder array');\n aLog.WriteLine(Format('Alphabet size: %d', [FAlphaSize]));\n aLog.WriteLine(Format('Max codelength: %d', [FMaxCodeLen]));\n\n {$IFDEF EnableMegaLog}\n aLog.WriteLine('Index Len Xtra Symbol Reversed Code');\n for i := 0 to pred(PowerOfTwo[FMaxCodeLen]) do begin\n Code := FDecodes^[i];\n if (Code = -1) then\n aLog.WriteLine(Format('%5d%49s', [i, 'no code']))\n else\n aLog.WriteLine(Format('%5d%4d%5d%7d%33s',\n [i,\n ((Code shr 16) and $FF),\n ((Code shr 24) and $FF),\n (Code and $FFFF),\n CodeToStr(i, ((Code shr 16) and $FF))]));\n end;\n aLog.WriteLine('---end decoder array---');\n {$ENDIF}\n end;\n\n if (FUsage <> huDecoding) then begin\n aLog.WriteLine('Huffman encoder array');\n aLog.WriteLine(Format('Alphabet size: %d', [FAlphaSize]));\n\n {$IFDEF EnableMegaLog}\n aLog.WriteLine('Symbol Len Xtra Reversed Code');\n for i := 0 to pred(FAlphaSize) do begin\n Code := FEncodes^[i];\n if (Code = -1) then\n aLog.WriteLine(Format('%6d%42s', [i, 'no code']))\n else\n aLog.WriteLine(Format('%6d%4d%5d%33s',\n [i,\n ((Code shr 16) and $FF),\n ((Code shr 24) and $FF),\n CodeToStr((Code and $FFFF), ((Code shr 16) and $FF))]));\n end;\n aLog.WriteLine('---end encoder array---');\n {$ENDIF}\n end;\nend;\n{$ENDIF}\n{--------}\nfunction TAbDfDecodeHuffmanTree.Decode(aLookupBits : integer) : longint;\nbegin\n {protect against dumb programming mistakes (note: FMask only exists\n if assertions are on)}\n {$IFOPT C+}\n Assert((aLookupBits and FMask) = 0,\n 'TAbDfDecodeHuffmanTree.Decode: trying to decode too many bits, use LookupBitLength property');\n {$ENDIF}\n\n {return the code data}\n Result := FDecodes^[aLookupBits];\nend;\n{--------}\nfunction TAbDfDecodeHuffmanTree.Encode(aSymbol : integer) : longint;\nbegin\n {protect against dumb programming mistakes}\n Assert((0 <= aSymbol) and (aSymbol < FAlphaSize),\n 'TAbDfDecodeHuffmanTree.Encode: trying to encode a symbol that is not in the alphabet');\n\n {return the code data}\n Result := FEncodes^[aSymbol];\n\n {if the result is -1, it's another programming mistake: the user is\n attempting to get a code for a symbol that wasn't being used}\n Assert(Result <> -1,\n 'TAbDfDecodeHuffmanTree.Encode: trying to encode a symbol that was not used');\nend;\n{====================================================================}\n\n\n{===BuildStaticTrees=================================================}\nprocedure BuildStaticTrees;\nvar\n i : integer;\n CodeLens : array [0..287] of integer;\nbegin\n {this routine builds the static huffman trees, those whose code\n lengths are determined by the deflate spec}\n\n {the static literal tree first}\n for i := 0 to 143 do\n CodeLens[i] := 8;\n for i := 144 to 255 do\n CodeLens[i] := 9;\n for i := 256 to 279 do\n CodeLens[i] := 7;\n for i := 280 to 287 do\n CodeLens[i] := 8;\n AbStaticLiteralTree := TAbDfDecodeHuffmanTree.Create(288, 15, huBoth);\n AbStaticLiteralTree.Build(CodeLens, 0, 288,\n dfc_LitExtraBits, dfc_LitExtraOffset);\n\n {the static distance tree afterwards}\n for i := 0 to 31 do\n CodeLens[i] := 5;\n AbStaticDistanceTree := TAbDfDecodeHuffmanTree.Create(32, 15, huBoth);\n AbStaticDistanceTree.Build(CodeLens, 0, 32,\n dfc_DistExtraBits, dfc_DistExtraOffset);\nend;\n{====================================================================}\n\ninitialization\n BuildStaticTrees;\n\nfinalization\n AbStaticLiteralTree.Free;\n AbStaticDistanceTree.Free;\n \nend.\n"
},
{
"path": "lib/abbrevia/source/AbDfInW.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfInW.pas *}\n{*********************************************************}\n{* Deflate input sliding window unit *}\n{*********************************************************}\n\nunit AbDfInW;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbDfBase;\n\n{Notes: TdfInputWindow implements a sliding window on data for the\n LZ77 dictionary encoding.\n\n The stream passed to the class is automatically read when\n required to keep the internal buffer fully loaded.\n }\n\ntype\n TAbDfMatch = record\n maLen : integer;\n maDist : integer;\n maLit : AnsiChar;\n end;\n\ntype\n PAbPointerList = ^TAbPointerList;\n TAbPointerList = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer;\n\n TAbDfInputWindow = class\n private\n FAdvanceStart : boolean;\n FBuffer : PAnsiChar;\n FBufferEnd : PAnsiChar;\n FBytesUsed : longint;\n FChainLen : integer;\n FHashChains : PAbPointerList;\n FHashHeads : PAbPointerList;\n FHashIndex : integer;\n FChecksum : longint;\n FCurrent : PAnsiChar;\n FLookAheadEnd : PAnsiChar;\n FMaxMatchLen : integer;\n FMustSlide : boolean;\n FOnProgress : TAbProgressStep;\n FSlidePoint : PAnsiChar;\n FStart : PAnsiChar;\n FStartOffset : longint;\n FStream : TStream;\n FStreamSize : Int64;\n FUseCRC32 : boolean;\n FUseDeflate64 : boolean;\n FWinMask : integer;\n FWinSize : integer;\n protected\n function iwGetChecksum : longint;\n procedure iwReadFromStream;\n procedure iwSetCapacity(aValue : longint);\n procedure iwSlide;\n public\n constructor Create(aStream : TStream;\n aStreamSize : Int64;\n aWinSize : integer;\n aChainLength : integer;\n aUseDeflate64 : boolean;\n aUseCRC32 : boolean);\n destructor Destroy; override;\n\n procedure Advance(aCount : integer;\n aHashCount : integer);\n procedure AdvanceByOne;\n function FindLongestMatch(aAmpleLength : integer;\n var aMatch : TAbDfMatch;\n const aPrevMatch : TAbDfMatch) : boolean;\n function GetNextChar : AnsiChar;\n function GetNextKeyLength : integer;\n function Position : longint;\n procedure ReadBuffer(var aBuffer; aCount : longint;\n aOffset : Int64);\n\n property ChainLen : integer read FChainLen write FChainLen;\n property Checksum : longint read iwGetChecksum;\n property OnProgress : TAbProgressStep\n read FOnProgress write FOnProgress;\n end;\n\nimplementation\n\nuses\n SysUtils;\n\n{Notes:\n Meaning of the internal pointers:\n\n |----------+===================+==+--------------------------|\n | | | | |\n FBuffer FStart FCurrent FLookAheadEnd FBufferEnd\n\n FCurrent is the current match position. The valid data that\n can be matched is between FStart and FLookAheadEnd, The data\n between FStart and FCurrent has already been seen; the data\n between FCurrent and FLookAheadEnd can be used for matching.\n\n The buffer size depends on the requested window size (a\n multiple of 1KB, up to 32KB for deflate, up to 64KB for\n deflate64) and the lookahead size (up to 258 bytes for deflate\n and 64KB for deflate64.)\n\n The window of data continuously slides to the right, and is\n slid back to FBuffer whenever FStart reaches a point 16KB\n away, this point being given by FSlidePoint.\n\n\n The hash table:\n This is a chained hash table with some peculiarities. First\n the table itself, FHashHeads. It contains pointers to strings\n in the window buffer, not to chains. The chains are held is a\n separate structure, FHashChains. The hash function on the\n three-character keys is a Rabin-Karp function:\n ((((Ch1 shl 5) xor Ch2) shl 5) xor Ch3) and $3FFF\n designed so that a running hash value can be kept and\n calculated per character. The hash table is $4000 elements\n long (obviously, given the hash function).\n On insertion, the previous pointer in the hash table at the\n calculated index is saved and replaced by the new pointer. The\n old pointer is saved in the chains array. This has the same\n number of elements as the sliding window has characters. The\n pointer is placed at (Ptr and (WindowsSize-1)) overwriting the\n value that's already there. In this fashion the individual\n chains in the standard hash table are interwoven with each\n other in this hash table, like a skein of threads.\n }\n\nconst\n c_HashCount = $4000; {the number of hash entries}\n c_HashMask = c_HashCount - 1; {a mask for the hash function}\n c_HashShift = 5; {shift value for the hash function}\n\n{===TAbDfInputWindow=================================================}\nconstructor TAbDfInputWindow.Create(aStream : TStream;\n aStreamSize : Int64;\n aWinSize : integer;\n aChainLength : integer;\n aUseDeflate64 : boolean;\n aUseCRC32 : boolean);\nbegin\n {create the ancestor}\n inherited Create;\n\n {save parameters}\n FStreamSize := aStreamSize;\n FWinSize := aWinSize;\n FWinMask := aWinSize - 1;\n FStream := aStream;\n FChainLen := aChainLength;\n FUseDeflate64 := aUseDeflate64;\n FUseCRC32 := aUseCRC32;\n if aUseCRC32 then\n FChecksum := -1 { CRC32 starts off with all bits set }\n else\n FCheckSum := 1; { Adler32 starts off with a value of 1 }\n\n {set capacity of sliding window}\n iwSetCapacity(aWinSize);\n\n {create the hash table, first the hash table itself (and set all\n entries to nil)}\n FHashHeads := AllocMem(c_HashCount * sizeof(pointer));\n\n {..now the chains (there's no need to set the entries to nil, since\n the chain entries get fed from the head entries before searching)}\n GetMem(FHashChains, aWinSize * sizeof(pointer));\n\n {read the first chunk of data from the stream}\n FMustSlide := true;\n iwReadFromStream;\n\n {if there are at least two bytes, prime the hash index}\n if ((FLookAheadEnd - FBuffer) >= 2) then \n FHashIndex := ((longint(FBuffer[0]) shl c_HashShift) xor\n longint(FBuffer[1])) and\n c_HashMask;\nend;\n{--------}\ndestructor TAbDfInputWindow.Destroy;\nbegin\n {free the hash table}\n FreeMem(FHashHeads);\n FreeMem(FHashChains);\n\n {free the buffer}\n FreeMem(FBuffer);\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nprocedure TAbDfInputWindow.Advance(aCount : integer;\n aHashCount : integer);\nvar\n i : integer;\n ByteCount : integer;\n Percent : integer;\n HashChains: PAbPointerList;\n HashHeads : PAbPointerList;\n HashInx : integer;\n CurPos : PAnsiChar;\nbegin\n Assert((FLookAheadEnd - FCurrent) >= aCount,\n 'TAbDfInputWindow.Advance: seem to be advancing into the unknown');\n Assert((aHashCount = aCount) or (aHashCount = pred(aCount)),\n 'TAbDfInputWindow.Advance: the parameters are plain wrong');\n {use local var for speed}\n CurPos := FCurrent;\n\n {advance the current pointer if needed}\n if (aCount > aHashCount) then\n inc(CurPos);\n\n {make sure we update the hash table; remember that the string[3] at\n the current position has already been added to the hash table (for\n notes on updating the hash table, see FindLongestMatch}\n\n {use local vars for speed}\n HashChains := FHashChains;\n HashHeads := FHashHeads;\n HashInx := FHashIndex;\n\n {update the hash table}\n for i := 0 to pred(aHashCount) do begin\n HashInx :=\n ((HashInx shl c_HashShift) xor longint(CurPos[2])) and\n c_HashMask;\n HashChains^[longint(CurPos) and FWinMask] :=\n HashHeads^[HashInx];\n HashHeads^[HashInx] := CurPos;\n inc(CurPos);\n end;\n\n {replace old values}\n FHashChains := HashChains;\n FHashHeads := HashHeads;\n FHashIndex := HashInx;\n FCurrent := CurPos;\n\n {if we've seen at least FWinSize bytes...}\n if FAdvanceStart then begin\n\n {advance the start of the sliding window}\n inc(FStart, aCount);\n inc(FStartOffset, aCount);\n\n {check to see if we have advanced into the slide zone}\n if FMustSlide and (FStart >= FSlidePoint) then\n iwSlide;\n end\n\n {otherwise check to see if we've seen at least FWinSize bytes}\n else if ((CurPos - FStart) >= FWinSize) then begin\n FAdvanceStart := true;\n {note: we can't advance automatically aCount bytes here, we need\n to calculate the actual count}\n ByteCount := (CurPos - FWinSize) - FStart;\n inc(FStart, ByteCount);\n inc(FStartOffset, ByteCount);\n end;\n\n {show progress}\n if Assigned(FOnProgress) then begin\n inc(FBytesUsed, aCount);\n if ((FBytesUsed and $FFF) = 0) then begin\n Percent := Round((100.0 * FBytesUsed) / FStreamSize);\n FOnProgress(Percent);\n end;\n end;\n\n {check to see if we have advanced into the slide zone}\n if (FStart >= FSlidePoint) then\n iwSlide;\nend;\n{--------}\nprocedure TAbDfInputWindow.AdvanceByOne;\nvar\n Percent : integer;\nbegin\n {advance the current pointer}\n inc(FCurrent);\n\n {if we've seen at least FWinSize bytes...}\n if FAdvanceStart then begin\n\n {advance the start of the sliding window}\n inc(FStart, 1);\n inc(FStartOffset, 1);\n\n {check to see if we have advanced into the slide zone}\n if FMustSlide and (FStart >= FSlidePoint) then\n iwSlide;\n end\n\n {otherwise check to see if we've seen FWinSize bytes}\n else if ((FCurrent - FStart) = FWinSize) then\n FAdvanceStart := true;\n\n {show progress}\n if Assigned(FOnProgress) then begin\n inc(FBytesUsed, 1);\n if ((FBytesUsed and $FFF) = 0) then begin\n Percent := Round((100.0 * FBytesUsed) / FStreamSize);\n FOnProgress(Percent);\n end;\n end;\nend;\n{--------}\nfunction TAbDfInputWindow.FindLongestMatch(aAmpleLength : integer;\n var aMatch : TAbDfMatch;\n const aPrevMatch : TAbDfMatch)\n : boolean;\n{Note: this routine implements a greedy algorithm and is by far the\n time sink for compression. There are two versions, one written\n in Pascal for understanding, one in assembler for speed.\n Activate one and only one of the following compiler defines.}\n{$IFDEF CPU386}\n {$DEFINE UseGreedyAsm}\n{$ELSE}\n {$DEFINE UseGreedyPascal}\n{$ENDIF}\n\n{Check to see that all is correct}\n{$IFDEF UseGreedyAsm}\n {$IFDEF UseGreedyPascal}\n !! Compile Error: only one of the greedy compiler defines can be used\n {$ENDIF}\n{$ELSE}\n {$IFNDEF UseGreedyPascal}\n !! Compile Error: one of the greedy compiler defines must be used\n {$ENDIF}\n{$ENDIF}\ntype\n PLongint = ^longint;\n PWord = ^word;\nvar\n MaxLen : longint;\n MaxDist : longint;\n MaxMatch : integer;\n ChainLen : integer;\n PrevStrPos : PAnsiChar;\n CurPos : PAnsiChar;\n {$IFDEF UseGreedyAsm}\n CurWord : word;\n MaxWord : word;\n {$ENDIF}\n {$IFDEF UseGreedyPascal}\n Len : longint;\n MatchStr : PAnsiChar;\n CurrentCh : PAnsiChar;\n CurCh : AnsiChar;\n MaxCh : AnsiChar;\n {$ENDIF}\nbegin\n {calculate the hash index for the current position; using the\n Rabin-Karp algorithm this is equal to the previous index less the\n effect of the character just lost plus the effect of the character\n just gained}\n CurPos := FCurrent;\n FHashIndex :=\n ((FHashIndex shl c_HashShift) xor longint(CurPos[2])) and\n c_HashMask;\n\n {get the head of the hash chain: this is the position in the sliding\n window of the previous 3-character string with this hash value}\n PrevStrPos := FHashHeads^[FHashIndex];\n\n {set the head of the hash chain equal to our current position}\n FHashHeads^[FHashIndex] := CurPos;\n\n {update the chain itself: set the entry for this position equal to\n the previous string position}\n FHashChains^[longint(CurPos) and FWinMask] := PrevStrPos;\n\n {calculate the maximum match we could do at this position}\n MaxMatch := (FLookAheadEnd - CurPos);\n if (MaxMatch > FMaxMatchLen) then\n MaxMatch := FMaxMatchLen;\n if (aAmpleLength > MaxMatch) then\n aAmpleLength := MaxMatch;\n\n {calculate the current match length}\n if (aPrevMatch.maLen = 0) then\n MaxLen := 2\n else begin\n if (MaxMatch < aPrevMatch.maLen) then begin\n Result := false;\n aMatch.maLen := 0;\n aMatch.maLit := CurPos^;\n Exit;\n end;\n MaxLen := aPrevMatch.maLen;\n end;\n\n {get the bytes at the current position and at the end of the maximum\n match we have to better}\n {$IFDEF UseGreedyAsm}\n CurWord := PWord(CurPos)^;\n MaxWord := PWord(CurPos + pred(MaxLen))^;\n {$ENDIF}\n {$IFDEF UseGreedyPascal}\n CurCh := CurPos^;\n MaxCh := (CurPos + pred(MaxLen))^;\n {$ENDIF}\n\n {set the chain length to search based on the current maximum match\n (basically: if we've already satisfied the ample length\n requirement, don't search as far)}\n if (MaxLen >= aAmpleLength) then\n ChainLen := FChainLen div 4\n else\n ChainLen := FChainLen;\n\n {get ready for the loop}\n {$IFDEF DefeatWarnings}\n MaxDist := 0;\n {$ENDIF}\n\n {$IFDEF UseGreedyAsm} { slip into assembler for speed...}\n asm\n push ebx { save those registers we should}\n push esi\n push edi\n\n mov ebx, Self { ebx will store the Self pointer}\n mov edi, PrevStrPos { edi => previous string}\n mov esi, CurPos { esi => current string}\n\n @@TestThisPosition:\n { check previous string is in range}\n or edi, edi\n je @@Exit\n cmp edi, [ebx].TAbDfInputWindow.FStart\n jb @@Exit\n cmp edi, CurPos\n jae @@Exit\n\n mov ax, [edi] { check previous string starts with same}\n cmp CurWord, ax { two bytes as current}\n jne @@GetNextPosition { ..nope, they don't match}\n\n mov edx, edi { check previous string ends with same}\n add edi, MaxLen { two bytes as current (by \"ends\" we}\n dec edi { mean the last two bytes at the}\n mov ax, [edi] { current match length)}\n cmp MaxWord, ax\n mov edi, edx\n jne @@GetNextPosition { ..nope, they don't match}\n\n push edi { compare the previous string with the}\n push esi { current string}\n mov eax, MaxMatch\n add edi, 2 { (we've already checked that the first}\n sub eax, 2 { two characters are the same)}\n add esi, 2\n mov ecx, eax\n\n @@CmpQuads:\n cmp ecx, 4\n jb @@CmpSingles\n\n mov edx, [esi]\n cmp edx, [edi]\n jne @@CmpSingles\n\n add esi, 4\n add edi, 4\n sub ecx, 4\n jnz @@CmpQuads\n\n jmp @@MatchCheck\n\n @@CmpSingles:\n or ecx, ecx\n jb @@MatchCheck\n\n mov dl, [esi]\n cmp dl, [edi]\n jne @@MatchCheck\n\n inc esi\n inc edi\n dec ecx\n jnz @@CmpSingles\n\n @@MatchCheck:\n sub eax, ecx\n add eax, 2\n pop esi\n pop edi\n\n cmp eax, MaxLen { have we found a longer match?}\n jbe @@GetNextPosition { ..no}\n mov MaxLen, eax { ..yes, so save it}\n\n mov eax, esi { calculate the dist for this new match}\n sub eax, edi\n mov MaxDist, eax\n\n cmp eax, aAmpleLength { if this match is ample enough, exit}\n jae @@Exit\n\n mov eax, esi { calculate the two bytes at the end of}\n add eax, MaxLen { this new match}\n dec eax\n mov ax, [eax]\n mov MaxWord, ax\n\n @@GetNextPosition:\n mov eax, ChainLen { we've visited one more link on the}\n dec eax { chain, if that's the last one we}\n je @@Exit { should visit, exit}\n mov ChainLen, eax\n\n { advance along the chain}\n mov edx, [ebx].TAbDfInputWindow.FHashChains\n mov eax, [ebx].TAbDfInputWindow.FWinMask\n and edi, eax\n shl edi, 2\n mov edi, [edx+edi]\n jmp @@TestThisPosition\n\n @@Exit:\n pop edi\n pop esi\n pop ebx\n end;\n {$ENDIF}\n\n {$IFDEF UseGreedyPascal}\n {for all possible hash nodes in the chain...}\n while (FStart <= PrevStrPos) and (PrevStrPos < CurPos) do begin\n\n {if the initial and maximal characters match...}\n if (PrevStrPos[0] = CurCh) and\n (PrevStrPos[pred(MaxLen)] = MaxCh) then begin\n\n {compare more characters}\n Len := 1;\n CurrentCh := CurPos + 1;\n MatchStr := PrevStrPos + 1;\n\n {compare away, but don't go above the maximum length}\n while (Len < MaxMatch) and (MatchStr^ = CurrentCh^) do begin\n inc(CurrentCh);\n inc(MatchStr);\n inc(Len);\n end;\n\n {have we reached another maximum for the length?}\n if (Len > MaxLen) then begin\n MaxLen := Len;\n {calculate the distance}\n MaxDist := CurPos - PrevStrPos;\n MaxCh := CurPos[pred(MaxLen)];\n\n {is the new best length ample enough?}\n if MaxLen >= aAmpleLength then\n Break;\n end;\n end;\n\n {have we reached the end of this chain?}\n dec(ChainLen);\n if (ChainLen = 0) then\n Break;\n\n {otherwise move onto the next position}\n PrevStrPos := FHashChains^[longint(PrevStrPos) and FWinMask];\n end;\n {$ENDIF}\n\n {based on the results of our investigation, return the match values}\n if (MaxLen < 3) or (MaxLen <= aPrevMatch.maLen) then begin\n Result := false;\n aMatch.maLen := 0;\n aMatch.maLit := CurPos^;\n end\n else begin\n Result := true;\n aMatch.maLen := MaxLen;\n aMatch.maDist := MaxDist;\n aMatch.maLit := CurPos^; { just in case...}\n end;\nend;\n{--------}\nfunction TAbDfInputWindow.GetNextChar : AnsiChar;\nbegin\n Result := FCurrent^;\n inc(FCurrent);\nend;\n{--------}\nfunction TAbDfInputWindow.GetNextKeyLength : integer;\nbegin\n Result := FLookAheadEnd - FCurrent;\n if (Result > 3) then\n Result := 3;\nend;\n{--------}\nfunction TAbDfInputWindow.iwGetChecksum : longint;\nbegin\n {the CRC32 checksum algorithm requires a post-conditioning step\n after being calculated (the result is NOTted), whereas Adler32 does\n not}\n if FUseCRC32 then\n Result := not FChecksum\n else\n Result := FChecksum;\nend;\n{--------}\nprocedure TAbDfInputWindow.iwReadFromStream;\nvar\n BytesRead : longint;\n BytesToRead : longint;\nbegin\n {read some more data into the look ahead zone}\n BytesToRead := FBufferEnd - FLookAheadEnd;\n BytesRead := FStream.Read(FLookAheadEnd^, BytesToRead);\n\n {if nothing was read, we reached the end of the stream; hence\n there's no more need to slide the window since we have all the\n data}\n if (BytesRead = 0) then\n FMustSlide := false\n\n {otherwise something was actually read...}\n else begin\n {update the checksum}\n if FUseCRC32 then\n AbUpdateCRCBuffer(FChecksum, FLookAheadEnd^, BytesRead)\n else\n AbUpdateAdlerBuffer(FChecksum, FLookAheadEnd^, BytesRead);\n\n {reposition the pointer for the end of the lookahead area}\n inc(FLookAheadEnd, BytesRead);\n end;\nend;\n{--------}\nprocedure TAbDfInputWindow.iwSetCapacity(aValue : longint);\nvar\n ActualSize : integer;\nbegin\n {calculate the actual size; this will be the value passed in, plus\n the correct look ahead size, plus 16KB}\n ActualSize := aValue + (16 * 1024);\n if FUseDeflate64 then begin\n inc(ActualSize, dfc_MaxMatchLen64);\n FMaxMatchLen := dfc_MaxMatchLen64;\n end\n else begin\n inc(ActualSize, dfc_MaxMatchLen);\n FMaxMatchLen := dfc_MaxMatchLen;\n end;\n\n {get the new buffer}\n GetMem(FBuffer, ActualSize);\n\n {set the other buffer pointers}\n FStart := FBuffer;\n FCurrent := FBuffer;\n FLookAheadEnd := FBuffer;\n FBufferEnd := FBuffer + ActualSize;\n FSlidePoint := FBuffer + (16 * 1024);\nend;\n{--------}\nprocedure TAbDfInputWindow.iwSlide;\ntype\n PLongint = ^longint;\nvar\n i : integer;\n ByteCount : integer;\n Buffer : longint;\n ListItem : PLongint;\nbegin\n {move current valid data back to the start of the buffer}\n ByteCount := FLookAheadEnd - FStart;\n Move(FStart^, FBuffer^, ByteCount);\n\n {reset the various pointers}\n ByteCount := FStart - FBuffer;\n FStart := FBuffer;\n dec(FCurrent, ByteCount);\n dec(FLookAheadEnd, ByteCount);\n\n {patch up the hash table: the head pointers}\n Buffer := longint(FBuffer);\n ListItem := PLongint(@FHashHeads^[0]);\n for i := 0 to pred(c_HashCount) do begin\n dec(ListItem^, ByteCount);\n if (ListItem^ < Buffer) then\n ListItem^ := 0;\n inc(PAnsiChar(ListItem), sizeof(pointer));\n end;\n\n {..the chain pointers}\n ListItem := PLongint(@FHashChains^[0]);\n for i := 0 to pred(FWinSize) do begin\n dec(ListItem^, ByteCount);\n if (ListItem^ < Buffer) then\n ListItem^ := 0;\n inc(PAnsiChar(ListItem), sizeof(pointer));\n end;\n\n {now read some more data from the stream}\n iwReadFromStream;\nend;\n{--------}\nfunction TAbDfInputWindow.Position : longint;\nbegin\n Result := (FCurrent - FStart) + FStartOffset;\nend;\n{--------}\nprocedure TAbDfInputWindow.ReadBuffer(var aBuffer; aCount : longint;\n aOffset : Int64);\nvar\n CurPos : Int64; \nbegin\n CurPos := FStream.Seek(0, soCurrent);\n FStream.Seek(aOffSet, soBeginning);\n FStream.ReadBuffer(aBuffer, aCount);\n FStream.Seek(CurPos, soBeginning);\nend;\n{====================================================================}\n\nend.\n\n\n\n"
},
{
"path": "lib/abbrevia/source/AbDfOutW.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfOutW.pas *}\n{*********************************************************}\n{* Deflate output sliding window *}\n{*********************************************************}\n\nunit AbDfOutW;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbDfBase;\n\n{Notes: TAbDfOutputWindow implements a sliding window on previously\n written data for the LZ77 dictionary decoding.\n\n AddLiteral will add a literal character at the current\n position and advance by one. AddLenDist will copy the required\n number of characters from the given position to the current\n position, and advance the stream on by the length. The class\n will periodically update the stream from the internal buffer.\n\n For normal Deflate, the internal buffer is 48K + 512 bytes in\n size. Once there is 48Kb worth of data, 16KB is written to\n file, and the buffer is shifted left by 16KB. We need to keep\n the last decoded 32KB in memory at all times.\n\n For Deflate64, the internal buffer is 96K + 512 bytes in\n size. Once there is 96Kb worth of data, 32KB is written to\n file, and the buffer is shifted left by 32KB. We need to keep\n the last decoded 64KB in memory at all times.\n }\n\ntype\n TAbDfOutputWindow = class\n private\n FBuffer : PAnsiChar;\n FChecksum : longint;\n FCurrent : PAnsiChar;\n FLog : TAbLogger;\n FPartSize : longint;\n FSlideCount : integer;\n FStream : TStream;\n FStreamPos : longint;\n FTestOnly : boolean;\n FUseCRC32 : boolean;\n FWritePoint : PAnsiChar;\n protected\n function swGetChecksum : longint;\n procedure swWriteToStream(aFlush : boolean);\n public\n constructor Create(aStream : TStream;\n aUseDeflate64 : boolean;\n aUseCRC32 : boolean;\n aPartSize : longint;\n aTestOnly : boolean;\n aLog : TAbLogger);\n destructor Destroy; override;\n\n procedure AddBuffer(var aBuffer; aCount : integer);\n procedure AddLiteral(aCh : AnsiChar);\n procedure AddLenDist(aLen : integer; aDist : integer);\n function Position : longint;\n\n property Checksum : longint read swGetChecksum;\n property Log : TAbLogger read FLog;\n end;\n\nimplementation\n\nuses\n SysUtils;\n\n{Notes:\n Meaning of the internal pointers:\n\n |==============================+------------------------+----|\n | | |\n FBuffer FCurrent FWritePoint\n\n Once FCurrent reaches or exceeds FWritePoint, FSlideCount\n bytes of data from FBuffer are written to the stream and the\n remaining data is moved back FSlideCount bytes, moving\n FCurrent along with it as well.\n }\n\n{===TAbDfOutputWindow==================================================}\nconstructor TAbDfOutputWindow.Create(aStream : TStream;\n aUseDeflate64 : boolean;\n aUseCRC32 : boolean;\n aPartSize : longint;\n aTestOnly : boolean;\n aLog : TAbLogger);\nvar\n Size : integer;\n LookAheadSize : integer;\nbegin\n {allow the ancestor to initialize}\n inherited Create;\n\n {save parameters}\n FLog := aLog;\n FStream := aStream;\n FTestOnly := aTestOnly;\n if (aPartSize <= 0) then\n FPartSize := 0\n else\n FPartSize := aPartSize;\n FUseCRC32 := aUseCRC32;\n if aUseCRC32 then\n FChecksum := -1 { CRC32 starts off with all bits set}\n else\n FCheckSum := 1; { Adler32 starts off with a value of 1}\n\n {set capacity of sliding window}\n if aUseDeflate64 then begin\n Size := 96 * 1024;\n FSlideCount := 32 * 1024;\n LookAheadSize := 64 * 1024;\n end\n else begin\n Size := 64 * 1024;\n FSlideCount := 32 * 1024;\n LookAheadSize := 258;\n end;\n GetMem(FBuffer, Size + LookAheadSize);\n\n {set the other internal pointers}\n FCurrent := FBuffer;\n FWritePoint := FBuffer + Size;\n if (FPartSize > Size) then\n FPartSize := Size;\nend;\n{--------}\ndestructor TAbDfOutputWindow.Destroy;\nbegin\n {write remaining data and free the buffer}\n if (FBuffer <> nil) then begin\n if (FCurrent <> FBuffer) then\n swWriteToStream(true);\n FreeMem(FBuffer);\n end;\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nprocedure TAbDfOutputWindow.AddBuffer(var aBuffer; aCount : integer);\nvar\n Buffer : PAnsiChar;\n BytesToWrite : integer;\nbegin\n {if we've advanced to the point when we need to write, do so}\n if (FCurrent >= FWritePoint) then\n swWriteToStream(false);\n\n {cast the user buffer to a PChar, it's easier to use}\n Buffer := @aBuffer;\n\n {calculate the number of bytes to copy}\n BytesToWrite := FWritePoint - FCurrent;\n if (BytesToWrite > aCount) then\n BytesToWrite := aCount;\n\n {move this block of bytes}\n Move(Buffer^, FCurrent^, BytesToWrite);\n\n {advance pointers and counters}\n inc(FCurrent, BytesToWrite);\n dec(aCount, BytesToWrite);\n\n {while there is still data to copy...}\n while (aCount > 0) do begin\n {advance the user buffer pointer}\n inc(Buffer, BytesToWrite);\n\n {write the sliding window chunk to the stream}\n swWriteToStream(false);\n\n {calculate the number of bytes to copy}\n BytesToWrite := FWritePoint - FCurrent;\n if (BytesToWrite > aCount) then\n BytesToWrite := aCount;\n\n {move this block of bytes}\n Move(Buffer^, FCurrent^, BytesToWrite);\n\n {advance pointers and counters}\n inc(FCurrent, BytesToWrite);\n dec(aCount, BytesToWrite);\n end;\nend;\n{--------}\nprocedure AddLenDistToLog(aLog : TAbLogger;\n aPosn : longint;\n aLen : integer;\n aDist : integer;\n aOverLap : boolean);\nbegin\n {NOTE the reason for this separate routine is to avoid string\n allocations and try..finally blocks in the main method: an\n optimization issue}\n if aOverLap then\n aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d **overlap**',\n [aPosn, aLen, aDist]))\n else\n aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d',\n [aPosn, aLen, aDist]));\nend;\n{--------}\nprocedure TAbDfOutputWindow.AddLenDist(aLen : integer; aDist : integer);\nvar\n i : integer;\n ToChar : PAnsiChar;\n FromChar : PAnsiChar;\nbegin\n {log it}\n {$IFDEF UseLogging}\n if (FLog <> nil) then\n AddLenDistToLog(FLog, Position, aLen, aDist, (aLen > aDist));\n {$ENDIF}\n\n {if the length to copy is less than the distance, just do a move}\n if (aLen <= aDist) then begin\n Move((FCurrent - aDist)^ , FCurrent^, aLen);\n end\n\n {otherwise we have to use a byte-by-byte copy}\n else begin\n FromChar := FCurrent - aDist;\n ToChar := FCurrent;\n for i := 1 to aLen do begin\n ToChar^ := FromChar^;\n inc(FromChar);\n inc(ToChar);\n end;\n end;\n\n {increment the current pointer}\n inc(FCurrent, aLen);\n\n {if we've reached the point requested, abort}\n if (FPartSize > 0) and ((FCurrent - FBuffer) >= FPartSize) then\n raise EAbPartSizedInflate.Create(''); {NOTE: This exception is expected during detection of .GZ and .TGZ files. (VerifyGZip)}\n\n {if we've advanced to the point when we need to write, do so}\n if (FCurrent >= FWritePoint) then\n swWriteToStream(false);\nend;\n{--------}\nprocedure AddLiteralToLog(aLog : TAbLogger;\n aPosn : longint;\n aCh : AnsiChar);\nbegin\n {NOTE the reason for this separate routine is to avoid string\n allocations and try..finally blocks in the main method: an\n optimization issue}\n if (' ' < aCh) and (aCh <= '~') then\n aLog.WriteLine(Format('%8x Char: %3d $%2x [%s]', [aPosn, ord(aCh), ord(aCh), aCh]))\n else\n aLog.WriteLine(Format('%8x Char: %3d $%2x', [aPosn, ord(aCh), ord(aCh)]));\nend;\n{--------}\nprocedure TAbDfOutputWindow.AddLiteral(aCh : AnsiChar);\nbegin\n {log it}\n {$IFDEF UseLogging}\n if (FLog <> nil) then\n AddLiteralToLog(FLog, Position, aCh);\n {$ENDIF}\n\n {add the literal to the buffer}\n FCurrent^ := aCh;\n\n {increment the current pointer}\n inc(FCurrent);\n\n {if we've reached the point requested, abort}\n if (FPartSize > 0) and ((FCurrent - FBuffer) >= FPartSize) then\n raise EAbPartSizedInflate.Create('');\n\n {if we've advanced to the point when we need to write, do so}\n if (FCurrent >= FWritePoint) then\n swWriteToStream(false);\nend;\n{--------}\nfunction TAbDfOutputWindow.Position : longint;\nbegin\n if FTestOnly then\n Result := FStreamPos + (FCurrent - FBuffer)\n else\n Result := FStream.Position + (FCurrent - FBuffer);\nend;\n{--------}\nfunction TAbDfOutputWindow.swGetChecksum : longint;\nbegin\n {since the checksum is calculated by the method that flushes to the\n stream, make sure any buffered data is written out first}\n if (FCurrent <> FBuffer) then\n swWriteToStream(true);\n\n {the CRC32 checksum algorithm requires a post-conditioning step\n after being calculated (the result is NOTted), whereas Adler32 does\n not}\n if FUseCRC32 then\n Result := not FChecksum\n else\n Result := FChecksum;\nend;\n{--------}\nprocedure TAbDfOutputWindow.swWriteToStream(aFlush : boolean);\nvar\n FromPtr : PAnsiChar;\nbegin\n {if the request was to flush, write all remaining data after\n updating the checksum}\n if aFlush then begin\n if FUseCRC32 then\n AbUpdateCRCBuffer(FChecksum, FBuffer^, FCurrent - FBuffer)\n else\n AbUpdateAdlerBuffer(FChecksum, FBuffer^, FCurrent - FBuffer);\n if FTestOnly then\n inc(FStreamPos, FCurrent - FBuffer)\n else\n FStream.WriteBuffer(FBuffer^, FCurrent - FBuffer);\n FCurrent := FBuffer;\n end\n\n {otherwise, update the checksum with the data in the sliding window\n chunk, write it out to the stream, and move the rest of the buffer\n back}\n else begin\n if FUseCRC32 then\n AbUpdateCRCBuffer(FChecksum, FBuffer^, FSlideCount)\n else\n AbUpdateAdlerBuffer(FChecksum, FBuffer^, FSlideCount);\n if FTestOnly then\n inc(FStreamPos, FSlideCount)\n else\n FStream.WriteBuffer(FBuffer^, FSlideCount);\n FromPtr := FBuffer + FSlideCount;\n Move(FromPtr^, FBuffer^, FCurrent - FromPtr);\n FCurrent := FCurrent - FSlideCount;\n end;\nend;\n{====================================================================}\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbDfPkMg.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfPkMg.pas *}\n{*********************************************************}\n{* Deflate package-merge algorithm *}\n{*********************************************************}\n\nunit AbDfPkMg;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n AbDfBase;\n\nprocedure GenerateCodeLengths(aMaxCodeLen : integer;\n const aWeights : array of integer;\n var aCodeLengths : array of integer;\n aStartInx : integer;\n aLog : TAbLogger);\n\nimplementation\n\ntype\n PPkgNode = ^TPkgNode;\n TPkgNode = packed record\n pnWeight : integer;\n pnCount : integer;\n pnLeft : PPkgNode;\n pnRight : PPkgNode;\n end;\n\n PPkgNodeList = ^TPkgNodeList;\n TPkgNodeList = array [0..pred(286 * 2)] of PPkgNode;\n {Note: the \"286\" is the number of literal/length symbols, the\n maximum number of weights we'll be calculating the optimal\n code lengths for}\n\n\n{===helper routines==================================================}\nfunction IsCalcFeasible(aCount : integer;\n aMaxCodeLen : integer) : boolean;\n\nbegin\n {works out if length-limited codes can be calculated for a given\n number of symbols and the maximum code length}\n\n {return whether 2^aMaxCodeLen > aCount}\n Result := (1 shl aMaxCodeLen) > aCount;\nend;\n{--------}\nprocedure QSS(aList : PPkgNodeList;\n aFirst : integer;\n aLast : integer);\nvar\n L, R : integer;\n Pivot : integer;\n Temp : pointer;\nbegin\n {while there are at least two items to sort}\n while (aFirst < aLast) do begin\n {the pivot is the middle item}\n Pivot := aList^[(aFirst+aLast) div 2]^.pnWeight;\n {set indexes and partition}\n L := pred(aFirst);\n R := succ(aLast);\n while true do begin\n repeat dec(R); until (aList^[R]^.pnWeight <= Pivot);\n repeat inc(L); until (aList^[L]^.pnWeight >= Pivot);\n if (L >= R) then Break;\n Temp := aList^[L];\n aList^[L] := aList^[R];\n aList^[R] := Temp;\n end;\n {quicksort the first subfile}\n if (aFirst < R) then\n QSS(aList, aFirst, R);\n {quicksort the second subfile - recursion removal}\n aFirst := succ(R);\n end;\nend;\n{--------}\nprocedure SortList(aList : PPkgNodeList; aCount : integer);\nbegin\n QSS(aList, 0, pred(aCount));\nend;\n{--------}\nprocedure Accumulate(aNode : PPkgNode);\nbegin\n while (aNode^.pnLeft <> nil) do begin\n Accumulate(aNode^.pnLeft);\n aNode := aNode^.pnRight;\n end;\n inc(aNode^.pnCount);\nend;\n{====================================================================}\n\n\n{===Interfaced routine===============================================}\nprocedure GenerateCodeLengths(aMaxCodeLen : integer;\n const aWeights : array of integer;\n var aCodeLengths : array of integer;\n aStartInx : integer;\n aLog : TAbLogger);\nvar\n i : integer;\n Bit : integer;\n WeightCount : integer;\n OrigList : PPkgNodeList;\n OrigListCount : integer;\n MergeList : PPkgNodeList;\n MergeListCount : integer;\n PkgList : PPkgNodeList;\n PkgListCount : integer;\n OrigInx : integer;\n PkgInx : integer;\n Node : PPkgNode;\n NodeMgr : TAbNodeManager;\nbegin\n {calculate the number of weights}\n WeightCount := succ(high(aWeights));\n\n {check for dumb programming errors}\n Assert((0 < aMaxCodeLen) and (aMaxCodeLen <= 15),\n 'GenerateCodeLengths: the maximum code length should be in the range 1..15');\n Assert((1 <= WeightCount) and (WeightCount <= 286),\n 'GenerateCodeLengths: the weight array must have 1..286 elements');\n Assert(IsCalcFeasible(WeightCount, aMaxCodeLen),\n 'GenerateCodeLengths: the package-merge algorithm should always be feasible');\n\n {clear the code lengths array}\n FillChar(aCodeLengths[aStartInx], WeightCount * sizeof(integer), 0);\n\n {prepare for the try..finally}\n OrigList := nil;\n MergeList := nil;\n PkgList := nil;\n NodeMgr := nil;\n try\n\n {create the node manager}\n NodeMgr := TAbNodeManager.Create(sizeof(TPkgNode));\n\n {create the original list of nodes}\n GetMem(OrigList, WeightCount * sizeof(PPkgNode));\n OrigListCount := 0;\n for i := 0 to pred(WeightCount) do\n if (aWeights[i] <> 0) then begin\n Node := NodeMgr.AllocNode;\n Node^.pnLeft := nil; { this will indicate a leaf}\n Node^.pnRight := pointer(i); { the index of the weight}\n Node^.pnWeight := aWeights[i]; { the weight itself}\n Node^.pnCount := 1; { how many times used}\n OrigList^[OrigListCount] := Node;\n inc(OrigListCount);\n end;\n\n {we need at least 2 items, so make anything less a special case}\n if (OrigListCount <= 1) then begin\n\n {if there are no items at all in the original list, we need to\n pretend that there is one, since we shall eventually need to\n calculate a Count-1 value that cannot be negative}\n if (OrigListCount = 0) then begin\n aCodeLengths[aStartInx] := 1;\n Exit;\n end;\n\n {otherwise there is only one item: set its code length directly}\n for i := 0 to pred(WeightCount) do\n if (aWeights[i] <> 0) then begin\n aCodeLengths[aStartInx + i] := 1;\n Exit;\n end;\n end;\n\n {there are at least 2 items in the list; so sort the list}\n SortList(OrigList, OrigListCount);\n\n {create the merge and package lists}\n GetMem(MergeList, OrigListCount * 2 * sizeof(PPkgNode));\n GetMem(PkgList, OrigListCount * 2 * sizeof(PPkgNode));\n\n {initialize the merge list to have the same items as the\n original list}\n Move(OrigList^, MergeList^, OrigListCount * sizeof(PPkgNode));\n MergeListCount := OrigListCount;\n\n {do aMaxCodeLen - 2 times...}\n for Bit := 1 to pred(aMaxCodeLen) do begin\n\n {generate the package list from the merge list by grouping pairs\n from the merge list and adding them to the package list}\n PkgListCount := 0;\n for i := 0 to pred(MergeListCount div 2) do begin\n Node := NodeMgr.AllocNode;\n Node^.pnLeft := MergeList^[i * 2];\n Node^.pnRight := MergeList^[i * 2 + 1];\n Node^.pnWeight := Node^.pnLeft^.pnWeight +\n Node^.pnRight^.pnWeight;\n {$IFOPT C+}\n Node^.pnCount := 0;\n {$ENDIF}\n PkgList^[PkgListCount] := Node;\n inc(PkgListCount);\n end;\n\n {merge the original list and the package list}\n MergeListCount := 0;\n OrigInx := 0;\n PkgInx := 0;\n {note the optimization here: the package list will *always* be\n last to empty in the merge process since it will have at least\n one item whose accumulated weight is greater than all of the\n items in the original list}\n while (OrigInx < OrigListCount) and (PkgInx < PkgListCount) do begin\n if (OrigList^[OrigInx]^.pnWeight <= PkgList^[PkgInx]^.pnWeight) then begin\n MergeList^[MergeListCount] := OrigList^[OrigInx];\n inc(OrigInx);\n end\n else begin\n MergeList^[MergeListCount] := PkgList^[PkgInx];\n inc(PkgInx);\n end;\n inc(MergeListCount);\n end;\n if (OrigInx < OrigListCount) then begin\n Move(OrigList^[OrigInx], MergeList^[MergeListCount],\n (OrigListCount - OrigInx) * sizeof(PPkgNode));\n inc(MergeListCount, (OrigListCount - OrigInx));\n end\n else begin\n Move(PkgList^[PkgInx], MergeList^[MergeListCount],\n (PkgListCount - PkgInx) * sizeof(PPkgNode));\n inc(MergeListCount, (PkgListCount - PkgInx));\n end;\n end;\n\n {calculate the code lengths}\n for i := 0 to (OrigListCount * 2) - 3 do begin\n Node := MergeList^[i];\n if (Node^.pnLeft <> nil) then\n Accumulate(Node);\n end;\n for i := 0 to pred(OrigListCount) do\n aCodeLengths[aStartInx + integer(OrigList^[i].pnRight)] :=\n OrigList^[i].pnCount;\n finally\n FreeMem(OrigList);\n FreeMem(MergeList);\n FreeMem(PkgList);\n NodeMgr.Free;\n end;\nend;\n{====================================================================}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDfStrm.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfStrm.pas *}\n{*********************************************************}\n{* Deflate streams unit for various streams *}\n{*********************************************************}\n\nunit AbDfStrm;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbDfBase,\n AbDfInW,\n AbDfHufD;\n\ntype\n TAb32bit = longint; { a 32-bit type}\n\n PAbDfLitBuckets = ^TAbDfLitBuckets;\n TAbDfLitBuckets = array [0..285] of integer;\n PAbDfDistBuckets = ^TAbDfDistBuckets;\n TAbDfDistBuckets = array [0..31] of integer;\n PAbDfCodeLenBuckets = ^TAbDfCodeLenBuckets;\n TAbDfCodeLenBuckets = array [0..18] of integer;\n\n\nconst\n AbExtractMask : array [1..31] of TAb32bit =\n ($00000001, $00000003, $00000007, $0000000F,\n $0000001F, $0000003F, $0000007F, $000000FF,\n $000001FF, $000003FF, $000007FF, $00000FFF,\n $00001FFF, $00003FFF, $00007FFF, $0000FFFF,\n $0001FFFF, $0003FFFF, $0007FFFF, $000FFFFF,\n $001FFFFF, $003FFFFF, $007FFFFF, $00FFFFFF,\n $01FFFFFF, $03FFFFFF, $07FFFFFF, $0FFFFFFF,\n $1FFFFFFF, $3FFFFFFF, $7FFFFFFF);\n\ntype\n TAbDfInBitStream = class { input bit stream}\n private\n FBitBuffer : TAb32bit;\n FBitsLeft : integer;\n FBufEnd : PAnsiChar;\n FBuffer : PAnsiChar;\n FBufPos : PAnsiChar;\n FByteCount : longint;\n FFakeCount : integer;\n FOnProgress: TAbProgressStep;\n {$IFOPT C+}\n FPeekCount : integer;\n {$ENDIF}\n FStream : TStream;\n FStreamSize: longint;\n protected\n function ibsFillBuffer : boolean;\n public\n constructor Create(aStream : TStream;\n aOnProgress : TAbProgressStep;\n aStreamSize : longint);\n destructor Destroy; override;\n\n procedure AlignToByte;\n procedure DiscardBits(aCount : integer);\n procedure DiscardMoreBits(aCount : integer);\n function PeekBits(aCount : integer) : integer;\n function PeekMoreBits(aCount : integer) : integer;\n function ReadBit : boolean;\n function ReadBits(aCount : integer) : integer;\n procedure ReadBuffer(var aBuffer; aCount : integer);\n\n property BitBuffer : TAb32bit read FBitBuffer write FBitBuffer;\n property BitsLeft : integer read FBitsLeft write FBitsLeft;\n end;\n\ntype\n TAbDfOutBitStream = class { output bit stream}\n private\n FBitBuffer : TAb32bit;\n FBitsUsed : integer;\n FBufEnd : PAnsiChar;\n FBuffer : PAnsiChar;\n FBufPos : PAnsiChar;\n FStream : TStream;\n protected\n procedure obsEmptyBuffer;\n public\n constructor Create(aStream : TStream);\n destructor Destroy; override;\n\n procedure AlignToByte;\n function Position : longint;\n procedure WriteBit(aBit : boolean);\n procedure WriteBits(aBits : integer; aCount : integer);\n procedure WriteBuffer(var aBuffer; aCount : integer);\n procedure WriteMoreBits(aBits : integer; aCount : integer);\n\n property BitBuffer : TAb32bit read FBitBuffer write FBitBuffer;\n property BitsUsed : integer read FBitsUsed write FBitsUsed;\n end;\n\ntype\n TAbDfLZStream = class { LZ77 token stream}\n private\n FCurPos : PAnsiChar;\n FDistBuckets : PAbDfDistBuckets;\n FDistCount : integer;\n FLitBuckets : PAbDfLitBuckets;\n FLitCount : integer;\n FLog : TAbLogger;\n FSlideWin : TAbDfInputWindow;\n FStartOfs : Int64;\n FStoredSize : LongWord;\n FStream : PAnsiChar;\n FStrmEnd : PAnsiChar;\n {$IFDEF UseLogging}\n FSWPos : longint;\n {$ENDIF}\n FUseDeflate64: boolean;\n protected\n function lzsGetApproxSize : LongWord;\n function lzsGetStaticSize : integer;\n function lzsGetStoredSize : integer;\n function lzsIsFull : boolean;\n public\n constructor Create(aSlideWin : TAbDfInputWindow;\n aUseDeflate64 : boolean;\n aLog : TAbLogger);\n destructor Destroy; override;\n\n function AddLenDist(aLen : integer; aDist : integer) : boolean;\n { returns true if the stream is \"full\"}\n function AddLiteral(aCh : AnsiChar) : boolean;\n { returns true if the stream is \"full\"}\n\n procedure Clear;\n procedure Encode(aBitStrm : TAbDfOutBitStream;\n aLitTree : TAbDfDecodeHuffmanTree;\n aDistTree : TAbDfDecodeHuffmanTree;\n aUseDeflate64 : boolean);\n procedure Rewind;\n\n procedure ReadStoredBuffer(var aBuffer; aCount : integer);\n\n property LenDistCount : integer read FDistCount;\n property LiteralCount : integer read FLitCount;\n\n property DistBuckets : PAbDfDistBuckets read FDistBuckets;\n property LitBuckets : PAbDfLitBuckets read FLitBuckets;\n\n property StaticSize : integer read lzsGetStaticSize;{ in bits}\n property StoredSize : integer read lzsGetStoredSize;{ in bytes}\n end;\n\ntype\n TAbDfCodeLenStream = class { codelength token stream}\n private\n FBuckets : PAbDfCodeLenBuckets;\n FPosition : PAnsiChar;\n FStream : PAnsiChar; {array [0..285+32*2] of byte;}\n FStrmEnd : PAnsiChar;\n protected\n public\n constructor Create(aLog : TAbLogger);\n destructor Destroy; override;\n\n procedure Build(const aCodeLens : array of integer;\n aCount : integer);\n procedure Encode(aBitStrm : TAbDfOutBitStream;\n aTree : TAbDfDecodeHuffmanTree);\n\n property Buckets : PAbDfCodeLenBuckets read FBuckets;\n end;\n\nimplementation\n\nuses\n SysUtils,\n AbDfXlat;\n\ntype\n PAb32bit = ^TAb32bit;\n\nconst\n BitStreamBufferSize = 16*1024;\n\n{===TAbDfInBitStream=================================================}\nconstructor TAbDfInBitStream.Create(aStream : TStream;\n aOnProgress : TAbProgressStep;\n aStreamSize : longint);\nbegin\n {protect against dumb programming mistakes}\n Assert(aStream <> nil,\n 'TAbDfInBitStream.Create: Cannot create a bit stream wrapping a nil stream');\n\n {create the ancestor}\n inherited Create;\n\n {save the stream instance, allocate the buffer}\n FStream := aStream;\n GetMem(FBuffer, BitStreamBufferSize);\n\n {save the on progress handler}\n if Assigned(aOnProgress) and (aStreamSize > 0) then begin\n FOnProgress := aOnProgress;\n FStreamSize := aStreamSize;\n end;\nend;\n{--------}\ndestructor TAbDfInBitStream.Destroy;\nbegin\n {if we did some work...}\n if (FBuffer <> nil) then begin\n\n {reposition the underlying stream to the point where we stopped;\n this position is equal to...\n the position of the underlying stream, PLUS\n the number of fake bytes we added, LESS\n the number of bytes in the buffer, PLUS\n the position in the buffer, PLUS\n the number of complete bytes in the bit buffer}\n FStream.Seek(FStream.Position +\n FFakeCount -\n (FBufEnd - FBuffer) +\n (FBufPos - FBuffer) -\n (FBitsLeft div 8), soBeginning);\n\n {free the buffer}\n FreeMem(FBuffer);\n end;\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nprocedure TAbDfInBitStream.AlignToByte;\nbegin\n {get rid of the odd bits by shifting them out of the bit cache}\n FBitBuffer := FBitBuffer shr (FBitsLeft mod 8);\n dec(FBitsLeft, FBitsLeft mod 8);\nend;\n{--------}\nprocedure TAbDfInBitStream.DiscardBits(aCount : integer);\nvar\n BitsToGo : integer;\nbegin\n {aCount comes from a (possibly corrupt) stream, so check that it is\n the correct range, 1..32}\n if (aCount <= 0) or (aCount > 32) then\n raise EAbInternalInflateError.Create(\n 'count of bits must be between 1 and 32 inclusive [TAbDfInBitStream.DiscardBits]');\n\n {$IFOPT C+}\n {verify that the count of bits to discard is less than or equal to\n the recent count from PeekBits--a programming error}\n Assert((aCount <= FPeekCount),\n 'TAbDfInBitStream.DiscardBits: discarding more bits than peeked');\n {since we're discarding bits already peeked, reset the peek count}\n FPeekCount := 0;\n {$ENDIF}\n\n {if we have more than enough bits in our bit buffer, update the\n bitbuffer and the number of bits left}\n if (aCount <= FBitsLeft) then begin\n FBitBuffer := FBitBuffer shr aCount;\n dec(FBitsLeft, aCount);\n end\n\n {otherwise we shall have to read another integer out of the buffer\n to satisfy the request}\n else begin\n {check that there is data in the buffer, if not it's indicates a\n corrupted stream: PeekBits should have filled it}\n if (FBufPos = FBufEnd) then\n raise EAbInternalInflateError.Create(\n 'no more compressed data in stream [TAbDfInBitStream.DiscardBits]');\n\n {refill the bit buffer}\n BitsToGo := aCount - FBitsLeft;\n FBitBuffer := PAb32bit(FBufPos)^;\n inc(FBufPos, sizeof(TAb32bit));\n FBitBuffer := FBitBuffer shr BitsToGo;\n FBitsLeft := 32 - BitsToGo;\n end;\nend;\n{--------}\nprocedure TAbDfInBitStream.DiscardMoreBits(aCount : integer);\nvar\n BitsToGo : integer;\nbegin\n {aCount comes from a (possibly corrupt) stream, so check that it is\n the correct range, 1..32}\n if (aCount <= 0) or (aCount > 32) then\n raise EAbInternalInflateError.Create(\n 'count of bits must be between 1 and 32 inclusive [TAbDfInBitStream.DiscardMoreBits]');\n\n {$IFOPT C+}\n {verify that the count of bits to discard is less than or equal to\n the recent count from PeekBits--a programming error}\n Assert((aCount <= FPeekCount),\n 'TAbDfInBitStream.DiscardBits: discarding more bits than peeked');\n {since we're discarding bits already peeked, reset the peek count}\n FPeekCount := 0;\n {$ENDIF}\n\n {check that there is data in the buffer, if not it's indicates a\n corrupted stream: PeekBits/PeekMoreBits should have filled it}\n if (FBufPos = FBufEnd) then\n raise EAbInternalInflateError.Create(\n 'no more compressed data in stream [TAbDfInBitStream.DiscardBits]');\n\n {refill the bit buffer}\n BitsToGo := aCount - FBitsLeft;\n FBitBuffer := PAb32bit(FBufPos)^;\n inc(FBufPos, sizeof(TAb32bit));\n FBitBuffer := FBitBuffer shr BitsToGo;\n FBitsLeft := 32 - BitsToGo;\nend;\n{--------}\nfunction TAbDfInBitStream.ibsFillBuffer : boolean;\nvar\n BytesRead : longint;\n BytesToRead : longint;\n i : integer;\n Percent : integer;\n Buffer : PAnsiChar;\n BufferCount : integer;\nbegin\n {check for dumb programming mistakes: this routine should only be\n called if there are less than 4 bytes unused in the buffer}\n Assert((FBufEnd - FBufPos) < sizeof(longint),\n 'TAbDfInBitStream.ibsFillBuffer: the buffer should be almost empty');\n\n {if there are still 1, 2, or three bytes unused, move them to the\n front of the buffer}\n Buffer := FBuffer;\n while (FBufPos <> FBufEnd) do begin\n Buffer^ := FBufPos^;\n inc(FBufPos);\n inc(Buffer);\n end;\n\n {fill the buffer}\n BytesToRead := BitStreamBufferSize - (Buffer - FBuffer);\n BytesRead := FStream.Read(Buffer^, BytesToRead);\n\n {reset the internal pointers}\n FBufPos := FBuffer;\n FBufEnd := Buffer + BytesRead;\n BufferCount := FBufEnd - FBuffer;\n\n {if, as a result of the read, no data is in the buffer, return\n false; the caller will decide what to do about the problem}\n if (BufferCount = 0) then\n Result := false\n\n {otherwise there is data to be processed}\n else begin\n Result := true;\n\n {if we didn't read anything from the stream, we need to make sure\n that enough buffer is zeroed out so that reading longint values\n don't produce (dreadfully) bogus values}\n if (BytesRead = 0) and ((BufferCount mod 4) <> 0) then begin\n FFakeCount := 4 - (BufferCount mod 4);\n for i := 0 to pred(FFakeCount) do begin\n FBufEnd^ := #0;\n inc(FBufEnd);\n end;\n end;\n\n {fire the progress event}\n if Assigned(FOnProgress) then begin\n inc(FByteCount, BytesRead);\n Percent := Round((100.0 * FByteCount) / FStreamSize);\n FOnProgress(Percent);\n end;\n end;\nend;\n{--------}\nfunction TAbDfInBitStream.PeekBits(aCount : integer) : integer;\nvar\n BitsToGo : integer;\n TempBuffer : integer;\nbegin\n {check that aCount is in the correct range 1..32}\n Assert((0 <= aCount) and (aCount <= 32),\n 'TAbDfInBitStream.PeekBits: count of bits must be between 1 and 32 inclusive');\n\n {if we have more than enough bits in our bit buffer, return as many\n as needed}\n if (aCount <= FBitsLeft) then\n Result := FBitBuffer and AbExtractMask[aCount]\n\n {otherwise we shall have to read another integer out of the buffer\n to satisfy the request; note that this will fill the stream buffer\n if required}\n else begin\n BitsToGo := aCount - FBitsLeft;\n Result := FBitBuffer;\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n if not ibsFillBuffer then\n TempBuffer := 0\n else\n TempBuffer := PAb32bit(FBufPos)^\n else\n TempBuffer := PAb32bit(FBufPos)^;\n Result := Result +\n ((TempBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft);\n end;\n\n {$IFOPT C+}\n {save the number of bits peeked for an assertion check later}\n FPeekCount := aCount;\n {$ENDIF}\nend;\n{--------}\nfunction TAbDfInBitStream.PeekMoreBits(aCount : integer) : integer;\nvar\n BitsToGo : integer;\n TempBuffer : integer;\nbegin\n BitsToGo := aCount - FBitsLeft;\n Result := FBitBuffer;\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n if not ibsFillBuffer then\n TempBuffer := 0\n else\n TempBuffer := PAb32bit(FBufPos)^\n else\n TempBuffer := PAb32bit(FBufPos)^;\n Result := Result +\n ((TempBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft);\nend;\n{--------}\nfunction TAbDfInBitStream.ReadBit : boolean;\nbegin\n if (FBitsLeft = 0) then begin\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n if not ibsFillBuffer then\n raise EAbInternalInflateError.Create(\n 'no more compressed data in stream [TAbDfInBitStream.ReadBit]');\n FBitBuffer := PAb32bit(FBufPos)^;\n inc(FBufPos, sizeof(TAb32bit));\n FBitsLeft := 32;\n end;\n Result := Odd(FBitBuffer);\n FBitBuffer := FBitBuffer shr 1;\n dec(FBitsLeft);\nend;\n{--------}\nfunction TAbDfInBitStream.ReadBits(aCount : integer) : integer;\nvar\n BitsToGo : integer;\nbegin\n {aCount comes from a (possibly corrupt) stream, so check that it is\n the correct range, 1..16}\n if (aCount <= 0) or (aCount > 16) then\n raise EAbInternalInflateError.Create(\n 'count of bits must be between 1 and 16 inclusive [TAbDfInBitStream.ReadBits]');\n\n {if we have more than enough bits in our bit buffer, return as many\n as needed, and update the bitbuffer and the number of bits left}\n if (aCount <= FBitsLeft) then begin\n Result := FBitBuffer and AbExtractMask[aCount];\n FBitBuffer := FBitBuffer shr aCount;\n dec(FBitsLeft, aCount);\n end\n\n {if we have exactly enough bits in our bit buffer, return them all,\n and update the bitbuffer and the number of bits left}\n else if (aCount = FBitsLeft) then begin\n Result := FBitBuffer;\n FBitBuffer := 0;\n FBitsLeft := 0;\n end\n\n {otherwise we shall have to read another integer out of the buffer\n to satisfy the request}\n else begin\n BitsToGo := aCount - FBitsLeft;\n Result := FBitBuffer;\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n if not ibsFillBuffer then\n raise EAbInternalInflateError.Create(\n 'no more compressed data in stream [TAbDfInBitStream.ReadBits]');\n FBitBuffer := PAb32bit(FBufPos)^;\n inc(FBufPos, sizeof(TAb32bit));\n Result := Result +\n ((FBitBuffer and AbExtractMask[BitsToGo]) shl FBitsLeft);\n FBitBuffer := FBitBuffer shr BitsToGo;\n FBitsLeft := 32 - BitsToGo;\n end;\nend;\n{--------}\nprocedure TAbDfInBitStream.ReadBuffer(var aBuffer; aCount : integer);\nvar\n i : integer;\n Buffer : PAnsiChar;\n BytesToRead : integer;\n BytesInBuffer : integer;\nbegin\n {this method is designed to read a set of bytes and this can only be\n done if the stream has been byte aligned--if it isn't, it's a\n programming error}\n Assert((FBitsLeft mod 8) = 0,\n 'TAbDfInBitStream.ReadBuffer. cannot read a buffer unless the stream is byte-aligned');\n\n {get the address of the user buffer as a PChar: easier arithmetic}\n Buffer := @aBuffer;\n\n {if we have some bits left in the bit buffer, we need to copy those\n first}\n if (FBitsLeft > 0) then begin\n BytesToRead := FBitsLeft div 8;\n for i := 0 to pred(BytesToRead) do begin\n Buffer^ := AnsiChar(FBitBuffer and $FF);\n inc(Buffer);\n FBitBuffer := FBitBuffer shr 8;\n end;\n {calculate the count of bytes still to read}\n dec(aCount, BytesToRead);\n end;\n\n {calculate the number of bytes to copy}\n BytesInBuffer := FBufEnd - FBufPos;\n if (aCount <= BytesInBuffer) then\n BytesToRead := aCount\n else\n BytesToRead := BytesInBuffer;\n\n {copy the data from our buffer to the user buffer}\n Move(FBufPos^, Buffer^, BytesToRead);\n\n {update variables}\n dec(aCount, BytesToRead);\n inc(FBufPos, BytesToRead);\n\n {while there is still data to copy, keep on filling our internal\n buffer and copy it to the user buffer}\n while (aCount <> 0) do begin\n\n {increment the user buffer pointer past the data just copied}\n inc(Buffer, BytesToRead);\n\n {fill our buffer}\n if not ibsFillBuffer then\n raise EAbInternalInflateError.Create(\n 'no more compressed data in stream [TAbDfInBitStream.ReadBuffer]');\n\n {calculate the number of bytes to copy}\n BytesInBuffer := FBufEnd - FBufPos;\n if (aCount <= BytesInBuffer) then\n BytesToRead := aCount\n else\n BytesToRead := BytesInBuffer;\n\n {copy the data from our buffer to the user buffer}\n Move(FBufPos^, Buffer^, BytesToRead);\n\n {update variables}\n dec(aCount, BytesToRead);\n inc(FBufPos, BytesToRead);\n end;\n\n {now we've copied everything over, reset the bit variables: they're\n empty and need refilling}\n FBitBuffer := 0;\n FBitsLeft := 0;\nend;\n{====================================================================}\n\n\n{===TAbDfOutBitStream================================================}\nconstructor TAbDfOutBitStream.Create(aStream : TStream);\nbegin\n {protect against dumb programming mistakes}\n Assert(aStream <> nil,\n 'TAbDfOutBitStream.Create: Cannot create a bit stream wrapping a nil stream');\n\n {create the ancestor}\n inherited Create;\n\n {save the stream instance, allocate the buffer}\n FStream := aStream;\n GetMem(FBuffer, BitStreamBufferSize);\n FBufEnd := FBuffer + BitStreamBufferSize;\n FBufPos := FBuffer;\nend;\n{--------}\ndestructor TAbDfOutBitStream.Destroy;\nvar\n i : integer;\nbegin\n {if the buffer was allocated...}\n if (FBuffer <> nil) then begin\n\n {if there are still some bits in the bit buffer...}\n if (FBitsUsed <> 0) then begin\n\n {pad the bit buffer to a byte boundary}\n AlignToByte;\n\n {empty the main buffer if there isn't enough room to copy over\n the 1 to 4 bytes in the bit buffer}\n if ((FBufEnd - FBufPos) < FBitsUsed div 8) then\n obsEmptyBuffer;\n\n {flush the bit buffer}\n for i := 1 to (FBitsUsed div 8) do begin\n FBufPos^ := AnsiChar(FBitBuffer);\n FBitBuffer := FBitBuffer shr 8;\n inc(FBufPos);\n end;\n end;\n\n {if there is some data in the main buffer, empty it}\n if (FBufPos <> FBuffer) then\n obsEmptyBuffer;\n\n {free the buffer}\n FreeMem(FBuffer);\n end;\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nprocedure TAbDfOutBitStream.AlignToByte;\nbegin\n {round up the number of bits used to the nearest 8}\n FBitsUsed := (FBitsUsed + 7) and $F8;\n\n {if the bit buffer is now full, flush it to the main buffer}\n if (FBitsUsed = 32) then begin\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n obsEmptyBuffer;\n PAb32bit(FBufPos)^ := FBitBuffer;\n inc(FBufPos, sizeof(TAb32bit));\n FBitBuffer := 0;\n FBitsUsed := 0;\n end;\nend;\n{--------}\nprocedure TAbDfOutBitStream.obsEmptyBuffer;\nvar\n ByteCount : integer;\n BytesWritten : longint;\nbegin\n {empty the buffer}\n ByteCount := FBufPos - FBuffer;\n BytesWritten := FStream.Write(FBuffer^, ByteCount);\n\n {if we couldn't write the correct number of bytes, it's an error}\n if (BytesWritten <> ByteCount) then\n raise EAbInternalDeflateError.Create(\n 'could not write to the output stream [TAbDfInBitStream.obsEmptyBuffer]');\n\n {reset the pointers}\n FBufPos := FBuffer;\nend;\n{--------}\nfunction TAbDfOutBitStream.Position : longint;\nbegin\n Assert(false,\n 'TAbDfOutBitStream.Position: not implemented yet!');\n Result := -1;\nend;\n{--------}\nprocedure TAbDfOutBitStream.WriteBit(aBit : boolean);\nbegin\n {only set the corresponding bit in the bit buffer if the passed bit\n is set (the bit buffer is set to zero when emptied, so we don't\n actually have to record clear bits)}\n if aBit then\n FBitBuffer := FBitBuffer or (1 shl FBitsUsed);\n\n {we've now got one more bit}\n inc(FBitsUsed);\n\n {if the bit buffer is now full, flush it to the main buffer}\n if (FBitsUsed = 32) then begin\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n obsEmptyBuffer;\n PAb32bit(FBufPos)^ := FBitBuffer;\n inc(FBufPos, sizeof(TAb32bit));\n FBitBuffer := 0;\n FBitsUsed := 0;\n end;\nend;\n{--------}\nprocedure TAbDfOutBitStream.WriteBits(aBits : integer; aCount : integer);\nbegin\n {protect against programming mistakes...}\n {..the count should be in the range 1 to 16 (BTW, the latter is only\n used once: Deflate64 with length symbol 258)}\n Assert((0 < aCount) and (aCount <= 16),\n 'TAbDfOutBitStream.WriteBits: aCount should be from 1 to 16');\n {..there shouldn't be more than aCount bits}\n Assert((aBits shr aCount) = 0,\n 'TAbDfOutBitStream.WriteBits: aBits has more than aCount bits');\n\n {copy as many bits as we can to the bit buffer}\n FBitBuffer := FBitBuffer or (aBits shl FBitsUsed);\n\n {increment the number of bits used}\n inc(FBitsUsed, aCount);\n\n {if we've overshot...}\n if (FBitsUsed >= 32) then begin\n\n {the bit buffer is now full, so flush it}\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n obsEmptyBuffer;\n PAb32bit(FBufPos)^ := FBitBuffer;\n inc(FBufPos, sizeof(TAb32bit));\n\n {patch up the bit buffer and the number of bits used}\n dec(FBitsUsed, 32);\n FBitBuffer := aBits shr (aCount - FBitsUsed);\n end;\nend;\n{--------}\nprocedure TAbDfOutBitStream.WriteBuffer(var aBuffer; aCount : integer);\nvar\n Buffer : PAnsiChar;\n BytesToCopy : integer;\nbegin\n {guard against dumb programming errors: we must be byte aligned}\n Assert((FBitsUsed and $7) = 0,\n 'TAbDfOutBitStream.WriteBuffer: must be byte aligned');\n\n {use the user buffer as a PChar}\n Buffer := @aBuffer;\n\n {flush the bit buffer to the underlying stream}\n while (FBitsUsed <> 0) do begin\n if (FBufEnd = FBufPos) then\n obsEmptyBuffer;\n FBufPos^ := AnsiChar(FBitBuffer and $FF);\n inc(FBufPos);\n FBitBuffer := FBitBuffer shr 8;\n dec(FBitsUsed, 8);\n end;\n\n {copy over the data to the underlying stream}\n BytesToCopy := FBufEnd - FBufPos;\n if (BytesToCopy > aCount) then\n BytesToCopy := aCount;\n Move(Buffer^, FBufPos^, BytesToCopy);\n inc(FBufPos, BytesToCopy);\n dec(aCount, BytesToCopy);\n while (aCount <> 0) do begin\n inc(Buffer, BytesToCopy);\n obsEmptyBuffer;\n BytesToCopy := FBufEnd - FBufPos;\n if (BytesToCopy > aCount) then\n BytesToCopy := aCount;\n Move(Buffer^, FBufPos^, BytesToCopy);\n inc(FBufPos, BytesToCopy);\n dec(aCount, BytesToCopy);\n end;\n\n {finish with a flushed buffer}\n obsEmptyBuffer;\nend;\n{--------}\nprocedure TAbDfOutBitStream.WriteMoreBits(aBits : integer; aCount : integer);\nbegin\n {the bit buffer is now full, so flush it}\n if ((FBufEnd - FBufPos) < sizeof(TAb32bit)) then\n obsEmptyBuffer;\n PAb32bit(FBufPos)^ := FBitBuffer;\n inc(FBufPos, sizeof(TAb32bit));\n\n {patch up the bit buffer and the number of bits used}\n dec(FBitsUsed, 32);\n FBitBuffer := aBits shr (aCount - FBitsUsed);\nend;\n{====================================================================}\n\n\n{===TAbDfLZStream====================================================}\nconst\n {Implementation note: this stream size has been chosen so that if\n the data must be stored, a block size of about 64K will result}\n StreamSize = 160 * 1024;\ntype\n PWord = ^word;\n{--------}\nconstructor TAbDfLZStream.Create(aSlideWin : TAbDfInputWindow;\n aUseDeflate64 : boolean;\n aLog : TAbLogger);\nbegin\n {create the ancestor}\n inherited Create;\n\n {save the sliding window and the logger}\n FSlideWin := aSlideWin;\n FUseDeflate64 := aUseDeflate64;\n FLog := aLog;\n\n {create the buckets}\n New(FDistBuckets);\n New(FLitBuckets);\n\n {create the memory stream, allocate its buffer, position at start}\n GetMem(FStream, StreamSize);\n Clear;\nend;\n{--------}\ndestructor TAbDfLZStream.Destroy;\nbegin\n {free the buckets}\n if (FDistBuckets <> nil) then\n Dispose(FDistBuckets);\n if (FLitBuckets <> nil) then\n Dispose(FLitBuckets);\n\n {free the memory stream}\n if (FStream <> nil) then\n FreeMem(FStream);\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\n{$IFDEF UseLogging}\nprocedure AddLenDistToLog(aLog : TAbLogger;\n aPosn : longint;\n aLen : integer;\n aDist : integer;\n aOverLap : boolean);\nbegin\n {NOTE the reason for this separate routine is to avoid string\n allocations and try..finally blocks in the main method: an\n optimization issue}\n if aOverLap then\n aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d **overlap**',\n [aPosn, aLen, aDist]))\n else\n aLog.WriteLine(Format('%8x Len: %-3d, Dist: %-5d',\n [aPosn, aLen, aDist]));\nend;\n{$ENDIF}\n{--------}\nfunction TAbDfLZStream.AddLenDist(aLen : integer; aDist : integer)\n : boolean;\nvar\n LenSymbol : integer;\n DistSymbol : integer;\n CurPos : PAnsiChar;\nbegin\n {$IFDEF UseLogging}\n {log it}\n if (FLog <> nil) then begin\n if (aLen > aDist) then\n AddLenDistToLog(FLog, FSWPos, aLen, aDist, true)\n else\n AddLenDistToLog(FLog, FSWPos, aLen, aDist, false);\n inc(FSWPos, aLen);\n end;\n {$ENDIF}\n\n {write a length/distance record to the stream}\n CurPos := FCurPos;\n CurPos^ := AnsiChar(false);\n inc(CurPos);\n PWord(CurPos)^ := word(aLen - 1);\n inc(CurPos, sizeof(word));\n PWord(CurPos)^ := word(aDist - 1);\n inc(CurPos, sizeof(word));\n FCurPos := CurPos;\n\n {increment the various counters}\n inc(FDistCount);\n inc(FStoredSize, aLen);\n\n {convert the length and distance to their symbols}\n {$IFOPT C+} {if Assertions are on}\n LenSymbol := AbSymbolTranslator.TranslateLength(aLen);\n DistSymbol := AbSymbolTranslator.TranslateDistance(aDist);\n {$ELSE}\n if (3 <= aLen) and (aLen <= 258) then\n LenSymbol := AbSymbolTranslator.LenSymbols[aLen-3] + 257\n else\n LenSymbol := 285;\n if (aDist <= 256) then\n DistSymbol := AbSymbolTranslator.ShortDistSymbols[aDist - 1]\n else if (aDist <= 32768) then\n DistSymbol := AbSymbolTranslator.MediumDistSymbols[((aDist - 1) div 128) - 2]\n else\n DistSymbol := AbSymbolTranslator.LongDistSymbols[((aDist - 1) div 16384) - 2];\n {$ENDIF}\n\n {increment the buckets}\n inc(FLitBuckets^[LenSymbol]);\n inc(FDistBuckets^[DistSymbol]);\n\n {return whether the stream is full and needs encoding}\n Result := lzsIsFull;\nend;\n{--------}\n{$IFDEF UseLogging}\nprocedure AddLiteralToLog(aLog : TAbLogger;\n aPosn : longint;\n aCh : AnsiChar);\nbegin\n {NOTE the reason for this separate routine is to avoid string\n allocations and try..finally blocks in the main method: an\n optimization issue}\n if (' ' < aCh) and (aCh <= '~') then\n aLog.WriteLine(Format('%8x Char: %3d $%2x [%s]', [aPosn, ord(aCh), ord(aCh), aCh]))\n else\n aLog.WriteLine(Format('%8x Char: %3d $%2x', [aPosn, ord(aCh), ord(aCh)]));\nend;\n{$ENDIF}\n{--------}\nfunction TAbDfLZStream.AddLiteral(aCh : AnsiChar) : boolean;\nvar\n CurPos : PAnsiChar;\nbegin\n {$IFDEF UseLogging}\n {log it}\n if (FLog <> nil) then begin\n AddLiteralToLog(FLog, FSWPos, aCh);\n inc(FSWPos);\n end;\n {$ENDIF}\n\n {write a literal to the internal stream}\n CurPos := FCurPos;\n CurPos^ := AnsiChar(true);\n inc(CurPos);\n CurPos^ := aCh;\n inc(CurPos);\n FCurPos := CurPos;\n\n {increment the various counters}\n inc(FLitCount);\n inc(FLitBuckets^[byte(aCh)]);\n inc(FStoredSize);\n\n {return whether the stream is full and needs encoding}\n Result := lzsIsFull;\nend;\n{--------}\nprocedure TAbDfLZStream.Clear;\nbegin\n {position the stream at the start}\n Rewind;\n\n {reset all variables}\n FStrmEnd := nil;\n FLitCount := 0;\n FDistCount := 0;\n FStartOfs := FSlideWin.Position;\n FStoredSize := 0;\n {$IFDEF UseLogging}\n FSWPos := FStartOfs;\n {$ENDIF}\n\n {reset the buckets}\n FillChar(FLitBuckets^, sizeof(FLitBuckets^), 0);\n FLitBuckets^[256] := 1; { end-of-block marker: it's always there...}\n FillChar(FDistBuckets^, sizeof(FDistBuckets^), 0);\nend;\n{--------}\nprocedure TAbDfLZStream.Encode(aBitStrm : TAbDfOutBitStream;\n aLitTree : TAbDfDecodeHuffmanTree;\n aDistTree : TAbDfDecodeHuffmanTree;\n aUseDeflate64 : boolean);\nvar\n Len : integer;\n Dist : integer;\n Symbol : integer;\n CurPos : PAnsiChar;\n StrmEnd : PAnsiChar;\n Code : longint;\n ExtraBits : longint;\nbegin\n {rewind the LZ77 stream}\n Rewind;\n\n {for speed use local variables}\n CurPos := FCurPos;\n StrmEnd := FStrmEnd;\n\n {while there are still items in the stream...}\n while (CurPos < StrmEnd) do begin\n\n {if the next item is a literal...}\n if boolean(CurPos^) then begin\n\n {encode the literal character as a symbol}\n inc(CurPos);\n {$IFOPT C+} {if Assertions are on}\n Code := aLitTree.Encode(byte(CurPos^));\n {$ELSE}\n Code := aLitTree.Encodes^[byte(CurPos^)];\n {$ENDIF}\n inc(CurPos);\n\n {write the code out to the bit stream}\n {$IFOPT C+}\n aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);\n {$ELSE}\n with aBitStrm do begin\n BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed);\n BitsUsed := BitsUsed + ((Code shr 16) and $FF);\n if (BitsUsed >= 32) then\n WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF);\n end;\n {$ENDIF}\n end\n\n {otherwise it's a length/distance pair}\n else begin\n\n {DO THE LENGTH FIRST-------------------------------------------}\n {get the length from the stream}\n inc(CurPos);\n Len := integer(PWord(CurPos)^) + 1;\n inc(CurPos, sizeof(word));\n\n {translate it to a symbol and convert that to a code using the\n literal/length huffman tree}\n {$IFOPT C+} {if Assertions are on}\n Symbol := AbSymbolTranslator.TranslateLength(Len);\n Code := aLitTree.Encode(Symbol);\n {$ELSE}\n if (3 <= Len) and (Len <= 258) then\n Symbol := AbSymbolTranslator.LenSymbols[Len-3] + 257\n else\n Symbol := 285;\n Code := aLitTree.Encodes^[Symbol];\n {$ENDIF}\n\n {output the length code}\n {$IFOPT C+}\n aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);\n {$ELSE}\n with aBitStrm do begin\n BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed);\n BitsUsed := BitsUsed + ((Code shr 16) and $FF);\n if (BitsUsed >= 32) then\n WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF);\n end;\n {$ENDIF}\n\n {if the length symbol were 285, its definition changes from Deflate\n to Deflate64, so make it a special case: for Deflate there are no\n extra bits, for Deflate64 output the (length - 3) as 16 bits}\n if (Symbol = 285) then begin\n if aUseDeflate64 then begin\n {$IFOPT C+}\n aBitStrm.WriteBits(Len - 3, 16);\n {$ELSE}\n with aBitStrm do begin\n BitBuffer := BitBuffer or ((Len - 3) shl BitsUsed);\n BitsUsed := BitsUsed + 16;\n if (BitsUsed >= 32) then\n WriteMoreBits(Len - 3, 16);\n end;\n {$ENDIF}\n end;\n end\n\n {otherwise if there are extra bits to be output for this length,\n calculate them and output them}\n else begin\n ExtraBits := Code shr 24;\n if (ExtraBits <> 0) then begin\n {$IFOPT C+}\n aBitStrm.WriteBits((Len - dfc_LengthBase[Symbol - 257]),\n ExtraBits);\n {$ELSE}\n with aBitStrm do begin\n BitBuffer := BitBuffer or\n ((Len - dfc_LengthBase[Symbol - 257]) shl BitsUsed);\n BitsUsed := BitsUsed + ExtraBits;\n if (BitsUsed >= 32) then\n WriteMoreBits((Len - dfc_LengthBase[Symbol - 257]),\n ExtraBits);\n end;\n {$ENDIF}\n end;\n end;\n\n {DO THE DISTANCE NEXT------------------------------------------}\n {get the distance from the stream}\n Dist := integer(PWord(CurPos)^) + 1;\n inc(CurPos, sizeof(word));\n\n {translate it to a symbol and convert that to a code using the\n distance huffman tree}\n {$IFOPT C+} {if Assertions are on}\n Symbol := AbSymbolTranslator.TranslateDistance(Dist);\n Assert(aUseDeflate64 or (Symbol < 30),\n 'TAbDfLZStream.Encode: a Deflate64 distance symbol has been generated for Deflate');\n Code := aDistTree.Encode(Symbol);\n {$ELSE}\n if (Dist <= 256) then\n Symbol := AbSymbolTranslator.ShortDistSymbols[Dist - 1]\n else if (Dist <= 32768) then\n Symbol := AbSymbolTranslator.MediumDistSymbols[((Dist - 1) div 128) - 2]\n else\n Symbol := AbSymbolTranslator.LongDistSymbols[((Dist - 1) div 16384) - 2];\n Code := aDistTree.Encodes^[Symbol];\n {$ENDIF}\n\n {output the distance code}\n {$IFOPT C+}\n aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);\n {$ELSE}\n with aBitStrm do begin\n BitBuffer := BitBuffer or ((Code and $FFFF) shl BitsUsed);\n BitsUsed := BitsUsed + ((Code shr 16) and $FF);\n if (BitsUsed >= 32) then\n WriteMoreBits(Code and $FFFF, (Code shr 16) and $FF);\n end;\n {$ENDIF}\n\n {if there are extra bits to be output for this distance, calculate\n them and output them}\n ExtraBits := Code shr 24;\n if (ExtraBits <> 0) then begin\n {$IFOPT C+}\n aBitStrm.WriteBits((Dist - dfc_DistanceBase[Symbol]),\n ExtraBits);\n {$ELSE}\n with aBitStrm do begin\n BitBuffer := BitBuffer or\n ((Dist - dfc_DistanceBase[Symbol]) shl BitsUsed);\n BitsUsed := BitsUsed + ExtraBits;\n if (BitsUsed >= 32) then\n WriteMoreBits((Dist - dfc_DistanceBase[Symbol]),\n ExtraBits);\n end;\n {$ENDIF}\n end;\n end;\n end;\n\n{clear the stream; ready for some more items}\n{ Clear;}\nend;\n{--------}\nfunction TAbDfLZStream.lzsGetApproxSize : LongWord;\nvar\n i : integer;\nbegin\n {note: calculates an approximate compressed size without taking too\n long about it. The average encoded bit length for literals\n and lengths is assumed to be 8. Distances are assumed to\n follow the static tree definition (ie, 5 bits per distance,\n plus any extra bits).\n There are FLitCount literals, FDistCount lengths, and\n FDistCount distances}\n Result := (13 * FDistCount) + (8 * FLitCount);\n for i := 4 to 31 do\n inc(Result, FDistBuckets^[i] * dfc_DistExtraBits[i]);\n Result := Result div 8;\nend;\n{--------}\nfunction TAbDfLZStream.lzsGetStaticSize : integer;\nvar\n i : integer;\nbegin\n Result := 0;\n for i := 0 to 143 do\n inc(Result, FLitBuckets^[i] * 8);\n for i := 144 to 255 do\n inc(Result, FLitBuckets^[i] * 9);\n inc(Result, FLitBuckets^[256] * 7);\n for i := 257 to 279 do\n inc(Result, FLitBuckets^[i] *\n (7 + dfc_LitExtraBits[i - dfc_LitExtraOffset]));\n for i := 280 to 284 do\n inc(Result, FLitBuckets^[i] *\n (8 + dfc_LitExtraBits[i - dfc_LitExtraOffset]));\n if FUseDeflate64 then\n inc(Result, FLitBuckets^[285] * (8 + 16))\n else\n inc(Result, FLitBuckets^[285] * 8);\n\n for i := 0 to 31 do\n inc(Result, FDistBuckets^[i] * (5 + dfc_DistExtraBits[i]));\nend;\n{--------}\nfunction TAbDfLZStream.lzsGetStoredSize : integer;\nbegin\n Result := FStoredSize;\n{Result := FSlideWin.Position - FStartOfs;}\nend;\n{--------}\nfunction TAbDfLZStream.lzsIsFull : boolean;\nbegin\n {if the number of hits on the (eventual) literal tree is a multiple\n of 8192, the stream is full if the majority were straight literals\n and we're getting approx 50% compression}\n if (((FLitCount + FDistCount) and $1FFF) = 0) then begin\n Result := (FDistCount < FLitCount) and\n (lzsGetApproxSize < (FStoredSize div 2));\n if Result then\n Exit;\n end;\n\n {otherwise the stream is full if the number of hits on the literal\n tree or on the distance tree is 32768}\n{ Result := (FCurPos - FStream) > (StreamSIze - 100);}\n Result := (FDistCount >= 32768) or\n ((FLitCount + FDistCount) >= 32768);\nend;\n{--------}\nprocedure TAbDfLZStream.ReadStoredBuffer(var aBuffer; aCount : integer);\nbegin\n FSlideWin.ReadBuffer(aBuffer, aCount, FStartOfs);\n inc(FStartOfs, aCount);\nend;\n{--------}\nprocedure TAbDfLZStream.Rewind;\nbegin\n {position the stream at the beginning}\n FStrmEnd := FCurPos;\n FCurPos := FStream;\nend;\n{====================================================================}\n\n\n{===TAbDfCodeLenStream===============================================}\nconstructor TAbDfCodeLenStream.Create(aLog : TAbLogger);\nbegin\n {create the ancestor}\n inherited Create;\n\n {allocate the stream (to contain all literals and distances and\n possible extra data}\n GetMem(FStream, (285 + 32) * 2);\n FPosition := FStream;\n\n {allocate the buckets}\n FBuckets := AllocMem(sizeof(TAbDfCodeLenBuckets));\nend;\n{--------}\ndestructor TAbDfCodeLenStream.Destroy;\nbegin\n {free the stream}\n if (FStream <> nil) then\n FreeMem(FStream);\n\n {free the buckets}\n if (FBuckets <> nil) then\n Dispose(FBuckets);\n\n {destroy the ancestor}\n inherited Destroy;\nend;\n{--------}\nprocedure TAbDfCodeLenStream.Build(const aCodeLens : array of integer;\n aCount : integer);\nvar\n i : integer;\n State : (ScanStart, ScanNormal, Got2nd, Got3rd);\n Count : integer;\n ThisCount : integer;\n CodeLen : integer;\n PrevCodeLen : integer;\n CurPos : PAnsiChar;\n Buckets : PAbDfCodeLenBuckets;\nbegin\n {start the automaton}\n State := ScanStart;\n CurPos := FStream;\n Buckets := FBuckets;\n Count := 0;\n PrevCodeLen := 0;\n\n {for all the codelengths in the array (plus a fake one at the end to\n ensure all codeslengths are counted)...}\n for i := 0 to aCount do begin\n\n {get the current codelength}\n if (i = aCount) then\n CodeLen := -1\n else\n CodeLen := aCodeLens[i];\n\n {switch based on the state...}\n case State of\n ScanStart :\n begin\n PrevCodeLen := CodeLen;\n State := ScanNormal;\n end;\n\n ScanNormal :\n begin\n {if the current code is the same as the previous, move to\n the next state}\n if (CodeLen = PrevCodeLen) then\n State := Got2nd\n\n {otherwise output the previous code}\n else begin\n CurPos^ := AnsiChar(PrevCodeLen);\n inc(CurPos);\n inc(Buckets^[PrevCodeLen]);\n PrevCodeLen := CodeLen;\n end;\n end;\n\n Got2nd :\n begin\n {if the current code is the same as the previous, move to\n the next state; we now have three similar codes in a row}\n if (CodeLen = PrevCodeLen) then begin\n State := Got3rd;\n Count := 3;\n end\n\n {otherwise output the previous two similar codes, move back\n to the initial state}\n else begin\n CurPos^ := AnsiChar(PrevCodeLen);\n inc(CurPos);\n CurPos^ := AnsiChar(PrevCodeLen);\n inc(CurPos);\n inc(Buckets^[PrevCodeLen], 2);\n PrevCodeLen := CodeLen;\n State := ScanNormal;\n end;\n end;\n\n Got3rd:\n begin\n {if the current code is the same as the previous, increment\n the count of similar codes}\n if (CodeLen = PrevCodeLen) then\n inc(Count)\n\n {otherwise we need to output the repeat values...}\n else begin\n\n {if the previous code were a zero code...}\n if (PrevCodeLen = 0) then begin\n\n {while there are zero codes to be output...}\n while (Count <> 0) do begin\n\n {if there are less than three zero codes, output them\n individually}\n if (Count < 3) then begin\n while (Count <> 0) do begin\n CurPos^ := #0;\n inc(CurPos);\n inc(Buckets^[0]);\n dec(Count);\n end;\n end\n\n {if there are less than 11 successive zero codes,\n output a 17 code and the count of zeros}\n else if (Count < 11) then begin\n CurPos^ := #17;\n inc(CurPos);\n inc(Buckets^[17]);\n CurPos^ := AnsiChar(Count - 3);\n inc(CurPos);\n Count := 0;\n end\n\n {otherwise output an 18 code and the count of zeros}\n else begin\n ThisCount := Count;\n if (ThisCount > 138) then\n ThisCount := 138;\n CurPos^ := #18;\n inc(CurPos);\n inc(Buckets^[18]);\n CurPos^ := AnsiChar(ThisCount - 11);\n inc(CurPos);\n dec(Count, ThisCount);\n end;\n end;\n end\n\n {otherwise the previous code was a non-zero code...}\n else begin\n\n {output the first code}\n CurPos^ := AnsiChar(PrevCodeLen);\n inc(CurPos);\n inc(Buckets^[PrevCodeLen]);\n dec(Count);\n\n {while there are more codes to be output...}\n while (Count <> 0) do begin\n\n {if there are less than three codes, output them\n individually}\n if (Count < 3) then begin\n while (Count <> 0) do begin\n CurPos^ := AnsiChar(PrevCodeLen);\n inc(CurPos);\n inc(Buckets^[PrevCodeLen]);\n dec(Count);\n end;\n end\n\n {otherwise output an 16 code and the count}\n else begin\n ThisCount := Count;\n if (ThisCount > 6) then\n ThisCount := 6;\n CurPos^ := #16;\n inc(CurPos);\n inc(Buckets^[16]);\n CurPos^ := AnsiChar(ThisCount - 3);\n inc(CurPos);\n dec(Count, ThisCount);\n end;\n end;\n end;\n\n {move back to the initial state}\n PrevCodeLen := CodeLen;\n State := ScanNormal;\n end;\n end;\n end;\n end;\n\n {set the read position}\n FStrmEnd := CurPos;\n FPosition := FStream;\nend;\n{--------}\nprocedure TAbDfCodeLenStream.Encode(aBitStrm : TAbDfOutBitStream;\n aTree : TAbDfDecodeHuffmanTree);\nvar\n Symbol : integer;\n ExtraData : integer;\n Code : longint;\n CurPos : PAnsiChar;\n StrmEnd : PAnsiChar;\nbegin\n {prepare for the loop}\n CurPos := FPosition;\n StrmEnd := FStrmEnd;\n\n {while there are tokens in the stream...}\n while (CurPos <> StrmEnd) do begin\n\n {get the next symbol}\n Symbol := ord(CurPos^);\n inc(CurPos);\n\n {if the symbol is 0..15, get the code and output it}\n if (Symbol <= 15) then begin\n {$IFOPT C+} {if Assertions are on}\n Code := aTree.Encode(Symbol);\n {$ELSE}\n Code:= aTree.Encodes^[Symbol];\n {$ENDIF}\n aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);\n end\n\n {otherwise the symbol is 16, 17, or 18}\n else begin\n {get the extra data}\n ExtraData := ord(CurPos^);\n inc(CurPos);\n {get the code and output it}\n {$IFOPT C+} {if Assertions are on}\n Code := aTree.Encode(Symbol);\n {$ELSE}\n Code:= aTree.Encodes^[Symbol];\n {$ENDIF}\n aBitStrm.WriteBits(Code and $FFFF, (Code shr 16) and $FF);\n if (Symbol = 16) then\n aBitStrm.WriteBits(ExtraData, 2)\n else if (Symbol = 17) then\n aBitStrm.WriteBits(ExtraData, 3)\n else {Symbol = 18}\n aBitStrm.WriteBits(ExtraData, 7);\n end;\n end;\nend;\n{====================================================================}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDfXlat.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDfXlat.pas *}\n{*********************************************************}\n{* Deflate length/dist to symbol translator *}\n{*********************************************************}\n\nunit AbDfXlat;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils;\n\ntype\n TAbDfTranslator = class\n private\n FBuffer : PAnsiChar;\n FLenSymbols : PByteArray;\n {for lengths 3..258}\n FLongDistSymbols : PByteArray;\n {for distances 32769..65536 (deflate64)}\n FMediumDistSymbols : PByteArray;\n {for distances 257..32768}\n FShortDistSymbols : PByteArray;\n {for distances 1..256}\n protected\n procedure trBuild;\n public\n constructor Create;\n destructor Destroy; override;\n\n function TranslateLength(aLen : integer): integer;\n function TranslateDistance(aDist : integer) : integer;\n\n property LenSymbols : PByteArray read FLenSymbols;\n property LongDistSymbols : PByteArray read FLongDistSymbols;\n property MediumDistSymbols : PByteArray read FMediumDistSymbols;\n property ShortDistSymbols : PByteArray read FShortDistSymbols;\n end;\n\nvar\n AbSymbolTranslator : TAbDfTranslator;\n\nimplementation\n\nuses\n AbDfBase;\n\n{====================================================================}\nconstructor TAbDfTranslator.Create;\nbegin\n {create the ancestor}\n inherited Create;\n\n {allocate the translation arrays (the buffer *must* be zeroed)}\n FBuffer := AllocMem(256 + 2 + 256 + 256);\n FLenSymbols := PByteArray(FBuffer);\n FLongDistSymbols := PByteArray(FBuffer + 256);\n FMediumDistSymbols := PByteArray(FBuffer + 256 + 2);\n FShortDistSymbols := PByteArray(FBuffer + 256 + 2 + 256);\n\n {build the translation arrays}\n trBuild;\nend;\n{--------}\ndestructor TAbDfTranslator.Destroy;\nbegin\n if (FBuffer <> nil) then\n FreeMem(FBuffer);\n inherited Destroy;\nend;\n{--------}\nfunction TAbDfTranslator.TranslateDistance(aDist : integer) : integer;\nbegin\n {save against dumb programming mistakes}\n Assert((1 <= aDist) and (aDist <= 65536),\n 'TAbDfTranslator.Translate: distance should be 1..65536');\n\n {translate the distance}\n if (aDist <= 256) then\n Result := FShortDistSymbols[aDist - 1]\n else if (aDist <= 32768) then\n Result := FMediumDistSymbols[((aDist - 1) div 128) - 2]\n else\n Result := FLongDistSymbols[((aDist - 1) div 16384) - 2];\nend;\n{--------}\nfunction TAbDfTranslator.TranslateLength(aLen : integer): integer;\nbegin\n {save against dumb programming mistakes}\n Assert((3 <= aLen) and (aLen <= 65536),\n 'TAbDfTranslator.Translate: length should be 3..65536');\n\n {translate the length}\n dec(aLen, 3);\n if (0 <= aLen) and (aLen <= 255) then\n Result := FLenSymbols[aLen] + 257\n else\n Result := 285;\nend;\n{--------}\nprocedure TAbDfTranslator.trBuild;\nvar\n i : integer;\n Len : integer;\n Dist : integer;\n Value : integer;\nbegin\n {initialize the length translation array; elements will contain\n (Symbol - 257) for a given (length - 3)}\n for i := low(dfc_LengthBase) to pred(high(dfc_LengthBase)) do begin\n Len := dfc_LengthBase[i] - 3;\n FLenSymbols[Len] := i;\n end;\n FLenSymbols[255] := 285 - 257;\n Value := -1;\n for i := 0 to 255 do begin\n if (Value < FLenSymbols[i]) then\n Value := FLenSymbols[i]\n else\n FLenSymbols[i] := Value;\n end;\n\n {initialize the short distance translation array: it will contain\n the Symbol for a given (distance - 1) where distance <= 256}\n for i := 0 to 15 do begin\n Dist := dfc_DistanceBase[i] - 1;\n FShortDistSymbols[Dist] := i;\n end;\n Value := -1;\n for i := 0 to 255 do begin\n if (Value < FShortDistSymbols[i]) then\n Value := FShortDistSymbols[i]\n else\n FShortDistSymbols[i] := Value;\n end;\n\n {initialize the medium distance translation array: it will contain\n the Symbol for a given (((distance - 1) div 128) - 2) where\n distance is in the range 256..32768}\n for i := 16 to 29 do begin\n Dist := ((dfc_DistanceBase[i] - 1) div 128) - 2;\n FMediumDistSymbols[Dist] := i;\n end;\n Value := -1;\n for i := 0 to 255 do begin\n if (Value < FMediumDistSymbols[i]) then\n Value := FMediumDistSymbols[i]\n else\n FMediumDistSymbols[i] := Value;\n end;\n\n {initialize the long distance translation array: it will contain the\n Symbol for a given ((distance - 1) div 16384) - 2) for distances\n over 32768 in deflate64}\n FLongDistSymbols[0] := 30;\n FLongDistSymbols[1] := 31;\nend;\n{====================================================================}\n\ninitialization\n AbSymbolTranslator := TAbDfTranslator.Create;\n\nfinalization\n AbSymbolTranslator.Free;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDlgDir.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDlgDir.pas *}\n{*********************************************************}\n{* ABBREVIA: Dialog - Directory *}\n{* Use AbQDgDir.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbDlgDir;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF MSWINDOWS}\n Windows, Messages, ShlObj, ActiveX,\n{$ENDIF}\n SysUtils, Classes,\n{$IFDEF UsingClx}\n QButtons, QExtCtrls, QGraphics, QForms, QControls, QStdCtrls,\n{$ELSE}\n Buttons, ExtCtrls, Graphics, Forms, Controls, StdCtrls,\n {$WARN UNIT_PLATFORM OFF}\n FileCtrl,\n {$WARN UNIT_PLATFORM ON}\n{$ENDIF}\n AbResString;\n\ntype\n{$IFNDEF UsingClx}\n TDirDlg = class(TForm)\n OKBtn: TButton;\n CancelBtn: TButton;\n Bevel1: TBevel;\n DriveComboBox1: TDriveComboBox;\n DirectoryListBox1: TDirectoryListBox;\n Panel1: TPanel;\n procedure DirectoryListBox1Change(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n public\n SelectedFolder: string;\n end;\n{$ELSE}\n TDirDlg = class(TForm)\n OKBtn: TButton;\n CancelBtn: TButton;\n Bevel1: TBevel;\n Panel1: TPanel;\n procedure DirectoryListBox1Change(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n public\n SelectedFolder: string;\n end;\n{$ENDIF}\n\n\n{$IFDEF MSWINDOWS}\ntype\n TAbDirDlg = class(TComponent)\n protected {private}\n FAdditionalText : string;\n FCaption : string;\n FHandle : Integer;\n FIDList : PItemIDList;\n FSelectedFolder : string;\n\n procedure SetSelectedFolder(const Value : string);\n procedure FreeIDList;\n\n public {properties}\n property AdditionalText : string\n read FAdditionalText\n write FAdditionalText;\n property Caption : string\n read FCaption\n write FCaption;\n property Handle : Integer\n read FHandle;\n property IDList : PItemIDList\n read FIDList;\n property SelectedFolder : string\n read FSelectedFolder\n write SetSelectedFolder;\n\n public {methods}\n constructor Create(AOwner : TComponent);\n override;\n destructor Destroy;\n override;\n function Execute : Boolean;\n end;\n{$ENDIF}\n\nvar\n DirDlg: TDirDlg;\n\nimplementation\n\n{$IFNDEF UsingCLX}\n{$R *.dfm}\n{$ENDIF}\n\n{== TAbDirDlg ========================================================}\n{$IFDEF MSWINDOWS}\nfunction AbDirDlgCallbackProc(hWnd : HWND; Msg : UINT; lParam : LPARAM;\n Data : LPARAM): Integer; stdcall;\nvar\n X, Y : Integer;\n R : TRect;\n Buf : array[0..MAX_PATH-1] of Char;\nbegin\n Result := 0;\n with TAbDirDlg(Data) do begin\n case Msg of\n BFFM_INITIALIZED :\n begin\n FHandle := hWnd;\n if (FCaption <> '') then\n SendMessage(hWnd, WM_SETTEXT, 0, Integer(PChar(FCaption)));\n SendMessage(hWnd, BFFM_SETSELECTION, 1, Integer(PChar(SelectedFolder)));\n GetWindowRect(hWnd, R);\n X := (Screen.Width div 2) - ((R.Right - R.Left) div 2);\n Y := (Screen.Height div 2) - ((R.Bottom - R.Top) div 2);\n SetWindowPos(hWnd, 0, X, Y, 0, 0, SWP_NOSIZE or SWP_NOZORDER);\n end;\n BFFM_SELCHANGED :\n if (FHandle <> 0) then begin\n FIDList := PItemIDList(lParam);\n SHGetPathFromIDList(IDList, Buf);\n SelectedFolder := Buf;\n end;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nconstructor TAbDirDlg.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbDirDlg.Destroy;\nbegin\n if FIDList <> nil then\n FreeIDList;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbDirDlg.Execute : Boolean;\nvar\n Info : TBrowseInfo;\n Buf : array[0..MAX_PATH-1] of Char;\nbegin\n if (FIDList <> nil) then\n FreeIDList;\n\n{$IFNDEF UsingClx}\n if (Owner is TWinControl) then\n Info.hwndOwner := (Owner as TWinControl).Handle\n else if Owner is TApplication then\n Info.hwndOwner := (Owner as TApplication).Handle\n else\n{$ENDIF}\n Info.hwndOwner := 0;\n Info.pidlRoot := nil;\n Info.pszDisplayName := Buf;\n Info.lpszTitle := PChar(FAdditionalText);\n Info.ulFlags := BIF_RETURNONLYFSDIRS;\n Info.lpfn := AbDirDlgCallbackProc;\n Info.lParam := Integer(Self);\n Info.iImage := 0;\n\n FIDList := SHBrowseForFolder(Info);\n FHandle := 0;\n Result := (FIDList <> nil);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbDirDlg.FreeIDList;\nvar\n Malloc : IMalloc;\nbegin\n if coGetMalloc(MEMCTX_TASK, Malloc) = NOERROR then begin\n Malloc.Free(FIDList);\n FIDList := nil;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbDirDlg.SetSelectedFolder(const Value : string);\nbegin\n FSelectedFolder := Value;\n if FSelectedFolder <> '' then\n if FSelectedFolder[Length(FSelectedFolder)] = '\\' then\n Delete(FSelectedFolder, Length(FSelectedFolder), 1);\n if (Length(FSelectedFolder) = 2) then\n FSelectedFolder := FSelectedFolder + '\\';\nend;\n{$ENDIF}\n\n{== TDirDlg ========================================================}\n{ TDirDlg }\nprocedure TDirDlg.FormCreate(Sender: TObject);\nbegin\n DirectoryListBox1Change(nil);\n OKBtn.Caption := AbOKS;\n CancelBtn.Caption := AbCancelS;\n Caption := AbSelectDirectoryS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TDirDlg.DirectoryListBox1Change(Sender: TObject);\nbegin\n{$IFNDEF UsingClx}\n SelectedFolder := DirectoryListBox1.Directory;\n{$ENDIF}\n Panel1.Caption := SelectedFolder;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbDlgPwd.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbDlgPwd.pas *}\n{*********************************************************}\n{* ABBREVIA: Dialog - Password *}\n{* Use AbQDgPwd.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbDlgPwd;\n\n{$R *.dfm}\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils,\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n{$IFDEF UsingClx}\n QGraphics, QForms, QControls, QStdCtrls,\n QButtons, QExtCtrls,\n{$ELSE}\n Graphics, Forms, Controls, StdCtrls,\n Buttons, ExtCtrls,\n{$ENDIF}\n Classes;\n\ntype\n TPassWordDlg = class(TForm)\n OKBtn: TButton;\n CancelBtn: TButton;\n Bevel1: TBevel;\n Edit1: TEdit;\n{$IFDEF MSWINDOWS}\n Edit2: TEdit;\n{$ENDIF}\n Label1: TLabel;\n{$IFDEF MSWINDOWS}\n Label2: TLabel;\n{$ENDIF}\n procedure Edit1Change(Sender: TObject);\n procedure Edit2Change(Sender: TObject);\n procedure FormActivate(Sender: TObject);\n procedure FormCreate(Sender: TObject);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\nvar\n PassWordDlg: TPassWordDlg;\n\nimplementation\n\nuses\n AbResString;\n\nprocedure TPassWordDlg.Edit1Change(Sender: TObject);\nbegin\n{$IFDEF MSWINDOWS}\n Edit2.Text := '';\n OKBtn.Enabled := ( CompareStr( Edit1.Text, Edit2.Text ) = 0);\n{$ELSE}\n OKBtn.Enabled := true;\n{$ENDIF}\nend;\n\nprocedure TPassWordDlg.Edit2Change(Sender: TObject);\nbegin\n{$IFDEF MSWINDOWS}\n OKBtn.Enabled := ( CompareStr( Edit1.Text, Edit2.Text ) = 0);\n{$ELSE}\n OKBtn.Enabled := true;\n{$ENDIF}\nend;\n\nprocedure TPassWordDlg.FormActivate(Sender: TObject);\nbegin\n{$IFDEF MSWINDOWS}\n OKBtn.Enabled := ( CompareStr( Edit1.Text, Edit2.Text ) = 0);\n{$ELSE}\n OKBtn.Enabled := true;\n{$ENDIF}\nend;\n\nprocedure TPassWordDlg.FormCreate(Sender: TObject);\nbegin\n Caption := AbEnterPasswordS;\n OKBtn.Caption := AbOKS;\n CancelBtn.Caption := AbCancelS;\n Label1.Caption := AbPasswordS;\n{$IFDEF MSWINDOWS}\n Label2.Caption := AbVerifyS;\n{$ENDIF}\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbExcept.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbExcept.pas *}\n{*********************************************************}\n{* ABBREVIA: Exception classes *}\n{*********************************************************}\n\nunit AbExcept;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils,\n AbUtils;\n\ntype\n EAbException = class( Exception )\n public\n ErrorCode : Integer;\n end;\n\n EAbArchiveBusy = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbBadStream = class( EAbException )\n protected\n FInnerException : Exception;\n public\n constructor Create;\n constructor CreateInner(aInnerException : Exception);\n property InnerException : Exception read FInnerException;\n end;\n\n EAbDuplicateName = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbFileNotFound = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbNoArchive = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbUserAbort = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbNoSuchDirectory = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbUnhandledType = class( EAbException )\n public\n constructor Create;\n end;\n\n EAbSpanningNotSupported = class (EAbException)\n public\n constructor Create;\n end;\n\n EAbInvalidSpanningThreshold = class ( EAbException )\n public\n constructor Create;\n end;\n\n EAbZipException = class( EAbException ); {Zip exception}\n EAbCabException = class( EAbException ); {Cab exception}\n EAbTarException = class( EAbException ); {Tar Exception}\n EAbGzipException = class( EAbException); {GZip exception}\n\n EAbZipBadSpanStream = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipBadCRC = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInflateBlock = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInvalid = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbInvalidIndex = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInvalidFactor = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInvalidLFH = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInvalidMethod = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInvalidPassword = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipInvalidStub= class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipNoExtraction = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipNoInsertion = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipSpanOverwrite= class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipStreamFull = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipTruncate = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipUnsupported = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbZipVersion = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbReadError = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbGzipBadCRC = class( EAbGZipException )\n public\n constructor Create;\n end;\n\n EAbGzipBadFileSize = class( EAbGZipException )\n public\n constructor Create;\n end;\n\n EAbGzipInvalid = class( EAbGZipException )\n public\n constructor Create;\n end;\n\n EAbTarInvalid = class( EAbTarException)\n public\n constructor Create;\n end;\n\n EAbTarBadFileName = class( EAbTarException)\n public\n constructor Create;\n end;\n\n EAbTarBadLinkName = class( EAbTarException)\n public\n constructor Create;\n end;\n\n EAbTarBadOp = class( EAbTarException)\n public\n constructor Create;\n end;\n\n EAbVMSInvalidOrigin = class( EAbZipException )\n public\n constructor Create( Value : Integer );\n end;\n\n EAbVMSErrorOpenSwap = class( EAbZipException )\n public\n constructor Create( const Value : string );\n end;\n\n EAbVMSSeekFail = class( EAbZipException )\n public\n constructor Create( const Value : string );\n end;\n\n EAbVMSReadFail = class( EAbZipException )\n public\n constructor Create( Count : Integer; const Value : string );\n end;\n\n EAbVMSWriteFail = class( EAbZipException )\n public\n constructor Create( Count : Integer; const Value : string );\n end;\n\n EAbVMSWriteTooManyBytes = class( EAbZipException )\n public\n constructor Create( Count : Integer );\n end;\n\n EAbBBSReadTooManyBytes = class( EAbZipException )\n public\n constructor Create(Count : Integer );\n end;\n\n EAbBBSSeekOutsideBuffer = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbBBSInvalidOrigin = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbBBSWriteTooManyBytes = class( EAbZipException )\n public\n constructor Create(Count : Integer );\n end;\n\n EAbSWSNotEndofStream = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbSWSSeekFailed = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbSWSWriteFailed = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbSWSInvalidOrigin = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbSWSInvalidNewOrigin = class( EAbZipException )\n public\n constructor Create;\n end;\n\n EAbNoCabinetDll = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFileOpenError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFileReadError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFileWriteError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFileCloseError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFileSeekError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFileDeleteError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIAddFileError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCICreateError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFlushCabinetError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFCIFlushFolderError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFDICopyError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFDICreateError = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbInvalidCabTemplate = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbInvalidCabFile = class( EAbCabException )\n public\n constructor Create;\n end;\n\n EAbFileTooLarge = class(EAbException)\n public\n constructor Create;\n end;\n\n procedure AbConvertException( const E : Exception;\n var eClass : TAbErrorClass;\n var eErrorCode : Integer );\n\n\nimplementation\n\nuses\n Classes,\n AbConst,\n AbResString;\n\nconstructor EAbArchiveBusy.Create;\nbegin\n inherited Create(AbArchiveBusyS);\n ErrorCode := AbArchiveBusy;\nend;\n\nconstructor EAbBadStream.Create;\nbegin\n inherited Create(AbBadStreamTypeS);\n FInnerException := nil;\n ErrorCode := AbBadStreamType;\nend;\n\nconstructor EAbBadStream.CreateInner(aInnerException: Exception);\nbegin\n inherited Create(AbBadStreamTypeS + #13#10 + aInnerException.Message);\n FInnerException := aInnerException;\n ErrorCode := AbBadStreamType;\nend;\n\n\nconstructor EAbDuplicateName.Create;\nbegin\n inherited Create(AbDuplicateNameS);\n ErrorCode := AbDuplicateName;\nend;\n\nconstructor EAbNoSuchDirectory.Create;\nbegin\n inherited Create(AbNoSuchDirectoryS);\n ErrorCode := AbNoSuchDirectory;\nend;\n\nconstructor EAbInvalidSpanningThreshold.Create;\nbegin\n inherited Create(AbInvalidThresholdS);\n ErrorCode := AbInvalidThreshold;\nend;\n\nconstructor EAbFileNotFound.Create;\nbegin\n inherited Create(AbFileNotFoundS);\n ErrorCode := AbFileNotFound;\nend;\n\nconstructor EAbNoArchive.Create;\nbegin\n inherited Create(AbNoArchiveS);\n ErrorCode := AbNoArchive;\nend;\n\nconstructor EAbUserAbort.Create;\nbegin\n inherited Create(AbUserAbortS);\n ErrorCode := AbUserAbort;\nend;\n\nconstructor EAbZipBadSpanStream.Create;\nbegin\n inherited Create(AbBadSpanStreamS);\n ErrorCode := AbBadSpanStream;\nend;\n\nconstructor EAbZipBadCRC.Create;\nbegin\n inherited Create(AbZipBadCRCS);\n ErrorCode := AbZipBadCRC;\nend;\n\nconstructor EAbZipInflateBlock.Create;\nbegin\n inherited Create(AbInflateBlockErrorS);\n ErrorCode := AbInflateBlockError;\nend;\n\nconstructor EAbZipInvalid.Create;\nbegin\n inherited Create(AbErrZipInvalidS);\n ErrorCode := AbErrZipInvalid;\nend;\n\nconstructor EAbInvalidIndex.Create;\nbegin\n inherited Create(AbInvalidIndexS);\n ErrorCode := AbInvalidIndex;\nend;\n\nconstructor EAbZipInvalidFactor.Create;\nbegin\n inherited Create(AbInvalidFactorS);\n ErrorCode := AbInvalidFactor;\nend;\n\nconstructor EAbZipInvalidLFH.Create;\nbegin\n inherited Create(AbInvalidLFHS);\n ErrorCode := AbInvalidLFH;\nend;\n\nconstructor EAbZipInvalidMethod.Create;\nbegin\n inherited Create(AbUnknownCompressionMethodS);\n ErrorCode := AbUnknownCompressionMethod;\nend;\n\nconstructor EAbZipInvalidPassword.Create;\nbegin\n inherited Create(AbInvalidPasswordS);\n ErrorCode := AbInvalidPassword;\nend;\n\nconstructor EAbZipInvalidStub.Create;\nbegin\n inherited Create(AbZipBadStubS);\n ErrorCode := AbZipBadStub;\nend;\n\nconstructor EAbZipNoExtraction.Create;\nbegin\n inherited Create(AbNoExtractionMethodS);\n ErrorCode := AbNoExtractionMethod;\nend;\n\nconstructor EAbZipNoInsertion.Create;\nbegin\n inherited Create(AbNoInsertionMethodS);\n ErrorCode := AbNoInsertionMethod;\nend;\n\nconstructor EAbZipSpanOverwrite.Create;\nbegin\n inherited Create(AbNoOverwriteSpanStreamS);\n ErrorCode := AbNoOverwriteSpanStream;\nend;\n\nconstructor EAbZipStreamFull.Create;\nbegin\n inherited Create(AbStreamFullS);\n ErrorCode := AbStreamFull;\nend;\n\nconstructor EAbZipTruncate.Create;\nbegin\n inherited Create(AbTruncateErrorS);\n ErrorCode := AbTruncateError;\nend;\n\nconstructor EAbZipUnsupported.Create;\nbegin\n inherited Create(AbUnsupportedCompressionMethodS);\n ErrorCode := AbUnsupportedCompressionMethod;\nend;\n\nconstructor EAbZipVersion.Create;\nbegin\n inherited Create(AbZipVersionNeededS);\n ErrorCode := AbZipVersionNeeded;\nend;\n\nconstructor EAbReadError.Create;\nbegin\n inherited Create(AbReadErrorS);\n ErrorCode := AbReadError;\nend;\n\nconstructor EAbVMSInvalidOrigin.Create( Value : Integer );\nbegin\n inherited Create(Format(AbVMSInvalidOriginS, [Value]));\n ErrorCode := AbVMSInvalidOrigin;\nend;\n\nconstructor EAbBBSReadTooManyBytes.Create(Count : Integer );\nbegin\n inherited Create(Format(AbBBSReadTooManyBytesS, [Count]));\n ErrorCode := AbBBSReadTooManyBytes;\nend;\n\nconstructor EAbBBSSeekOutsideBuffer.Create;\nbegin\n inherited Create(AbBBSSeekOutsideBufferS);\n ErrorCode := AbBBSSeekOutsideBuffer;\nend;\n\nconstructor EAbBBSInvalidOrigin.Create;\nbegin\n inherited Create(AbBBSInvalidOriginS);\n ErrorCode := AbBBSInvalidOrigin;\nend;\n\nconstructor EAbBBSWriteTooManyBytes.Create(Count : Integer);\nbegin\n inherited Create(Format(AbBBSWriteTooManyBytesS, [Count]));\n ErrorCode := AbBBSWriteTooManyBytes;\nend;\n\nconstructor EAbVMSErrorOpenSwap.Create( const Value : string );\nbegin\n inherited Create(Format(AbVMSErrorOpenSwapS, [Value]));\n ErrorCode := AbVMSErrorOpenSwap;\nend;\n\nconstructor EAbVMSSeekFail.Create( const Value : string );\nbegin\n inherited Create(Format(AbVMSSeekFailS, [Value]));\n ErrorCode := AbVMSSeekFail;\nend;\n\nconstructor EAbVMSReadFail.Create( Count : Integer; const Value : string );\nbegin\n inherited Create(Format(AbVMSReadFailS, [Count, Value]));\n ErrorCode := AbVMSReadFail;\nend;\n\nconstructor EAbVMSWriteFail.Create( Count : Integer; const Value : string );\nbegin\n inherited Create(Format(AbVMSWriteFailS, [Count, Value]));\n ErrorCode := AbVMSWriteFail;\nend;\n\nconstructor EAbVMSWriteTooManyBytes.Create( Count : Integer );\nbegin\n inherited Create(Format(AbVMSWriteTooManyBytesS, [Count]));\n ErrorCode := AbVMSWriteTooManyBytes;\nend;\n\nconstructor EAbSWSNotEndofStream.Create;\nbegin\n inherited Create(AbSWSNotEndofStreamS);\n ErrorCode := AbSWSNotEndofStream;\nend;\n\nconstructor EAbSWSSeekFailed.Create;\nbegin\n inherited Create(AbSWSSeekFailedS);\n ErrorCode := AbSWSSeekFailed;\nend;\n\nconstructor EAbSWSWriteFailed.Create;\nbegin\n inherited Create(AbSWSWriteFailedS);\n ErrorCode := AbSWSWriteFailed;\nend;\n\nconstructor EAbSWSInvalidOrigin.Create;\nbegin\n inherited Create(AbSWSInvalidOriginS);\n ErrorCode := AbSWSInvalidOrigin;\nend;\n\nconstructor EAbSWSInvalidNewOrigin.Create;\nbegin\n inherited Create(AbSWSInvalidNewOriginS);\n ErrorCode := AbSWSInvalidNewOrigin;\nend;\n\nconstructor EAbFCIFileOpenError.Create;\nbegin\n inherited Create(AbFCIFileOpenErrorS);\n ErrorCode := AbFCIFileOpenError;\nend;\n\nconstructor EAbNoCabinetDll.Create;\nbegin\n inherited Create(AbNoCabinetDllErrorS);\n ErrorCode := AbNoCabinetDllError;\nend;\n\nconstructor EAbFCIFileReadError.Create;\nbegin\n inherited Create(AbFCIFileReadErrorS);\n ErrorCode := AbFCIFileReadError;\nend;\n\nconstructor EAbFCIFileWriteError.Create;\nbegin\n inherited Create(AbFCIFileWriteErrorS);\n ErrorCode := AbFCIFileWriteError;\nend;\n\nconstructor EAbFCIFileCloseError.Create;\nbegin\n inherited Create(AbFCIFileCloseErrorS);\n ErrorCode := AbFCIFileCloseError;\nend;\n\nconstructor EAbFCIFileSeekError.Create;\nbegin\n inherited Create(AbFCIFileSeekErrorS);\n ErrorCode := AbFCIFileSeekError;\nend;\n\nconstructor EAbFCIFileDeleteError.Create;\nbegin\n inherited Create(AbFCIFileDeleteErrorS);\n ErrorCode := AbFCIFileDeleteError;\nend;\n\nconstructor EAbFCIAddFileError.Create;\nbegin\n inherited Create(AbFCIAddFileErrorS);\n ErrorCode := AbFCIAddFileError;\nend;\n\nconstructor EAbFCICreateError.Create;\nbegin\n inherited Create(AbFCICreateErrorS);\n ErrorCode := AbFCICreateError;\nend;\n\nconstructor EAbFCIFlushCabinetError.Create;\nbegin\n inherited Create(AbFCIFlushCabinetErrorS);\n ErrorCode := AbFCIFlushCabinetError;\nend;\n\nconstructor EAbFCIFlushFolderError.Create;\nbegin\n inherited Create(AbFCIFlushFolderErrorS);\n ErrorCode := AbFCIFlushFolderError;\nend;\n\nconstructor EAbFDICopyError.Create;\nbegin\n inherited Create(AbFDICopyErrorS);\n ErrorCode := AbFDICopyError;\nend;\n\nconstructor EAbFDICreateError.Create;\nbegin\n inherited Create(AbFDICreateErrorS);\n ErrorCode := AbFDICreateError;\nend;\n\nconstructor EAbInvalidCabTemplate.Create;\nbegin\n inherited Create(AbInvalidCabTemplateS);\n ErrorCode := AbInvalidCabTemplate;\nend;\n\nconstructor EAbInvalidCabFile.Create;\nbegin\n inherited Create(AbInvalidCabFileS);\n ErrorCode := AbInvalidCabFile;\nend;\n\nprocedure AbConvertException( const E : Exception;\n var eClass : TAbErrorClass;\n var eErrorCode : Integer );\nbegin\n eClass := ecOther;\n eErrorCode := 0;\n if E is EAbException then begin\n eClass := ecAbbrevia;\n eErrorCode := (E as EAbException).ErrorCode;\n end\n else if E is EInOutError then begin\n eClass := ecInOutError;\n eErrorCode := (E as EInOutError).ErrorCode;\n end\n else if E is EFilerError then\n eClass := ecFilerError\n else if E is EFOpenError then\n eClass := ecFileOpenError\n else if E is EFCreateError then\n eClass := ecFileCreateError;\nend;\n\n{ EAbUnhandledType }\n\nconstructor EAbUnhandledType.Create;\nbegin\n inherited Create(AbUnhandledFileTypeS);\n ErrorCode := AbUnhandledFileType;\nend;\n\n{ EAbGzipBadCRC }\n\nconstructor EAbGzipBadCRC.Create;\nbegin\n inherited Create(AbGzipBadCRCS);\n ErrorCode := AbGzipBadCRC;\nend;\n\n{ EAbGzipBadFileSize }\n\nconstructor EAbGzipBadFileSize.Create;\nbegin\n inherited Create(AbGzipBadFileSizeS);\n ErrorCode := AbGzipBadFileSize;\nend;\n\n{ EAbGzipInvalid }\n\nconstructor EAbGzipInvalid.Create;\nbegin\n inherited Create(AbSpanningNotSupportedS);\n ErrorCode := AbSpanningNotSupported;\n\nend;\n\n{ EAbTarInvalid }\n\nconstructor EAbTarInvalid.Create;\nbegin\n inherited Create(AbTarInvalidS);\n ErrorCode := AbTarInvalid;\nend;\n\n{ EAbTarBadFileName }\n\nconstructor EAbTarBadFileName.Create;\nbegin\n inherited Create(AbTarBadFileNameS);\n ErrorCode := AbTarBadFileName;\nend;\n\n{ EAbTarBadLinkName }\n\nconstructor EAbTarBadLinkName.Create;\nbegin\n inherited Create(AbTarBadLinkNameS);\n ErrorCode := AbTarBadLinkName;\nend;\n\n{ EAbTarBadOp }\n\nconstructor EAbTarBadOp.Create;\nbegin\n inherited Create(AbTarBadOpS);\n ErrorCode := AbTarBadOp;\nend;\n\n{ EAbSpanningNotSupported }\n\nconstructor EAbSpanningNotSupported.Create;\nbegin\n inherited Create(AbSpanningNotSupportedS);\n ErrorCode := AbSpanningNotSupported;\nend;\n\n{ EAbFileTooLarge }\n\nconstructor EAbFileTooLarge.Create;\nbegin\n {TODO Create const and fix wording}\n inherited Create(AbFileSizeTooBigS);\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbFciFdi.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbFciFdi.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet DLL wrapper *}\n{* Based on info from the FCI/FDI Library Description, *}\n{* included in the Microsoft Cabinet SDK *}\n{*********************************************************}\n\nunit AbFciFdi;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Windows, AbUtils;\n\nconst\n CabinetDLL = 'cabinet.dll';\n cpuUnknown = -1;\n cpu80286 = 0;\n cpu80386 = 1;\n cpuDefault = cpuUnknown;\n\n\ntype\n {FDI errors}\n FDIError =\n (FDIError_None, FDIError_Cabinet_Not_Found,\n FDIError_Not_A_Cabinet, FDIError_Unknown_Cabinet_Version,\n FDIError_Corrupt_Cabinet, FDIError_Alloc_Fail,\n FDIError_Bad_Compr_Type, FDIError_MDI_Fail,\n FDIError_Target_File, FDIError_Reserve_Mismatch,\n FDIError_Wrong_Cabinet, FDIError_User_Abort);\n\n {FCI errors}\n FCIError =\n (FCIError_NONE, FCIError_Open_SRC,\n FCIError_Read_SRC, FCIError_Alloc_Fail,\n FCIError_Temp_File, FCIError_Bad_Compr_Type,\n FCIError_Cab_File, FCIError_User_Abort,\n FCIERRor_MCI_Fail);\n\n {FDI notifications}\n FDINotificationType =\n (FDINT_Cabinet_Info, FDINT_Partial_File,\n FDINT_Copy_File, FDINT_Close_File_Info,\n FDINT_Next_Cabinet, FDINT_Enumerate);\n\n {FDI/FCI error structure}\n PCabErrorRecord = ^CabErrorRecord;\n CabErrorRecord = record\n ErrorCode : Integer;\n ErrorType : Integer;\n ErrorPresent : BOOL;\n end;\n\n {FDI cabinet information structure}\n PFDICabInfo = ^FDICabInfo;\n FDICabInfo = record\n cbCabinet : Longint;\n cFolders : Word;\n cFiles : Word;\n setID : Word;\n iCabinet : Word;\n fReserve : BOOL;\n hasprev : BOOL;\n hasnext : BOOL;\n end;\n\n {FCI cabinet information structure}\n PFCICabInfo = ^FCICabInfo;\n FCICabInfo = record\n cb : Longint;\n cbFolderThresh : Longint;\n cbReserveCFHeader : Integer;\n cbReserveCFFolder : Integer;\n cbReserveCFData : Integer;\n iCab : Integer;\n iDisk : Integer;\n fFailOnIncompressible : Integer;\n setID : Word;\n szDisk : array[0..255] of AnsiChar;\n szCab : array[0..255] of AnsiChar;\n szCabPath : array[0..255] of AnsiChar;\n end;\n\n {FDI notification structure}\n PFDINotification = ^FDINotification;\n FDINotification = record\n cb : Longint;\n psz1 : PAnsiChar;\n psz2 : PAnsiChar;\n psz3 : PAnsiChar;\n pv : Pointer;\n hf : PtrInt;\n date : Word;\n time : Word;\n attribs : Word;\n setID : Word;\n iCabinet : Word;\n iFolder : Word;\n fdie : FDIERROR;\n end;\n\n {misc defines}\n HFDI = Pointer;\n HFCI = Pointer;\n FARPROC = Pointer;\n\n\n{== Cabinet DLL routine prototypes ==========================================}\ntype\n TFDICreate =\n function (pfnalloc, pfnfree, pfnopen, pfnread, pfnwrite, pfnclose,\n pfnseek : FARPROC; cpuType : Integer; pError : PCabErrorRecord) : HFDI;\n cdecl;\n{----------------------------------------------------------------------------}\n TFDIIsCabinet =\n function(hfdi : HFDI; hf : PtrInt; pfdici : PFDICabInfo) : BOOL;\n cdecl;\n{----------------------------------------------------------------------------}\n TFDICopy =\n function(hfdi : HFDI; pszCabinet, pszCabPath : PAnsiChar;\n flags : Integer; pfnfdin, pfnfdid : FARPROC; Archive : Pointer) : BOOL;\n cdecl;\n{----------------------------------------------------------------------------}\n TFDIDestroy =\n function(hfdi : HFDI) : BOOL;\n cdecl;\n{----------------------------------------------------------------------------}\n TFCICreate =\n function(pError : PCabErrorRecord; pfnfcifp, pfnalloc, pfnfree,\n pfnopen, pfnread, pfnwrite, pfnclose, pfnseek, pfndelete,\n pfnfcigtf : FARPROC; pccab : PFCICabInfo; Archive : Pointer) : HFCI;\n cdecl;\n{----------------------------------------------------------------------------}\n TFCIAddFile =\n function(hfci : HFCI; pszFilePath, pszFileName : PAnsiChar;\n\t fExecute : BOOL; pfnfcignc, pfnfcis, pfnfcigoi : FARPROC;\n typeCompress : Word) : BOOL;\n cdecl;\n{----------------------------------------------------------------------------}\n TFCIFlushCabinet =\n\tfunction(hfci : HFCI; fGetNextCab : BOOL;\n pfnfcignc, pfnfcis : FARPROC) : BOOL;\n cdecl;\n{----------------------------------------------------------------------------}\n TFCIFlushFolder =\n\tfunction(hfci : HFCI; pfnfcignc, pfnfcis : FARPROC) : BOOL;\n cdecl;\n{----------------------------------------------------------------------------}\n TFCIDestroy =\n function(hfci : HFCI) : BOOL;\n cdecl;\n\n\n{== DLL routine wrappers ====================================================}\nfunction FDICreate(pfnalloc, pfnfree, pfnopen, pfnread,\n pfnwrite, pfnclose, pfnseek : FARPROC;\n cpuType : Integer; pError : PCabErrorRecord) : HFDI;\n {returns an FDI context for opening an existing cabinet}\n { pfnalloc - heap allocation callback function }\n { pfnfree - heap deallocation callback function }\n { pfnopen - open file callback function }\n { pfnwrite - write file callback function }\n { pfnclose - close file callback function }\n { pfnseek - reposition file pointer callback function }\n { cpuType - -1: unknown, 0: 80286, 1: 80386 }\n { pError - pointer to error record }\n{----------------------------------------------------------------------------}\nfunction FDIIsCabinet(hfdi : HFDI; hf : PtrInt;\n pfdici : PFDICabInfo) : BOOL;\n {checks cabinet file for validity}\n { hfdi - FDI context }\n { hf - cabinet file handle }\n { pfdici - pointer to FDI cabinet info structure }\n{----------------------------------------------------------------------------}\nfunction FDICopy(hfdi : HFDI; pszCabinet, pszCabPath : PAnsiChar;\n flags : Integer; pfnfdin, pfnfdid : FARPROC;\n Archive : Pointer) : BOOL;\n {enumerates every file in the cabinet. The callback function }\n {should indicate whether or not to extract a given file}\n { hfdi - FDI context }\n { pszCabinet - cabinet file name }\n { pszCabPath - cabinet file path }\n { flags - currently not used }\n { pfnfdin - FDI notifaction callback function }\n { pfnfdid - decryption callback (currently not used)}\n { Archive - the calling TAbCabArchive instance }\n{----------------------------------------------------------------------------}\nfunction FDIDestroy(hfdi : HFDI) : BOOL;\n {releases FDI context and frees resources}\n { hfdi - FDI context }\n{----------------------------------------------------------------------------}\nfunction FCICreate(pError : PCabErrorRecord;\n pfnfcifp, pfnalloc, pfnfree, pfnopen, pfnread, pfnwrite, pfnclose,\n pfnseek, pfndelete, pfnfcigtf : FARPROC;\n pccab : PFCICabInfo; Archive : Pointer) : HFCI;\n {creates a new cabinet file and returns the FCI context}\n { pError - pointer to error record }\n { pfnfcifp - callback notification when file has been placed in cabinet }\n { pfnalloc - callback function to allocate memory }\n { pfnfree - callback function to free memory }\n { pfnopen - callback function to open a file }\n { pfnwrite - callback function to write to a file }\n { pfnclose - callback function to close a file }\n { pfnseek - callback function to reposition file pointer }\n { pfndelete - callback function to delete a file }\n { pfnfcigtf - callback function to obtain temp filename }\n { pccab - pointer to FCI cabinet infor structure }\n { Archive - the calling TAbCabArchive instance }\n{----------------------------------------------------------------------------}\nfunction FCIAddFile(hfci : HFCI; pszFilePath, pszFileName : PAnsiChar;\n fExecute : BOOL; pfnfcignc, pfnfcis, pfnfcigoi : FARPROC;\n typeCompress : Word) : BOOL;\n {adds a file to the cabinet}\n { hfci - FCI context }\n { pszFilePath - full pathname of file being added }\n { pszFileName - just the file name }\n { fExecute - flag to indicate if file is executable }\n { pfnfcignc - callback function to obtain next cabinet info }\n { pfnfcis - callback function to relay progress }\n { pfnfcigoi - callback function to open file and get attributes }\n { typeCompress - compression type to use }\n{----------------------------------------------------------------------------}\nfunction FCIFlushCabinet(hfci : HFCI; fGetNextCab : BOOL;\n pfnfcignc, pfnfcis : FARPROC) : BOOL;\n {writes current cabinet file out to disk and optionally starts a new one}\n { hfci - FCI context }\n { fGetNextCab - flag indicating whether to start a new cabinet }\n { pfnfcignc - callback function to obtain next cabinet info }\n { pfnfcis - callback function to relay progress }\n{----------------------------------------------------------------------------}\nfunction FCIFlushFolder(hfci : HFCI;\n pfnfcignc, pfnfcis : FARPROC) : BOOL;\n {close current compression block and start a new one}\n { hfci - FCI context }\n { pfnfcignc - callback function to obtain next cabinet info }\n { pfnfcis - callback function to relay progress }\n{----------------------------------------------------------------------------}\nfunction FCIDestroy(hfci : HFCI) : BOOL;\n {releases FCI context and frees resources}\n { hfdi - FDI context }\n{----------------------------------------------------------------------------}\n\n\nimplementation\n\nuses\n AbExcept;\n\n\nvar\n CabDLLLoaded : Boolean;\n CabDLLHandle : THandle;\n FDICreateProc : TFDICreate;\n FDIIsCabinetProc : TFDIIsCabinet;\n FDICopyProc : TFDICopy;\n FDIDestroyProc : TFDIDestroy;\n FCICreateProc : TFCICreate;\n FCIAddFileProc : TFCIAddFile;\n FCIFlushCabinetProc : TFCIFlushCabinet;\n FCIFlushFolderProc : TFCIFlushFolder;\n FCIDestroyProc : TFCIDestroy;\n\n\n{============================================================================}\nprocedure LoadCabinetDLL;\nbegin\n if CabDllLoaded then\n Exit;\n CabDllHandle := LoadLibrary(CabinetDLL);\n if (CabDllHandle = 0) then\n raise EAbNoCabinetDLL.Create;\n @FDICreateProc := GetProcAddress(CabDllHandle, 'FDICreate');\n @FDIIsCabinetProc := GetProcAddress(CabDllHandle, 'FDIIsCabinet');\n @FDICopyProc := GetProcAddress(CabDllHandle, 'FDICopy');\n @FDIDestroyProc := GetProcAddress(CabDllHandle, 'FDIDestroy');\n @FCICreateProc := GetProcAddress(CabDllHandle, 'FCICreate');\n @FCIAddFileProc := GetProcAddress(CabDllHandle, 'FCIAddFile');\n @FCIFlushCabinetProc := GetProcAddress(CabDllHandle, 'FCIFlushCabinet');\n @FCIFlushFolderProc := GetProcAddress(CabDllHandle, 'FCIFlushFolder');\n @FCIDestroyProc := GetProcAddress(CabDllHandle, 'FCIDestroy');\n CabDllLoaded := True;\nend;\n{----------------------------------------------------------------------------}\nfunction FDICreate(pfnalloc, pfnfree, pfnopen, pfnread,\n pfnwrite, pfnclose, pfnseek : FARPROC;\n cpuType : Integer; pError : PCabErrorRecord) : HFDI;\nbegin\n LoadCabinetDLL;\n if Assigned(FDICreateProc) then\n Result := FDICreateProc(pfnalloc, pfnfree, pfnopen, pfnread,\n pfnwrite, pfnclose, pfnseek, cpuType, pError)\n else\n Result := nil;\nend;\n{----------------------------------------------------------------------------}\nfunction FDIIsCabinet(hfdi : HFDI; hf : PtrInt;\n pfdici : PFDICabInfo) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FDIIsCabinetProc) then\n Result := FDIIsCabinetProc(hfdi, hf, pfdici)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\nfunction FDICopy(hfdi : HFDI; pszCabinet, pszCabPath : PAnsiChar;\n flags : Integer; pfnfdin, pfnfdid : FARPROC;\n Archive : Pointer) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FDICopyProc) then\n Result := FDICopyProc(hfdi, pszCabinet, pszCabPath, flags,\n pfnfdin, pfnfdid, Archive)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\nfunction FDIDestroy(hfdi : HFDI) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FDIDestroyProc) then\n Result := FDIDestroyProc(hfdi)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\nfunction FCICreate(pError : PCabErrorRecord;\n pfnfcifp, pfnalloc, pfnfree, pfnopen, pfnread, pfnwrite, pfnclose,\n pfnseek, pfndelete, pfnfcigtf : FARPROC;\n pccab : PFCICabInfo; Archive : Pointer) : HFCI;\nbegin\n LoadCabinetDLL;\n if Assigned(FCICreateProc) then\n Result := FCICreateProc(pError, pfnfcifp, pfnalloc, pfnfree, pfnopen,\n pfnread, pfnwrite, pfnclose, pfnseek, pfndelete, pfnfcigtf,\n pccab, Archive)\n else\n Result := nil;\nend;\n{----------------------------------------------------------------------------}\nfunction FCIAddFile(hfci : HFCI; pszFilePath, pszFileName : PAnsiChar;\n fExecute : BOOL; pfnfcignc, pfnfcis, pfnfcigoi : FARPROC;\n typeCompress : Word) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FCIAddFileProc) then\n Result := FCIAddFileProc(hfci, pszFilePath, pszFileName,\n fExecute, pfnfcignc, pfnfcis, pfnfcigoi, typeCompress)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\nfunction FCIFlushCabinet(hfci : HFCI; fGetNextCab : BOOL;\n pfnfcignc, pfnfcis : FARPROC) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FCIFlushCabinetProc) then\n Result := FCIFlushCabinetProc(hfci, fGetNextCab, pfnfcignc, pfnfcis)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\nfunction FCIFlushFolder(hfci : HFCI;\n pfnfcignc, pfnfcis : FARPROC) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FCIFlushFolderProc) then\n Result := FCIFlushFolderProc(hfci, pfnfcignc, pfnfcis)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\nfunction FCIDestroy(hfci : HFCI) : BOOL;\nbegin\n LoadCabinetDLL;\n if Assigned(FCIDestroyProc) then\n Result := FCIDestroyProc(hfci)\n else\n Result := False;\nend;\n{----------------------------------------------------------------------------}\ninitialization\n CabDllLoaded := False;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbGzTyp.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbGzTyp.pas *}\n{*********************************************************}\n{* ABBREVIA: TAbGzipArchive, TAbGzipItem classes *}\n{*********************************************************}\n{* Misc. constants, types, and routines for working *}\n{* with GZip files *}\n{* See: RFC 1952 *}\n{* \"GZIP file format specification version 4.3\" *}\n{* for more information on GZip *}\n{* See \"algorithm.doc\" in Gzip source and \"format.txt\" *}\n{* on gzip.org for differences from RFC *}\n{*********************************************************}\n\nunit AbGzTyp;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes, AbUtils, AbArcTyp, AbTarTyp, AbVMStrm;\n\ntype\n { pre-defined \"operating system\" (really more FILE system)\n types for the Gzip header }\n TAbGzFileSystem =\n (osFat, osAmiga, osVMS, osUnix, osVM_CMS, osAtariTOS,\n osHPFS, osMacintosh, osZSystem, osCP_M, osTOPS20,\n osNTFS, osQDOS, osAcornRISCOS, osVFAT, osMVS, osBeOS,\n osTandem, osTHEOS, osUnknown, osUndefined);\n\ntype\n PAbGzHeader = ^TAbGzHeader;\n TAbGzHeader = packed record { SizeOf(TGzHeader) = 10}\n ID1 : Byte; { ID Byte, should always be $1F}\n ID2 : Byte; { ID Byte, should always be $8B}\n CompMethod : Byte; { compression method used}\n { 0..7 reserved, 8 = deflate, others undefined as of this writing (4/27/2001)}\n Flags : Byte; { misc flags}\n { Bit 0: FTEXT compressed file contains text, can be used for}\n { cross platform line termination translation}\n { Bit 1: FCONTINUATION file is a continuation of a multi-part gzip file}\n { RFC 1952 says this is the header CRC16 flag, but gzip}\n { reserves it and won't extract the file if this is set}\n { header data includes part number after header record}\n { Bit 2: FEXTRA header data contains Extra Data, starts after part}\n { number (if any)}\n { Bit 3: FNAME header data contains FileName, null terminated}\n { string starting immediately after Extra Data (if any)}\n { RFC 1952 says this is ISO 8859-1 encoded, but gzip}\n { always uses the system encoding}\n { Bit 4: FCOMMENT header data contains Comment, null terminated string}\n { starting immediately after FileName (if any)}\n { Bit 5: FENCRYPTED file is encrypted using zip-1.9 encryption }\n { header data contains a 12-byte encryption header }\n { starting immediately after Comment. Documented in}\n { \"algorithm.doc\", but unsupported in gzip}\n { Bits 6..7 are undefined and reserved as of this writing (8/25/2009)}\n ModTime : LongInt; { File Modification (Creation) time,}\n { UNIX cdate format}\n XtraFlags : Byte; { additional flags}\n { XtraFlags = 2 -- Deflate compressor used maximum compression algorithm}\n { XtraFlags = 4 -- Deflate compressor used fastest algorithm}\n OS : Byte; { Operating system that created file,}\n { see GZOsToStr routine for values}\n end;\n\n TAbGzTailRec = packed record\n CRC32 : LongInt; { crc for uncompressed data }\n ISize : LongWord; { size of uncompressed data }\n end;\n\n TAbGzExtraFieldSubID = array[0..1] of AnsiChar;\n\ntype\n TAbGzipExtraField = class(TAbExtraField)\n private\n FGZHeader : PAbGzHeader;\n function GetID(aIndex : Integer): TAbGzExtraFieldSubID;\n protected\n procedure Changed; override;\n public\n constructor Create(aGZHeader : PAbGzHeader);\n procedure Delete(aID : TAbGzExtraFieldSubID);\n function Get(aID : TAbGzExtraFieldSubID;\n out aData : Pointer; out aDataSize : Word) : Boolean;\n procedure Put(aID : TAbGzExtraFieldSubID; const aData; aDataSize : Word);\n public\n property IDs[aIndex : Integer]: TAbGzExtraFieldSubID\n read GetID;\n end;\n\n TAbGzipItem = class(TAbArchiveItem)\n protected {private}\n FGZHeader : TAbGzHeader;\n FExtraField : TAbGzipExtraField;\n FFileComment : AnsiString;\n FRawFileName : AnsiString;\n\n protected\n function GetFileSystem: TAbGzFileSystem;\n function GetHasExtraField: Boolean;\n function GetHasFileComment: Boolean;\n function GetHasFileName: Boolean;\n function GetIsText: Boolean;\n\n procedure SetFileComment(const Value : AnsiString);\n procedure SetFileSystem(const Value: TAbGzFileSystem);\n procedure SetIsText(const Value: Boolean);\n\n function GetExternalFileAttributes : LongWord; override;\n function GetIsEncrypted : Boolean; override;\n function GetLastModFileDate : Word; override;\n function GetLastModFileTime : Word; override;\n function GetLastModTimeAsDateTime: TDateTime; override;\n\n procedure SetExternalFileAttributes( Value : LongWord ); override;\n procedure SetFileName(const Value : string); override;\n procedure SetIsEncrypted(Value : Boolean); override;\n procedure SetLastModFileDate(const Value : Word); override;\n procedure SetLastModFileTime(const Value : Word); override;\n procedure SetLastModTimeAsDateTime(const Value: TDateTime); override;\n\n procedure SaveGzHeaderToStream(AStream : TStream);\n procedure LoadGzHeaderFromStream(AStream : TStream);\n public\n property CompressionMethod : Byte\n read FGZHeader.CompMethod;\n\n property ExtraFlags : Byte {Default: 2}\n read FGZHeader.XtraFlags write FGZHeader.XtraFlags;\n\n property Flags : Byte\n read FGZHeader.Flags;\n\n property FileComment : AnsiString\n read FFileComment write SetFileComment;\n\n property FileSystem : TAbGzFileSystem {Default: osFat (Windows); osUnix (Linux)}\n read GetFileSystem write SetFileSystem;\n\n property ExtraField : TAbGzipExtraField\n read FExtraField;\n\n property IsEncrypted : Boolean\n read GetIsEncrypted;\n\n property HasExtraField : Boolean\n read GetHasExtraField;\n\n property HasFileName : Boolean\n read GetHasFileName;\n\n property HasFileComment : Boolean\n read GetHasFileComment;\n\n property IsText : Boolean\n read GetIsText write SetIsText;\n\n property GZHeader : TAbGzHeader\n read FGZHeader;\n\n constructor Create;\n destructor Destroy; override;\n end;\n\n TAbGzipStreamHelper = class(TAbArchiveStreamHelper)\n private\n function GetGzCRC: LongInt;\n function GetFileSize: LongInt;\n protected {private}\n FItem : TAbGzipItem;\n FTail : TAbGzTailRec;\n public\n constructor Create(AStream : TStream);\n destructor Destroy; override;\n\n procedure ExtractItemData(AStream : TStream); override;\n function FindFirstItem : Boolean; override;\n function FindNextItem : Boolean; override;\n function SeekItem(Index : Integer): Boolean; override;\n procedure SeekToItemData;\n procedure WriteArchiveHeader; override;\n procedure WriteArchiveItem(AStream : TStream); override;\n procedure WriteArchiveTail; override;\n function GetItemCount : Integer; override;\n procedure ReadHeader; override;\n procedure ReadTail; override;\n\n property CRC : LongInt\n read GetGzCRC;\n property FileSize : LongInt\n read GetFileSize;\n property TailCRC : LongInt\n read FTail.CRC32;\n property TailSize : LongWord\n read FTail.ISize;\n end;\n\n TAbGzipArchiveState = (gsGzip, gsTar);\n\n TAbGzipArchive = class(TAbTarArchive)\n private\n FGZStream : TStream; { stream for GZip file}\n FGZItem : TAbArchiveList; { item in Gzip (only one, but need polymorphism of class)}\n FTarStream : TAbVirtualMemoryStream; { stream for possible contained Tar }\n FTarList : TAbArchiveList; { items in possible contained Tar }\n FTarAutoHandle: Boolean;\n FState : TAbGzipArchiveState;\n FIsGzippedTar : Boolean;\n\n procedure SetTarAutoHandle(const Value: Boolean);\n function GetIsGzippedTar: Boolean;\n procedure SwapToGzip;\n procedure SwapToTar;\n\n protected\n function CreateItem(const FileSpec : string): TAbArchiveItem;\n override;\n procedure ExtractItemAt(Index : Integer; const UseName : string);\n override;\n procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);\n override;\n procedure LoadArchive;\n override;\n procedure SaveArchive;\n override;\n procedure TestItemAt(Index : Integer);\n override;\n function FixName(const Value : string) : string;\n override;\n function GetSupportsEmptyFolders : Boolean;\n override;\n\n function GetItem(Index: Integer): TAbGzipItem;\n procedure PutItem(Index: Integer; const Value: TAbGzipItem);\n public {methods}\n constructor CreateFromStream(aStream : TStream; const aArchiveName : string);\n override;\n destructor Destroy;\n override;\n\n procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer;\n var ImageName : string; var Abort : Boolean); override;\n\n property TarAutoHandle : Boolean\n read FTarAutoHandle write SetTarAutoHandle;\n\n property IsGzippedTar : Boolean\n read GetIsGzippedTar write FIsGzippedTar;\n\n property Items[Index : Integer] : TAbGzipItem\n read GetItem\n write PutItem; default;\n end;\n\nfunction VerifyGZip(Strm : TStream) : TAbArchiveType;\nfunction GZOsToStr(OS: Byte) : string;\n\nimplementation\n\nuses\n {$IFDEF MSWINDOWS}\n Windows,\n {$ENDIF}\n{$IFDEF HasAnsiStrings}\n System.AnsiStrings,\n{$ENDIF}\n SysUtils, AbBitBkt, AbCharset, AbDfBase, AbDfDec, AbDfEnc, AbExcept, AbResString;\n\nconst\n { Header Signature Values}\n AB_GZ_HDR_ID1 = $1F;\n AB_GZ_HDR_ID2 = $8B;\n\n { Test bits for TGzHeader.Flags field }\n AB_GZ_FLAG_FTEXT = $01;\n AB_GZ_FLAG_FCONTINUATION = $02;\n AB_GZ_FLAG_FEXTRA = $04;\n AB_GZ_FLAG_FNAME = $08;\n AB_GZ_FLAG_FCOMMENT = $10;\n AB_GZ_FLAG_FENCRYPTED = $20;\n AB_GZ_UNSUPPORTED_FLAGS = $E2;\n\n { GZip OS source flags }\n AB_GZ_OS_ID_FAT = 0;\n AB_GZ_OS_ID_Amiga = 1;\n AB_GZ_OS_ID_VMS = 2;\n AB_GZ_OS_ID_Unix = 3;\n AB_GZ_OS_ID_VM_CMS = 4;\n AB_GZ_OS_ID_AtariTOS = 5;\n AB_GZ_OS_ID_HPFS = 6;\n AB_GZ_OS_ID_Macintosh = 7;\n AB_GZ_OS_ID_Z_System = 8;\n AB_GZ_OS_ID_CP_M = 9;\n AB_GZ_OS_ID_TOPS20 = 10;\n AB_GZ_OS_ID_NTFS = 11;\n AB_GZ_OS_ID_QDOS = 12;\n AB_GZ_OS_ID_AcornRISCOS = 13;\n AB_GZ_OS_ID_VFAT = 14;\n AB_GZ_OS_ID_MVS = 15;\n AB_GZ_OS_ID_BEOS = 16;\n AB_GZ_OS_ID_TANDEM = 17;\n AB_GZ_OS_ID_THEOS = 18;\n AB_GZ_OS_ID_unknown = 255;\n\nfunction GZOsToStr(OS: Byte) : string;\n{\nReturn a descriptive string for TGzHeader.OS field\n}\nbegin\n case OS of\n AB_GZ_OS_ID_FAT : Result := AbGzOsFat;\n AB_GZ_OS_ID_Amiga : Result := AbGzOsAmiga;\n AB_GZ_OS_ID_VMS : Result := AbGzOsVMS;\n AB_GZ_OS_ID_Unix : Result := AbGzOsUnix;\n AB_GZ_OS_ID_VM_CMS : Result := AbGzOsVM_CMS;\n AB_GZ_OS_ID_AtariTOS : Result := AbGzOsAtari;\n AB_GZ_OS_ID_HPFS : Result := AbGzOsHPFS;\n AB_GZ_OS_ID_Macintosh : Result := AbGzOsMacintosh;\n AB_GZ_OS_ID_Z_System : Result := AbGzOsZ_System;\n AB_GZ_OS_ID_CP_M : Result := AbGzOsCP_M;\n AB_GZ_OS_ID_TOPS20 : Result := AbGzOsTOPS_20;\n AB_GZ_OS_ID_NTFS : Result := AbGzOsNTFS;\n AB_GZ_OS_ID_QDOS : Result := AbGzOsQDOS;\n AB_GZ_OS_ID_AcornRISCOS : Result := AbGzOsAcornRISCOS;\n AB_GZ_OS_ID_VFAT : Result := AbGzOsVFAT;\n AB_GZ_OS_ID_MVS : Result := AbGzOsMVS;\n AB_GZ_OS_ID_BEOS : Result := AbGzOsBeOS;\n AB_GZ_OS_ID_TANDEM : Result := AbGzOsTandem;\n AB_GZ_OS_ID_THEOS : Result := AbGzOsTHEOS;\n AB_GZ_OS_ID_unknown : Result := AbGzOsunknown;\n else\n Result := AbGzOsUndefined;\n end;\nend;\n\n\nfunction VerifyHeader(const Header : TAbGzHeader) : Boolean;\nbegin\n { check id fields and if deflated (only handle deflate anyway)}\n Result := (Header.ID1 = AB_GZ_HDR_ID1) and\n (Header.ID2 = AB_GZ_HDR_ID2) and\n (Header.CompMethod = 8 {deflate});\nend;\n\nfunction VerifyGZip(Strm : TStream) : TAbArchiveType;\nvar\n GHlp : TAbGzipStreamHelper;\n Hlpr : TAbDeflateHelper;\n PartialTarData : TMemoryStream;\n CurPos : Int64;\nbegin\n Result := atUnknown;\n CurPos := Strm.Position;\n try\n Strm.Seek(0, soBeginning);\n\n {prepare for the try..finally}\n Hlpr := nil;\n PartialTarData := nil;\n\n GHlp := TAbGzipStreamHelper.Create(Strm);\n try\n {create the stream helper and read the item header}\n GHlp.ReadHeader;\n\n { check id fields and if deflated (only handle deflate anyway)}\n if VerifyHeader(GHlp.FItem.FGZHeader) then begin\n Result := atGZip; { provisional }\n\n { check if is actually a Gzipped Tar }\n { partial extract contents, verify vs. Tar }\n PartialTarData := TMemoryStream.Create;\n GHlp.SeekToItemData;\n Hlpr := TAbDeflateHelper.Create;\n Hlpr.PartialSize := 512;\n PartialTarData.SetSize(512 * 2);\n Inflate(Strm, PartialTarData, Hlpr);\n\n {set to beginning of extracted data}\n PartialTarData.Position := 0;\n\n if (VerifyTar(PartialTarData) = atTar) then\n Result := atGZippedTar;\n end;\n finally\n GHlp.Free;\n Hlpr.Free;\n PartialTarData.Free;\n end;\n except\n on EReadError do\n Result := atUnknown;\n end;\n Strm.Position := CurPos;\nend;\n\n{ TAbGzipExtraField }\n\nconstructor TAbGzipExtraField.Create(aGZHeader : PAbGzHeader);\nbegin\n inherited Create;\n FGZHeader := aGZHeader;\nend;\n\nprocedure TAbGzipExtraField.Changed;\nbegin\n if Buffer = nil then\n FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FEXTRA\n else\n FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FEXTRA;\nend;\n\nprocedure TAbGzipExtraField.Delete(aID : TAbGzExtraFieldSubID);\nbegin\n inherited Delete(Word(aID));\nend;\n\nfunction TAbGzipExtraField.GetID(aIndex : Integer): TAbGzExtraFieldSubID;\nbegin\n Result := TAbGzExtraFieldSubID(inherited IDs[aIndex]);\nend;\n\nfunction TAbGzipExtraField.Get(aID : TAbGzExtraFieldSubID; out aData : Pointer;\n out aDataSize : Word) : Boolean;\nbegin\n Result := inherited Get(Word(aID), aData, aDataSize);\nend;\n\nprocedure TAbGzipExtraField.Put(aID : TAbGzExtraFieldSubID; const aData; aDataSize : Word);\nbegin\n inherited Put(Word(aID), aData, aDataSize);\nend;\n\n\n{ TAbGzipStreamHelper }\n\nconstructor TAbGzipStreamHelper.Create(AStream : TStream);\nbegin\n inherited Create(AStream);\n FItem := TAbGzipItem.Create;\nend;\n\ndestructor TAbGzipStreamHelper.Destroy;\nbegin\n FItem.Free;\n inherited;\nend;\n\nfunction ReadCStringInStream(AStream: TStream): AnsiString;\n{\nlocate next instance of a null character in a stream\nleaves stream positioned just past that,\nor at end of stream if not found or null is last byte in stream.\nResult is the entire read string.\n}\nconst\n BuffSiz = 1024;\nvar\n Buff : array [0..BuffSiz-1] of AnsiChar;\n Len, DataRead : LongInt;\nbegin\n{ basically what this is supposed to do is...}\n{\n repeat\n AStream.Read(C, 1);\n Result := Result + C;\n until (AStream.Position = AStream.Size) or (C = #0);\n}\n Result := '';\n repeat\n DataRead := AStream.Read(Buff, BuffSiz - 1);\n Buff[DataRead] := #0;\n Len := AbStrLen(Buff);\n if Len > 0 then begin\n SetLength(Result, Length(Result) + Len);\n Move(Buff, Result[Length(Result) - Len + 1], Len);\n end;\n if Len < DataRead then begin\n AStream.Seek(Len - DataRead + 1, soCurrent);\n Break;\n end;\n until DataRead = 0;\nend;\n\nprocedure TAbGzipStreamHelper.SeekToItemData;\n{find end of header data, including FileName etc.}\nbegin\n {** Seek to Compressed Data **}\n FStream.Seek(0, soBeginning);\n FItem.LoadGzHeaderFromStream(FStream);\nend;\n\nprocedure TAbGzipStreamHelper.ExtractItemData(AStream: TStream);\nvar\n Helper : TAbDeflateHelper;\nbegin\n Helper := TAbDeflateHelper.Create;\n try\n SeekToItemData;\n if (AStream is TAbBitBucketStream) then\n Helper.Options := Helper.Options or dfc_TestOnly;\n FItem.CRC32 := Inflate(FStream, AStream, Helper);\n FItem.UncompressedSize := AStream.Size{Helper.NormalSize};\n finally\n Helper.Free;\n end;\nend;\n\nfunction TAbGzipStreamHelper.FindFirstItem: Boolean;\nvar\n GZH : TAbGzHeader;\n DataRead : Integer;\nbegin\n Result := False;\n FStream.Seek(0, soBeginning);\n DataRead := FStream.Read(GZH, SizeOf(TAbGzHeader));\n if (DataRead = SizeOf(TAbGzHeader)) and VerifyHeader(GZH) then begin\n FItem.FGZHeader := GZH;\n Result := True;\n end;\n FStream.Seek(0, soBeginning);\nend;\n\nfunction TAbGzipStreamHelper.FindNextItem: Boolean;\nbegin\n { only one item in a GZip }\n Result := False;\nend;\n\nfunction TAbGzipStreamHelper.SeekItem(Index: Integer): Boolean;\nbegin\n if Index > 0 then\n Result := False\n else\n Result := FindFirstItem;\nend;\n\nprocedure TAbGzipStreamHelper.WriteArchiveHeader;\nbegin\n FItem.SaveGzHeaderToStream(FStream);\nend;\n\nprocedure TAbGzipStreamHelper.WriteArchiveItem(AStream: TStream);\nvar\n Helper : TAbDeflateHelper;\nbegin\n Helper := TAbDeflateHelper.Create;\n try\n FItem.CRC32 := Deflate(AStream, FStream, Helper);\n FItem.UncompressedSize := AStream.Size;\n finally\n Helper.Free;\n end;\nend;\n\nprocedure TAbGzipStreamHelper.WriteArchiveTail;\nvar\n Tail : TAbGzTailRec;\nbegin\n Tail.CRC32 := FItem.CRC32;\n Tail.ISize := FItem.UncompressedSize;\n FStream.Write(Tail, SizeOf(TAbGzTailRec));\nend;\n\nfunction TAbGzipStreamHelper.GetItemCount: Integer;\nbegin\n { only one item in a gzip }\n Result := 1;\nend;\n\nprocedure TAbGzipStreamHelper.ReadHeader;\nbegin\n FItem.LoadGzHeaderFromStream(FStream);\nend;\n\nprocedure TAbGzipStreamHelper.ReadTail;\nbegin\n FStream.Read(FTail, SizeOf(TAbGzTailRec));\nend;\n\nfunction TAbGzipStreamHelper.GetGzCRC: LongInt;\nbegin\n Result := FItem.CRC32;\nend;\n\nfunction TAbGzipStreamHelper.GetFileSize: LongInt;\nbegin\n Result := FItem.UncompressedSize;\nend;\n\n{ TAbGzipItem }\n\nconstructor TAbGzipItem.Create;\nbegin\n inherited Create;\n\n { default ID fields }\n FGzHeader.ID1 := AB_GZ_HDR_ID1;\n FGzHeader.ID2 := AB_GZ_HDR_ID2;\n\n { compression method }\n FGzHeader.CompMethod := 8; { deflate }\n\n { Maxium Compression }\n FGzHeader.XtraFlags := 2;\n\n FFileName := '';\n FFileComment := '';\n FExtraField := TAbGzipExtraField.Create(@FGzHeader);\n\n { source OS ID }\n{$IFDEF LINUX } {assume EXT2 system }\n FGzHeader.OS := AB_GZ_OS_ID_Unix;\n{$ENDIF LINUX }\n{$IFDEF MSWINDOWS } {assume FAT system }\n FGzHeader.OS := AB_GZ_OS_ID_FAT;\n{$ENDIF MSWINDOWS }\nend;\n\ndestructor TAbGzipItem.Destroy;\nbegin\n FExtraField.Free;\n inherited;\nend;\n\nfunction TAbGzipItem.GetExternalFileAttributes: LongWord;\nbegin\n { GZip has no provision for storing attributes }\n Result := 0;\nend;\n\nfunction TAbGzipItem.GetFileSystem: TAbGzFileSystem;\nbegin\n case FGzHeader.OS of\n 0..18: Result := TAbGzFileSystem(FGzHeader.OS);\n 255: Result := osUnknown;\n else\n Result := osUndefined;\n end; { case }\nend;\n\nfunction TAbGzipItem.GetIsEncrypted: Boolean;\nbegin\n Result := (FGZHeader.Flags and AB_GZ_FLAG_FENCRYPTED) = AB_GZ_FLAG_FENCRYPTED;\nend;\n\nfunction TAbGzipItem.GetHasExtraField: Boolean;\nbegin\n Result := (FGZHeader.Flags and AB_GZ_FLAG_FEXTRA) = AB_GZ_FLAG_FEXTRA;\nend;\n\nfunction TAbGzipItem.GetHasFileComment: Boolean;\nbegin\n Result := (FGZHeader.Flags and AB_GZ_FLAG_FCOMMENT) = AB_GZ_FLAG_FCOMMENT;\nend;\n\nfunction TAbGzipItem.GetHasFileName: Boolean;\nbegin\n Result := (FGZHeader.Flags and AB_GZ_FLAG_FNAME) = AB_GZ_FLAG_FNAME;\nend;\n\nfunction TAbGzipItem.GetIsText: Boolean;\nbegin\n Result := (FGZHeader.Flags and AB_GZ_FLAG_FTEXT) = AB_GZ_FLAG_FTEXT;\nend;\n\nfunction TAbGzipItem.GetLastModFileDate: Word;\nbegin\n { convert to local DOS file Date }\n Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Hi;\nend;\n\nfunction TAbGzipItem.GetLastModFileTime: Word;\nbegin\n { convert to local DOS file Time }\n Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Lo;\nend;\n\nfunction TAbGzipItem.GetLastModTimeAsDateTime: TDateTime;\nbegin\n Result := AbUnixTimeToLocalDateTime(FGZHeader.ModTime);\nend;\n\nprocedure TAbGzipItem.LoadGzHeaderFromStream(AStream: TStream);\nvar\n LenW : Word;\nbegin\n AStream.Read(FGzHeader, SizeOf(TAbGzHeader));\n if not VerifyHeader(FGzHeader) then\n Exit;\n\n { Skip part number, if any }\n if (FGzHeader.Flags and AB_GZ_FLAG_FCONTINUATION) = AB_GZ_FLAG_FCONTINUATION then\n AStream.Seek(SizeOf(Word), soCurrent);\n\n if HasExtraField then begin\n { get length of extra data }\n AStream.Read(LenW, SizeOf(Word));\n FExtraField.LoadFromStream(AStream, LenW);\n end\n else\n FExtraField.Clear;\n\n { Get Filename, if any }\n if HasFileName then begin\n FRawFileName := ReadCStringInStream(AStream);\n FFileName := AbRawBytesToString(FRawFileName)\n end\n else\n FFileName := 'unknown';\n\n { any comment present? }\n if HasFileComment then\n FFileComment := ReadCStringInStream(AStream)\n else\n FFileComment := '';\n\n\n {Assert: stream should now be located at start of compressed data }\n {If file was compressed with 3.3 spec this will be invalid so use with care}\n CompressedSize := AStream.Size - AStream.Position - SizeOf(TAbGzTailRec);\n\n FDiskFileName := FileName;\n AbUnfixName(FDiskFileName);\n Action := aaNone;\n Tagged := False;\nend;\n\nprocedure TAbGzipItem.SaveGzHeaderToStream(AStream: TStream);\nvar\n LenW : Word;\nbegin\n { default ID fields }\n FGzHeader.ID1 := AB_GZ_HDR_ID1;\n FGzHeader.ID2 := AB_GZ_HDR_ID2;\n\n { compression method }\n FGzHeader.CompMethod := 8; { deflate }\n\n { reset unsupported flags }\n FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_UNSUPPORTED_FLAGS;\n\n { main header data }\n AStream.Write(FGzHeader, SizeOf(TAbGzHeader));\n\n { add extra field if any }\n if HasExtraField then begin\n LenW := Length(FExtraField.Buffer);\n AStream.Write(LenW, SizeOf(LenW));\n if LenW > 0 then\n AStream.Write(FExtraField.Buffer[0], LenW);\n end;\n\n { add filename if any (and include final #0 from string) }\n if HasFileName then\n AStream.Write(FRawFileName[1], Length(FRawFileName) + 1);\n\n { add file comment if any (and include final #0 from string) }\n if HasFileComment then\n AStream.Write(FFileComment[1], Length(FFileComment) + 1);\nend;\n\nprocedure TAbGzipItem.SetExternalFileAttributes(Value: LongWord);\nbegin\n { do nothing }\nend;\n\nprocedure TAbGzipItem.SetFileComment(const Value: AnsiString);\nbegin\n FFileComment := Value;\n if FFileComment <> '' then\n FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FCOMMENT\n else\n FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FCOMMENT;\nend;\n\nprocedure TAbGzipItem.SetFileName(const Value: string);\nbegin\n FFileName := Value;\n FRawFileName := AbStringToUnixBytes(Value);\n if Value <> '' then\n FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FNAME\n else\n FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FNAME;\nend;\n\nprocedure TAbGzipItem.SetFileSystem(const Value: TAbGzFileSystem);\nbegin\n if Value = osUnknown then\n FGzHeader.OS := 255\n else\n FGzHeader.OS := Ord(Value);\nend;\n\nprocedure TAbGzipItem.SetIsEncrypted(Value: Boolean);\nbegin\n { do nothing }\nend;\n\nprocedure TAbGzipItem.SetIsText(const Value: Boolean);\nbegin\n if Value then\n FGzHeader.Flags := FGzHeader.Flags or AB_GZ_FLAG_FTEXT\n else\n FGzHeader.Flags := FGzHeader.Flags and not AB_GZ_FLAG_FTEXT;\nend;\n\nprocedure TAbGzipItem.SetLastModFileDate(const Value: Word);\nbegin\n { replace date, keep existing time }\n LastModTimeAsDateTime :=\n EncodeDate(\n Value shr 9 + 1980,\n Value shr 5 and 15,\n Value and 31) +\n Frac(LastModTimeAsDateTime);\nend;\n\nprocedure TAbGzipItem.SetLastModFileTime(const Value: Word);\nbegin\n { keep current date, replace time }\n LastModTimeAsDateTime :=\n Trunc(LastModTimeAsDateTime) +\n EncodeTime(\n Value shr 11,\n Value shr 5 and 63,\n Value and 31 shl 1, 0);\nend;\n\nprocedure TAbGzipItem.SetLastModTimeAsDateTime(const Value: TDateTime);\nbegin\n FGZHeader.ModTime := AbLocalDateTimeToUnixTime(Value);\nend;\n\n{ TAbGzipArchive }\n\nconstructor TAbGzipArchive.CreateFromStream(aStream : TStream;\n const aArchiveName : string);\nbegin\n inherited CreateFromStream(aStream, aArchiveName);\n FState := gsGzip;\n FGZStream := FStream;\n FGZItem := FItemList;\n FTarStream := TAbVirtualMemoryStream.Create;\n FTarList := TAbArchiveList.Create(True);\nend;\n\nprocedure TAbGzipArchive.SwapToTar;\nbegin\n FStream := FTarStream;\n FItemList := FTarList;\n FState := gsTar;\nend;\n\nprocedure TAbGzipArchive.SwapToGzip;\nbegin\n FStream := FGzStream;\n FItemList := FGzItem;\n FState := gsGzip;\nend;\n\nfunction TAbGzipArchive.CreateItem(const FileSpec: string): TAbArchiveItem;\nvar\n GzItem : TAbGzipItem;\nbegin\n if IsGZippedTar and TarAutoHandle then begin\n SwapToTar;\n Result := inherited CreateItem(FileSpec);\n end\n else begin\n SwapToGzip;\n GzItem := TAbGzipItem.Create;\n try\n GzItem.CompressedSize := 0;\n GzItem.CRC32 := 0;\n GzItem.DiskFileName := ExpandFileName(FileSpec);\n GzItem.FileName := FixName(FileSpec);\n Result := GzItem;\n except\n Result := nil;\n end;\n end;\nend;\n\ndestructor TAbGzipArchive.Destroy;\nbegin\n SwapToGzip;\n FTarList.Free;\n FTarStream.Free;\n inherited Destroy;\nend;\n\n\nprocedure TAbGzipArchive.ExtractItemAt(Index: Integer;\n const UseName: string);\nvar\n OutStream : TFileStream;\n CurItem : TAbGzipItem;\nbegin\n if IsGZippedTar and TarAutoHandle then begin\n SwapToTar;\n inherited ExtractItemAt(Index, UseName);\n end\n else begin\n SwapToGzip;\n if Index > 0 then Index := 0; { only one item in a GZip}\n\n CurItem := TAbGzipItem(ItemList[Index]);\n\n OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone);\n try\n try {OutStream}\n ExtractItemToStreamAt(Index, OutStream);\n finally {OutStream}\n OutStream.Free;\n end; {OutStream}\n AbSetFileTime(UseName, CurItem.LastModTimeAsDateTime);\n AbSetFileAttr(UseName, CurItem.NativeFileAttributes);\n except\n on E : EAbUserAbort do begin\n FStatus := asInvalid;\n if FileExists(UseName) then\n DeleteFile(UseName);\n raise;\n end else begin\n if FileExists(UseName) then\n DeleteFile(UseName);\n raise;\n end;\n end;\n end;\nend;\n\nprocedure TAbGzipArchive.ExtractItemToStreamAt(Index: Integer;\n aStream: TStream);\nvar\n GzHelp : TAbGzipStreamHelper;\nbegin\n if IsGzippedTar and TarAutoHandle then begin\n SwapToTar;\n inherited ExtractItemToStreamAt(Index, aStream);\n end\n else begin\n SwapToGzip;\n { note Index ignored as there's only one item in a GZip }\n\n GZHelp := TAbGzipStreamHelper.Create(FGzStream);\n try\n { read GZip Header }\n GzHelp.ReadHeader;\n\n { extract copy data from GZip}\n GzHelp.ExtractItemData(aStream);\n\n { Get validation data }\n GzHelp.ReadTail;\n\n {$IFDEF STRICTGZIP}\n { According to\n http://www.gzip.org/zlib/rfc1952.txt\n\n A compliant gzip compressor should calculate and set the CRC32 and ISIZE.\n However, a compliant decompressor should not check these values.\n\n If you want to check the the values of the CRC32 and ISIZE in a GZIP file\n when decompressing enable the STRICTGZIP define contained in AbDefine.inc }\n\n { validate against CRC }\n if GzHelp.FItem.Crc32 <> GzHelp.TailCRC then\n raise EAbGzipBadCRC.Create;\n\n { validate against file size }\n if GzHelp.FItem.UncompressedSize <> GZHelp.TailSize then\n raise EAbGzipBadFileSize.Create;\n {$ENDIF}\n finally\n GzHelp.Free;\n end;\n end;\nend;\n\nfunction TAbGzipArchive.FixName(const Value: string): string;\n{ fix up fileaname for storage }\nbegin\n if FState = gsTar then\n Result := inherited FixName( Value )\n else begin\n {GZip files Always strip the file path}\n StoreOptions := StoreOptions + [soStripDrive, soStripPath];\n Result := '';\n if Value <> '' then\n Result := ExtractFileName(Value);\n end;\nend;\n\nfunction TAbGzipArchive.GetIsGzippedTar: Boolean;\nbegin\n Result := FIsGzippedTar;\nend;\n\nfunction TAbGzipArchive.GetItem(Index: Integer): TAbGzipItem;\nbegin\n Result := nil;\n if Index = 0 then\n Result := TAbGzipItem(FItemList.Items[Index]);\nend;\n\nfunction TAbGzipArchive.GetSupportsEmptyFolders : Boolean;\nbegin\n Result := IsGzippedTar and TarAutoHandle;\nend;\n\nprocedure TAbGzipArchive.LoadArchive;\nvar\n GzHelp : TAbGzipStreamHelper;\n Item : TAbGzipItem;\n Abort : Boolean;\nbegin\n SwapToGzip;\n if FGzStream.Size > 0 then begin\n GzHelp := TAbGzipStreamHelper.Create(FGzStream);\n try\n if GzHelp.FindFirstItem then begin\n Item := TAbGzipItem.Create;\n Item.LoadGzHeaderFromStream(FGzStream);\n FGzStream.Seek(-SizeOf(TAbGzTailRec), soEnd);\n GZHelp.ReadTail;\n Item.CRC32 := GZHelp.TailCRC;\n Item.UncompressedSize := GZHelp.TailSize;\n\n Item.Action := aaNone;\n FGZItem.Add(Item);\n\n if IsGzippedTar and TarAutoHandle then begin\n { extract Tar and set stream up }\n FTarStream.SwapFileDirectory := FTempDir;\n GzHelp.SeekToItemData;\n GzHelp.ExtractItemData(FTarStream);\n SwapToTar;\n inherited LoadArchive;\n end;\n end;\n\n DoArchiveProgress(100, Abort);\n FIsDirty := False;\n finally\n { Clean Up }\n GzHelp.Free;\n end;\n end;\nend;\n\nprocedure TAbGzipArchive.PutItem(Index: Integer; const Value: TAbGzipItem);\nbegin\n if Index = 0 then\n FItemList.Items[Index] := Value;\nend;\n\nprocedure TAbGzipArchive.SaveArchive;\nvar\n InGzHelp, OutGzHelp : TAbGzipStreamHelper;\n Abort : Boolean;\n i : Integer;\n NewStream : TAbVirtualMemoryStream;\n UncompressedStream : TStream;\n SaveDir : string;\n CurItem : TAbGzipItem;\nbegin\n {prepare for the try..finally}\n OutGzHelp := nil;\n NewStream := nil;\n\n try\n InGzHelp := TAbGzipStreamHelper.Create(FGzStream);\n\n try\n {init new archive stream}\n NewStream := TAbVirtualMemoryStream.Create;\n OutGzHelp := TAbGzipStreamHelper.Create(NewStream);\n\n { create helper }\n NewStream.SwapFileDirectory := FTempDir;\n\n { save the Tar data }\n if IsGzippedTar and TarAutoHandle then begin\n SwapToTar;\n inherited SaveArchive;\n if FGZItem.Count = 0 then begin\n CurItem := TAbGzipItem.Create;\n FGZItem.Add(CurItem);\n end;\n CurItem := FGZItem[0] as TAbGzipItem;\n CurItem.Action := aaNone;\n CurItem.LastModTimeAsDateTime := Now;\n CurItem.SaveGzHeaderToStream(NewStream);\n FTarStream.Position := 0;\n OutGzHelp.WriteArchiveItem(FTarStream);\n CurItem.CRC32 := OutGzHelp.CRC;\n CurItem.UncompressedSize := OutGzHelp.FileSize;\n OutGzHelp.WriteArchiveTail;\n end\n else begin\n SwapToGzip;\n\n {build new archive from existing archive}\n for i := 0 to pred(Count) do begin\n FCurrentItem := ItemList[i];\n CurItem := TAbGzipItem(ItemList[i]);\n InGzHelp.SeekToItemData;\n\n case CurItem.Action of\n aaNone, aaMove : begin\n {just copy the file to new stream}\n CurItem.SaveGzHeaderToStream(NewStream);\n InGzHelp.SeekToItemData;\n NewStream.CopyFrom(FGZStream, FGZStream.Size - FGZStream.Position);\n end;\n\n aaDelete: {doing nothing omits file from new stream} ;\n\n aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin\n try\n if (CurItem.Action = aaStreamAdd) then begin\n { adding from a stream }\n CurItem.SaveGzHeaderToStream(NewStream);\n CurItem.UncompressedSize := InStream.Size;\n OutGzHelp.WriteArchiveItem(InStream);\n OutGzHelp.WriteArchiveTail;\n end\n else begin\n { it's coming from a file }\n GetDir(0, SaveDir);\n try {SaveDir}\n if (BaseDirectory <> '') then\n ChDir(BaseDirectory);\n CurItem.LastModTimeAsDateTime := AbGetFileTime(CurItem.DiskFileName);\n UncompressedStream := TFileStream.Create(CurItem.DiskFileName,\n fmOpenRead or fmShareDenyWrite );\n finally {SaveDir}\n ChDir( SaveDir );\n end; {SaveDir}\n\n try\n CurItem.UncompressedSize := UncompressedStream.Size;\n CurItem.SaveGzHeaderToStream(NewStream);\n OutGzHelp.WriteArchiveItem(UncompressedStream);\n OutGzHelp.WriteArchiveTail;\n\n finally {UncompressedStream}\n UncompressedStream.Free;\n end; {UncompressedStream}\n end;\n except\n ItemList[i].Action := aaDelete;\n DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);\n end;\n end;\n end; {case}\n end; { for }\n end;\n finally\n InGzHelp.Free;\n end;\n\n {copy new stream to FStream}\n SwapToGzip;\n NewStream.Position := 0;\n if (FStream is TMemoryStream) then\n TMemoryStream(FStream).LoadFromStream(NewStream)\n else if FOwnsStream then begin\n { need new stream to write }\n FreeAndNil(FStream);\n FGZStream := nil;\n FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite);\n FGZStream := FStream;\n FStream.CopyFrom(NewStream, NewStream.Size);\n end\n else begin\n FStream.Size := 0;\n FStream.Position := 0;\n FStream.CopyFrom(NewStream, NewStream.Size);\n end;\n\n {update Items list}\n for i := pred( Count ) downto 0 do begin\n if ItemList[i].Action = aaDelete then\n FItemList.Delete( i )\n else if ItemList[i].Action <> aaFailed then\n ItemList[i].Action := aaNone;\n end;\n\n if IsGzippedTar and TarAutoHandle then\n SwapToTar;\n\n DoArchiveSaveProgress( 100, Abort );\n DoArchiveProgress( 100, Abort );\n finally {NewStream}\n OutGzHelp.Free;\n NewStream.Free;\n end;\nend;\n\nprocedure TAbGzipArchive.SetTarAutoHandle(const Value: Boolean);\nbegin\n if Value then\n SwapToTar\n else\n SwapToGzip;\n FTarAutoHandle := Value;\nend;\n\nprocedure TAbGzipArchive.TestItemAt(Index: Integer);\nvar\n SavePos : LongInt;\n GZType : TAbArchiveType;\n BitBucket : TAbBitBucketStream;\n GZHelp : TAbGzipStreamHelper;\nbegin\n if IsGzippedTar and TarAutoHandle then begin\n inherited TestItemAt(Index);\n end\n else begin\n { note Index ignored as there's only one item in a GZip }\n SavePos := FGzStream.Position;\n GZType := VerifyGZip(FGZStream);\n if not (GZType in [atGZip, atGZippedTar]) then\n raise EAbGzipInvalid.Create;\n\n BitBucket := nil;\n GZHelp := nil;\n try\n BitBucket := TAbBitBucketStream.Create(1024);\n GZHelp := TAbGzipStreamHelper.Create(FGZStream);\n\n GZHelp.ExtractItemData(BitBucket);\n GZHelp.ReadTail;\n\n { validate against CRC }\n if GzHelp.FItem.Crc32 <> GZHelp.TailCRC then\n raise EAbGzipBadCRC.Create;\n\n { validate against file size }\n if GzHelp.FItem.UncompressedSize <> GZHelp.TailSize then\n raise EAbGzipBadFileSize.Create;\n\n finally\n GZHelp.Free;\n BitBucket.Free;\n end;\n\n FGzStream.Position := SavePos;\n end;\nend;\n\nprocedure TAbGzipArchive.DoSpanningMediaRequest(Sender: TObject;\n ImageNumber: Integer; var ImageName: string; var Abort: Boolean);\nbegin\n Abort := False;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbHexVw.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbHexVw.pas *}\n{*********************************************************}\n{* Abbrevia: Hex View utility *}\n{*********************************************************}\n\n{$I AbDefine.inc}\n\n{$IFNDEF UsingCLX}\nunit AbHexVw;\n{$ENDIF}\n\ninterface\n\nuses\n Classes,\n{$IFDEF UsingCLX}\n QStdCtrls, QGraphics,\n{$ELSE}\n StdCtrls, Graphics, \n{$ENDIF}\n SysUtils;\ntype\n THexView = class(TMemo)\n protected\n FBlockSize : Integer;\n public\n procedure SetStream(Strm : TStream);\n constructor Create(AOwner : TComponent); override;\n destructor Destroy; override;\n property Stream : TStream write SetStream;\n property BlockSize : Integer read FBlockSize write FBlockSize;\n end;\n\nimplementation\n\n{$IFDEF HasUITypes}\nuses\n System.UITypes;\n{$ENDIF}\n\nconstructor THexView.Create(AOwner : TComponent);\nbegin\n Inherited Create(AOwner);\n Font.Style := Font.Style + [fsBold];\n ReadOnly := True;\n ScrollBars := ssVertical;\n WordWrap := False;\n WantTabs := True;\n FBlockSize := 512;\nend;\n\ndestructor THexView.Destroy;\nbegin\n inherited Destroy;\nend;\n\nprocedure THexView.SetStream(Strm : TStream);\nvar\n Buff : Array[0..15] of Byte;\n i, j : Integer;\n Str : String;\n StrList : TStringList;\nbegin\n Strm.Seek(0, soBeginning);\n StrList := TStringList.Create;\n Clear;\n while Strm.Position < Strm.Size do begin\n if ((Strm.Position mod FBlockSize) = 0) then\n StrList.Add('===========================================================');\n Str := '';\n\n for j := 0 to 15 do\n Buff[j] := Byte(chr(0));\n Strm.Read(Buff, 16);\n Str := Str + Format('%4.4X', [strm.Position - $10]) + ':' + #9;\n\n for i := 0 to 15 do begin\n Str := Str + Format('%2.2X', [Buff[i]]) + ' ';\n if i = 7 then Str := Str + #9;\n end;\n Str := Str + #9;\n for i := 0 to 15 do begin\n if (Buff[i] < $30) then\n Buff[i] := byte('.');\n Str := Str + Char(Buff[i]);\n end;\n StrList.Add(Str);\n end;\n SetLines(StrList);\n StrList.Free;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbLZMA.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is Craig Peterson\n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n * Pierre le Riche \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbLZMA.pas *}\n{*********************************************************}\n{* ABBREVIA: Lzma compression/decompression procedures. *}\n{*********************************************************}\n\nunit AbLZMA;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes, Windows, SysUtils, AbCrtl, AbUtils;\n\n{ Raw LZMA decompression =================================================== }\n\n{ Decompresses the LZMA compressed data in ASrc to ADes. ASrc should not have\n the header used by the other compression/decompression routines, and\n AProperties should contain any necessary data. }\nprocedure LzmaDecodeStream(AProperties: PByte; APropSize: Integer; ASrc, ADes: TStream;\n AUncompressedSize: Int64 = -1); overload;\n\n\n{ Stream compression and decompression (taken from LzmaUtil.c) ============= }\n\nprocedure LzmaDecodeStream(ASourceStream, ATargetStream: TStream); overload;\nprocedure LzmaEncodeStream(ASourceStream, ATargetStream: TStream; ASourceSize: Int64);\n\n\n{ In-memory compression and decompression ================================== }\n\n{ Given a pointer to the compressed data, this will return the size of the\n decompressed data. }\nfunction LzmaGetUncompressedSize(APCompressedData: Pointer; ACompressedSize: Integer): Integer;\n\n{ Decompresses the LZMA compressed data at APCompressedData to the buffer\n pointed to by APUncompressedData. The buffer at APUncompressedData should be\n large enough to hold the number of bytes as returned by LzmaGetDecompressedSize. }\nprocedure LzmaDecodeBuffer(APCompressedData: Pointer; ACompressedSize: Integer;\n APUncompressedData: Pointer);\n\n{ Compresses the data at APUncompressedData to the buffer at APCompressedData,\n and returns the number of bytes written. If ACompressedDataBufferCapacity is\n less than the number of bytes required to store the entire compressed stream,\n or any other error occurs, then an exception is raised. (A safe number for\n ACompressedDataBufferCapacity is slightly more than AUncompressedDataBufferSize.)\n Leave ACompressionLevel and ADictionarySize at -1 in order to use the default\n values (5 and 16MB respectively). }\nfunction LzmaEncodeBuffer(APUncompressedData: Pointer; AUncompressedSize: Integer;\n APCompressedData: Pointer; ACompressedDataBufferCapacity: Integer;\n ACompressionLevel: Integer = -1; ADictionarySize: Integer = -1): Integer;\n\n\n{ Types.h declarations ===================================================== }\n\nconst\n SZ_OK = 0;\n SZ_ERROR_DATA = 1;\n SZ_ERROR_MEM = 2;\n SZ_ERROR_CRC = 3;\n SZ_ERROR_UNSUPPORTED = 4;\n SZ_ERROR_PARAM = 5;\n SZ_ERROR_INPUT_EOF = 6;\n SZ_ERROR_OUTPUT_EOF = 7;\n SZ_ERROR_READ = 8;\n SZ_ERROR_WRITE = 9;\n SZ_ERROR_PROGRESS = 10;\n SZ_ERROR_FAIL = 11;\n SZ_ERROR_THREAD = 12;\n SZ_ERROR_ARCHIVE = 16;\n SZ_ERROR_NO_ARCHIVE = 17;\n\ntype\n SRes = Integer;\n\n ISeqInStream = packed record\n Read: function(p: Pointer; var buf; var size: size_t): SRes; cdecl;\n end;\n PISeqInStream = ^ISeqInStream;\n\n ISeqOutStream = packed record\n Write: function(p: Pointer; const buf; size: size_t): size_t; cdecl;\n end;\n PISeqOutStream = ^ISeqOutStream;\n\n ICompressProgress = packed record\n Progress: function(p: Pointer; inSize, outSize: Int64): SRes; cdecl;\n end;\n PICompressProgress = ^ICompressProgress;\n\n ISzAlloc = packed record\n Alloc: function(p: Pointer; size: size_t): Pointer; cdecl;\n Free: procedure(p: Pointer; address: Pointer); cdecl;\n end;\n PISzAlloc = ^ISzAlloc;\n\n\n{ LzmaDec.h declarations =================================================== }\n\ntype\n CLzmaProb = Word;\n\n// LZMA Properties\nconst\n LZMA_PROPS_SIZE = 5;\n\ntype\n CLzmaProps = packed record\n lc, lp, pb: Cardinal;\n dicSize: UInt32;\n end;\n\n// LZMA Decoder state\nconst\n LZMA_REQUIRED_INPUT_MAX = 20;\n\ntype\n CLzmaDec = packed record\n prop: CLzmaProps;\n probs: ^CLzmaProb;\n dic: PByte;\n buf: PByte;\n range, code: UInt32;\n dicPos: size_t;\n dicBufSize: size_t;\n processedPos: UInt32;\n checkDicSize: UInt32;\n state: Cardinal;\n reps: array[0..3] of UInt32;\n remainLen: Cardinal;\n needFlush: Integer;\n needInitState: Integer;\n numProbs: UInt32;\n tempBufSize: Cardinal;\n tempBuf: array[0..LZMA_REQUIRED_INPUT_MAX - 1] of Byte;\n end;\n\ntype\n ELzmaFinishMode = LongInt;\n\nconst\n LZMA_FINISH_ANY = 0; // finish at any point\n LZMA_FINISH_END = 1; // block must be finished at the end\n\ntype\n ELzmaStatus = LongInt;\n\nconst\n LZMA_STATUS_NOT_SPECIFIED = 0; // use main error code instead\n LZMA_STATUS_FINISHED_WITH_MARK = 1; // stream was finished with end mark.\n LZMA_STATUS_NOT_FINISHED = 3; // stream was not finished\n LZMA_STATUS_NEEDS_MORE_INPUT = 4; // you must provide more input bytes\n LZMA_STATUS_MAYBE_FINISHED_WITHOUT_MARK = 5; // there is probability that stream was finished without end mark\n\nprocedure LzmaDec_Construct(var p: CLzmaDec); cdecl;\nprocedure LzmaDec_Init(var p: CLzmaDec); cdecl; external;\nfunction LzmaDec_DecodeToBuf(var p: CLzmaDec; dest: PByte; var destLen: size_t;\n src: PByte; var srcLen: size_t; finishMode: ELzmaFinishMode;\n var status: ELzmaStatus): SRes; cdecl; external;\nfunction LzmaDec_Allocate(var state: CLzmaDec; prop: PByte; propsSize: Integer;\n alloc: PISzAlloc): SRes; cdecl; external;\nprocedure LzmaDec_Free(var state: CLzmaDec; alloc: PISzAlloc); cdecl; external;\n\n// One call decoding interface\nfunction LzmaDecode(dest: PByte; var destLen: size_t; src: PByte;\n var srcLen: size_t; propData: PByte; propSize: Integer;\n finishMode: ELzmaFinishMode; var status: ELzmaStatus; \n alloc: PISzAlloc): SRes; cdecl; external;\n\n\n{ LzmaEnc.h declarations =================================================== }\n\ntype\n CLzmaEncHandle = Pointer;\n\n CLzmaEncProps = packed record\n level: Integer; // 0 <= level <= 9\n dictSize: UInt32; // (1 << 12) <= dictSize <= (1 << 27) for 32-bit version\n // (1 << 12) <= dictSize <= (1 << 30) for 64-bit version\n // default = (1 << 24)\n lc: Integer; // 0 <= lc <= 8, default = 3\n lp: Integer; // 0 <= lp <= 4, default = 0\n pb: Integer; // 0 <= pb <= 4, default = 2\n algo: Integer; // 0 - fast, 1 - normal, default = 1\n fb: Integer; // 5 <= fb <= 273, default = 32\n btMode: Integer; // 0 - hashChain Mode, 1 - binTree mode - normal, default = 1\n numHashBytes: Integer; // 2, 3 or 4, default = 4\n mc: UInt32; // 1 <= mc <= (1 << 30), default = 32\n writeEndMark: Cardinal; // 0 - do not write EOPM, 1 - write EOPM, default = 0\n numThreads: Integer; // 1 or 2, default = 2\n end;\n\nprocedure LzmaEncProps_Init(var p: CLzmaEncProps); cdecl; external;\nfunction LzmaEnc_Create(Alloc: PISzAlloc): CLzmaEncHandle; cdecl; external;\nprocedure LzmaEnc_Destroy(p: CLzmaEncHandle; Alloc, allocBig: PISzAlloc); cdecl; external;\nfunction LzmaEnc_SetProps(p: CLzmaEncHandle; var props: CLzmaEncProps): SRes; cdecl; external;\nfunction LzmaEnc_WriteProperties(p: CLzmaEncHandle; properties: PByte;\n var size: size_t): SRes; cdecl; external;\nfunction LzmaEnc_Encode(p: CLzmaEncHandle; outStream: PISeqOutStream;\n inStream: PISeqInStream; Progress: PICompressProgress;\n Alloc, allocBig: PISzAlloc): SRes; cdecl; external;\nfunction LzmaEnc_MemEncode(p: CLzmaEncHandle; dest: PByte; var destLen: size_t;\n src: PByte; srcLen: size_t; writeEndMark: Integer; Progress: PICompressProgress;\n Alloc, allocBig: PISzAlloc): SRes; cdecl; external;\n\n// One call encoding interface\nfunction LzmaEncode(dest: PByte; var destLen: size_t; src: PByte;\n srcLen: size_t; var props: CLzmaEncProps; propsEncoded: PByte;\n var propsSize: size_t; writeEndMark: Integer; progress: PICompressProgress;\n alloc: pISzAlloc; allocBig: PISzAlloc): SRes; cdecl; external;\n\n\n{ LzFind.h declarations ==================================================== }\n\nprocedure MatchFinder_NeedMove; external;\nprocedure MatchFinder_GetPointerToCurrentPos; external;\nprocedure MatchFinder_MoveBlock; external;\nprocedure MatchFinder_ReadIfRequired; external;\nprocedure MatchFinder_Construct; external;\nprocedure MatchFinder_Create; external;\nprocedure MatchFinder_Free; external;\nprocedure MatchFinder_Normalize3; external;\nprocedure MatchFinder_ReduceOffsets; external;\nprocedure GetMatchesSpec1; external;\nprocedure MatchFinder_Init; external;\nprocedure MatchFinder_CreateVTable; external;\n\n\n{ LzFindMt.h declarations ================================================== }\n\nprocedure MatchFinderMt_Construct; external;\nprocedure MatchFinderMt_Destruct; external;\nprocedure MatchFinderMt_Create; external;\nprocedure MatchFinderMt_CreateVTable; external;\nprocedure MatchFinderMt_ReleaseStream; external;\n\n\n{ Lzma header fields ======================================================= }\n\ntype\n // The condensed compression properties\n TLZMAPropertyData = array[0..LZMA_PROPS_SIZE - 1] of Byte;\n\n // The header usually stored in front of LZMA compressed data\n TLZMAHeader = packed record\n PropertyData: TLZMAPropertyData;\n UncompressedSize: Int64;\n end;\n PLZMAHeader = ^TLZMAHeader;\n\n\n{ Error handling =========================================================== }\n\ntype\n EAbLZMAException = class(Exception);\n\nprocedure LzmaCheck(AResultCode: SRes);\nprocedure RaiseLzmaException(AResultCode: SRes);\n\n\n{ Linker directives ======================================================== }\n\n{$WARN BAD_GLOBAL_SYMBOL OFF}\n{$IF DEFINED(WIN32)}\n {$L Win32\\LzFind.obj}\n {$L Win32\\LzFindMt.obj}\n {$L Win32\\LzmaDec.obj}\n {$L Win32\\LzmaEnc.obj}\n {$L Win32\\Threads.obj}\n{$ELSEIF DEFINED(WIN64)}\n {$L Win64\\LzFind.obj}\n {$L Win64\\LzFindMt.obj}\n {$L Win64\\LzmaDec.obj}\n {$L Win64\\LzmaEnc.obj}\n {$L Win64\\Threads.obj}\n{$IFEND}\n\n\nimplementation\n\n{ Error handling =========================================================== }\n\nprocedure LzmaCheck(AResultCode: SRes);\nbegin\n if AResultCode <> SZ_OK then\n RaiseLzmaException(AResultCode);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure RaiseLzmaException(AResultCode: SRes);\nbegin\n case AResultCode of\n SZ_ERROR_DATA: raise EAbLZMAException.Create('LZMA Data Error.');\n SZ_ERROR_MEM: raise EAbLZMAException.Create('LZMA Memory Error.');\n SZ_ERROR_CRC: raise EAbLZMAException.Create('LZMA CRC Error.');\n SZ_ERROR_UNSUPPORTED: raise EAbLZMAException.Create('LZMA \"Unsupported\" Error.');\n SZ_ERROR_PARAM: raise EAbLZMAException.Create('LZMA Parameter Error.');\n SZ_ERROR_INPUT_EOF: raise EAbLZMAException.Create('LZMA Input EOF Error.');\n SZ_ERROR_OUTPUT_EOF: raise EAbLZMAException.Create('LZMA Output EOF Error.');\n SZ_ERROR_READ: raise EAbLZMAException.Create('LZMA Read Error.');\n SZ_ERROR_WRITE: raise EAbLZMAException.Create('LZMA Write Error.');\n SZ_ERROR_PROGRESS: raise EAbLZMAException.Create('LZMA Progress Error.');\n SZ_ERROR_FAIL: raise EAbLZMAException.Create('LZMA \"Fail\" Error.');\n SZ_ERROR_THREAD: raise EAbLZMAException.Create('LZMA Thread Error.');\n SZ_ERROR_ARCHIVE: raise EAbLZMAException.Create('LZMA Archive Error.');\n SZ_ERROR_NO_ARCHIVE: raise EAbLZMAException.Create('LZMA \"No Archive\" Error.');\n else\n raise EAbLZMAException.CreateFmt('Unknown LZMA error (%d)', [AResultCode]);\n end;\nend;\n\n\n{ Helper Routines ========================================================== }\n\nprocedure LzmaDec_Construct(var p: CLzmaDec); cdecl;\nbegin\n p.dic := nil;\n p.probs := nil;\nend;\n{ -------------------------------------------------------------------------- }\nfunction SzAlloc(p: Pointer; size: size_t): Pointer; cdecl;\nbegin\n Result := GetMemory(size);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure SzFree(p, address: Pointer); cdecl;\nbegin\n FreeMemory(address);\nend;\n\nvar\n DelphiMMInterface: ISzAlloc = (Alloc: SzAlloc; Free: SzFree);\n\n\n{ CSeq*Stream implementation =============================================== }\n\ntype\n CSeqInStream = packed record\n Intf: ISeqInStream;\n Stream: TStream;\n end;\n\n CSeqOutStream = packed record\n Intf: ISeqOutStream;\n Stream: TStream;\n end;\n{ -------------------------------------------------------------------------- }\nfunction ISeqInStream_Read(p: Pointer; var buf; var size: size_t): SRes; cdecl;\nbegin\n try\n size := CSeqInStream(p^).Stream.Read(buf, size);\n Result := SZ_OK;\n except\n Result := SZ_ERROR_DATA;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction ISeqOutStream_Write(p: Pointer; const buf; size: size_t): size_t; cdecl;\nbegin\n try\n Result := CSeqOutStream(p^).Stream.Write(buf, size);\n except\n Result := 0;\n end;\nend;\n\n\n{ Raw LZMA decompression =================================================== }\n\n{ Decompress an Lzma compressed stream. Based on LzmaUtil.c::Decode2 }\nfunction LzmaDecode2(var aState: CLzmaDec; aOutStream, aInStream: TStream;\n aUncompressedSize: Int64 = -1): SRes;\nconst\n IN_BUF_SIZE = 1 shl 16;\n OUT_BUF_SIZE = 1 shl 16;\nvar\n LHasSize: Boolean;\n LInBuf: array [0..IN_BUF_SIZE - 1] of Byte;\n LOutBuf: array [0..OUT_BUF_SIZE - 1] of Byte;\n LInPos, LInSize, LOutPos: size_t;\n LInProcessed, LOutProcessed: size_t;\n LFinishMode: ELzmaFinishMode;\n LStatus: ELzmaStatus;\nbegin\n Result := 0;\n LHasSize := aUncompressedSize <> -1;\n LInPos := 0;\n LInSize := 0;\n LOutPos := 0;\n\n LzmaDec_Init(aState);\n while True do\n begin\n if LInPos = LInSize then\n begin\n LInSize := aInStream.Read(LInBuf, IN_BUF_SIZE);\n LInPos := 0;\n if LInSize = 0 then\n Break;\n end\n else\n begin\n LInProcessed := LInSize - LInPos;\n LOutProcessed := OUT_BUF_SIZE - LOutPos;\n LFinishMode := LZMA_FINISH_ANY;\n if LHasSize and (LOutProcessed > aUncompressedSize) then\n begin\n LOutProcessed := size_t(aUncompressedSize);\n LFinishMode := LZMA_FINISH_END;\n end;\n Result := LzmaDec_DecodeToBuf(aState, @LOutBuf[LOutPos], LOutProcessed,\n @LInBuf[LInPos], LInProcessed, LFinishMode, LStatus);\n Inc(LInPos, LInProcessed);\n Inc(LOutPos, LOutProcessed);\n Dec(aUncompressedSize, LOutProcessed);\n\n if (aOutStream <> nil) and (aOutStream.Write(LOutBuf, LOutPos) <> LOutPos) then\n begin\n Result := SZ_ERROR_WRITE;\n Exit;\n end;\n\n LOutPos := 0;\n\n if (Result <> SZ_OK) or (LHasSize and (aUncompressedSize = 0)) then\n Exit;\n\n if (LInProcessed = 0) and (LOutProcessed = 0) then\n begin\n if LHasSize or (LStatus <> LZMA_STATUS_FINISHED_WITH_MARK) then\n Result := SZ_ERROR_DATA;\n Exit;\n end;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\n{ Decompress an LZMA compressed stream. Pass AUncompressedSize = -1 if the\n uncompressed size is not known. }\nprocedure LzmaDecodeStream(AProperties: PByte; APropSize: Integer;\n ASrc, ADes: TStream; AUncompressedSize: Int64);\nvar\n LLZMADecState: CLzmaDec;\nbegin\n LzmaDec_Construct(LLZMADecState);\n try\n LzmaCheck(LzmaDec_Allocate(LLZMADecState, AProperties, APropSize, @DelphiMMInterface));\n LzmaCheck(LzmaDecode2(LLZMADecState, ADes, ASrc, AUncompressedSize));\n finally\n LzmaDec_Free(LLZMADecState, @DelphiMMInterface);\n end;\nend;\n\n\n{ Stream to stream compression and decompression =========================== }\n\n{ Decompresses streams compressed with the LZMA SDK's LzmaUtil.exe.\n Based on LzmaUtil.c::Decode }\nprocedure LzmaDecodeStream(ASourceStream, ATargetStream: TStream);\nvar\n LUncompressedSize: Int64;\n // Header: 5 bytes of LZMA properties and 8 bytes of uncompressed size\n LHeader: TLZMAHeader;\nbegin\n // Read and parse header\n ASourceStream.ReadBuffer(LHeader, SizeOf(LHeader));\n LUncompressedSize := LHeader.UncompressedSize;\n\n LzmaDecodeStream(PByte(@LHeader.PropertyData), LZMA_PROPS_SIZE, ASourceStream,\n ATargetStream, LUncompressedSize);\nend;\n{ -------------------------------------------------------------------------- }\n{ Compresses a stream so it's compatible with the LZMA SDK's LzmaUtil.exe.\n Based on LzmaUtil.c::Encode }\nprocedure LzmaEncodeStream(ASourceStream, ATargetStream: TStream; ASourceSize: Int64);\nvar\n LEncHandle: CLzmaEncHandle;\n LEncProps: CLzmaEncProps;\n LHeader: TLZMAHeader;\n LPropDataSize: size_t;\n LInStreamRec: CSeqInStream;\n LOutStreamRec: CSeqOutStream;\nbegin\n LInStreamRec.Intf.Read := ISeqInStream_Read;\n LInStreamRec.Stream := ASourceStream;\n LOutStreamRec.Intf.Write := ISeqOutStream_Write;\n LOutStreamRec.Stream := ATargetStream;\n\n LEncHandle := LzmaEnc_Create(@DelphiMMInterface);\n if LEncHandle = nil then\n LzmaCheck(SZ_ERROR_MEM);\n\n try\n LzmaEncProps_Init(LEncProps);\n\n LzmaCheck(LzmaEnc_SetProps(LEncHandle, LEncProps));\n\n LPropDataSize := LZMA_PROPS_SIZE;\n\n LzmaCheck(LzmaEnc_WriteProperties(LEncHandle, PByte(@LHeader.PropertyData),\n LPropDataSize));\n\n LHeader.UncompressedSize := ASourceSize;\n\n ATargetStream.WriteBuffer(LHeader, SizeOf(LHeader));\n\n LzmaCheck(LzmaEnc_Encode(LEncHandle, @LOutStreamRec.Intf,\n @LInStreamRec.Intf, nil, @DelphiMMInterface, @DelphiMMInterface));\n\n finally\n LzmaEnc_Destroy(LEncHandle, @DelphiMMInterface, @DelphiMMInterface);\n end;\nend;\n\n\n{ In-memory compression and decompression ================================== }\n\n{ Given a pointer to the compressed data, this will return the size of the\n decompressed data. }\nfunction LzmaGetUncompressedSize(APCompressedData: Pointer; ACompressedSize: Integer): Integer;\nbegin\n if ACompressedSize <= SizeOf(TLZMAHeader) then\n raise EAbLZMAException.Create('The LZMA compressed data is invalid (not enough bytes)');\n\n Result := PLZMAHeader(APCompressedData).UncompressedSize;\nend;\n{ -------------------------------------------------------------------------- }\n{ Decompresses the LZMA compressed data at APCompressedData to the buffer\n pointed to by APUncompressedData. The buffer at APUncompressedData should be\n large enough to hold the number of bytes as returned by LzGetDecompressedSize. }\nprocedure LzmaDecodeBuffer(APCompressedData: Pointer; ACompressedSize: Integer;\n APUncompressedData: Pointer);\nvar\n LPropertyData: TLZMAPropertyData;\n LUncompressedSize: Int64;\n LInputByteCount, LOutputByteCount: size_t;\n LStatus: ELzmaStatus;\nbegin\n if ACompressedSize <= SizeOf(TLZMAHeader) then\n raise EAbLZMAException.Create('The LZMA compressed data is invalid (not enough bytes)');\n\n // Read the header from the compressed data.\n LPropertyData := PLZMAHeader(APCompressedData).PropertyData;\n LUncompressedSize := PLZMAHeader(APCompressedData).UncompressedSize;\n Inc(PAnsiChar(APCompressedData), SizeOf(TLZMAHeader));\n Dec(ACompressedSize, SizeOf(TLZMAHeader));\n\n // Decompress from the input to the output buffer. This will change the byte\n // count variables to the actual number of bytes consumed/written.\n LInputByteCount := ACompressedSize;\n LOutputByteCount := LUncompressedSize;\n LzmaCheck(LzmaDecode(APUncompressedData, LOutputByteCount,\n APCompressedData, LInputByteCount, PByte(@LPropertyData), LZMA_PROPS_SIZE,\n LZMA_FINISH_END, LStatus, @DelphiMMInterface));\n\n // Check that the input buffer was fully consumed and the output buffer was filled up.\n if (LOutputByteCount <> LUncompressedSize) or (LInputByteCount <> ACompressedSize) then\n raise EAbLZMAException.Create('LZMA decompression data error');\nend;\n{ -------------------------------------------------------------------------- }\n{ Compresses the data at APUncompressedData to the buffer at APCompressedData,\n and returns the number of bytes written. If ACompressedDataBufferCapacity is\n less than the number of bytes required to store the entire compressed stream,\n or any other error occurs, then an exception is raised. (A safe number for\n ACompressedDataBufferCapacity is slightly more than AUncompressedDataBufferSize.) \n Leave ACompressionLevel and ADictionarySize at -1 in order to use the default\n values (5 and 16MB respectively). }\nfunction LzmaEncodeBuffer(APUncompressedData: Pointer; AUncompressedSize: Integer;\n APCompressedData: Pointer;\n ACompressedDataBufferCapacity, ACompressionLevel, ADictionarySize: Integer): Integer;\nvar\n LEncProps: CLzmaEncProps;\n LPropsSize: size_t;\n LPOutBuf: PByte;\n LOutputBytes: size_t;\nbegin\n if ACompressedDataBufferCapacity <= SizeOf(TLZMAHeader) then\n raise EAbLZMAException.Create('LZMA output buffer too small');\n\n // Set the uncompressed size in the header\n PLZMAHeader(APCompressedData).UncompressedSize := AUncompressedSize;\n\n // Set the properties\n LzmaEncProps_Init(LEncProps);\n if ACompressionLevel >= 0 then\n LEncProps.level := ACompressionLevel;\n if ADictionarySize >= 0 then\n LEncProps.dictSize := ADictionarySize;\n\n LPOutBuf := PByte(PtrUInt(APCompressedData) + SizeOf(TLZMAHeader));\n LOutputBytes := ACompressedDataBufferCapacity - SizeOf(TLZMAHeader);\n LPropsSize := LZMA_PROPS_SIZE;\n LzmaCheck(LzmaEncode(LPOutBuf, LOutputBytes, APUncompressedData,\n AUncompressedSize, LEncProps, APCompressedData, LPropsSize, 0, nil,\n @DelphiMMInterface, @DelphiMMInterface));\n\n Result := LOutputBytes + SizeOf(TLZMAHeader);\nend;\n\ninitialization\n // The LZMA routines are multithreaded and use the Delphi memory manager.\n IsMultiThread := True;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbLZMAStream.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is Pierre le Riche\n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Pierre le Riche \n * Craig Peterson \n *\n * ***** END LICENSE BLOCK *****\n\n\nUsage:\n LZMA Compression:\n 1) Create a TAbLZMACompressionStream, passing as parameter to the constructor\n the output stream where you want the compressed data stored.\n 2) Write the data that you want to compress to the TAbLZMACompressionStream.\n Compression occurs in a background thread.\n 3) (Optional) Notify the background compression thread that no more data will\n be written by calling NoMoreDataToCompress. Poll the IsBusy method to\n determine whether the background thread is still busy.\n 4) Free the TAbLZMACompressionStream to finish up and release resources. The\n compressed data will now be available in the output stream.\n\n LZMA Decompression:\n 1) Create a TAbLZMADecompressionStream, passing as parameter to the constructor\n the stream that contains the compressed data.\n 2) Read the decompressed data from TAbLZMADecompressionStream.\n 3) Free the TAbLZMADecompressionStream to finish up and release resources.\n\n*)\n\nunit AbLZMAStream;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Windows, Classes, SysUtils, AbLZMA, AbUtils;\n\nconst\n {The size of the intermediate buffers for compressed and decompressed data.}\n CompressedDataBufferSize = 16 * 1024;\n UncompressedDataBufferSize = 32 * 1024;\n {When reading/writing very small blocks from/to a (de)compression stream an\n intermediate buffer is used to buffer the small IO operations in order to\n improve performance. Reads and writes larger than this size are unbuffered\n and handled by the (de)compression algorithm directly. This value must be\n smaller than the compressed and uncompressed data buffers.}\n MaximumBlockSizeForBufferedIO = 1024;\n\ntype\n\n {------------LZMA compression stream------------}\n\n TAbLZMACompressionStream = class;\n\n {The background compression thread.}\n TAbLZMACompressionThread = class(TThread)\n protected\n FCompressionStream: TAbLZMACompressionStream;\n {$IFNDEF HasThreadFinished}\n FFinished: Boolean;\n procedure DoTerminate; override;\n property Finished: Boolean read FFinished;\n {$ENDIF}\n public\n procedure Execute; override;\n end;\n\n {Buffers queued for compression by the background compression thread.}\n PAbQueuedBuffer = ^TAbQueuedBuffer;\n TAbQueuedBuffer = packed record\n PreviousBuffer, NextBuffer: PAbQueuedBuffer;\n DataSize: Integer;\n {Adds this buffer to the compression queue for the given compression stream.\n It is assumed that the compression stream has acquired the buffer critical\n section.}\n procedure QueueBuffer(ACompressionStream: TAbLZMACompressionStream);\n {Removes this buffer from the compression queue}\n procedure UnQueueBuffer;\n {Returns a pointer to the data the given offset into the buffer}\n function GetDataPointer(AOffset: Integer): Pointer;\n end;\n\n TAbLZMACompressionStream = class(TStream)\n protected\n FOutputStream: TStream;\n {The critical section used to control access to the buffers that are queued\n for compression. The main thread and the compression thread may not access\n the buffer queue at the same time.}\n FBufferCriticalSection: TRTLCriticalSection;\n {This semaphore is signalled by the main thread when it added a workload\n for the compression thread (usually when a buffer has been added to\n compress).}\n FPendingWorkSemaphore: THandle;\n {The LZMA compression handle}\n FLZMAEncHandle: CLzmaEncHandle;\n {The background thread used to perform the compression}\n FCompressionThread: TAbLZMACompressionThread;\n {The error code returned by the compression method. 0 = Success.}\n FCompressionErrorCode: Integer;\n {The intermediate compression buffer used to aggregate small writes. When\n NoMoreDataToCompress is called this buffer is freed, so no more data may\n be written.}\n FPIntermediateCompressionBuffer: PAbQueuedBuffer;\n FIntermediateCompressionBufferAvailableBytes: Integer;\n {The circular linked list of buffers that are queued for compression.}\n FQueuedData: TAbQueuedBuffer;\n {The number of bytes of buffer FQueuedData.NextBuffer that has already been\n submitted to the compressor.}\n FCurrentBufferBytesSubmitted: Integer;\n {The position in the output stream where the uncompressed size must be\n stored.}\n FOutputStreamHeaderSizeFieldPosition: Int64;\n {The total number of bytes written to the compression stream}\n FTotalBytesWritten: Int64;\n {Wakes up the compression thread by signalling the \"pending work semaphore\"}\n procedure WakeCompressionThread; inline;\n public\n constructor Create(AOutputStream: TStream; ACompressionLevel: Integer = 5;\n ADictionarySize: Integer = 65536);\n destructor Destroy; override;\n {Reading is not supported and will raise an exception.}\n function Read(var ABuffer; ACount: Longint): Longint; override;\n {Submits data to the compression queue.}\n function Write(const ABuffer; ACount: Longint): Longint; override;\n {Will raise an exception if an attempt is made to seek off the current\n position.}\n function Seek(AOffset: Integer; AOrigin: Word): Integer; override;\n function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;\n {Signals the compression thread that no more data will be submitted.\n Calling write after NoMoreDataToCompress has been called will raise an\n exception.}\n procedure NoMoreDataToCompress;\n {Calls NoMoreDataToCompress and then waits for the background compression\n process to complete, returning the value of ErrorCode (0 = success).}\n function WaitForCompressionToFinish: Integer;\n {Returns True if the background thread is still busy compressing data. Will\n always return True until NoMoreDataToCompress is called.}\n function IsBusy: Boolean;\n {-------------Public properties---------------}\n {The error code returned by the compression method. 0 = Success.}\n property ErrorCode: Integer read FCompressionErrorCode;\n end;\n\n {------------LZMA decompression stream------------}\n\n TAbLZMADecompressionStream = class(TStream)\n protected\n FSourceStream: TStream;\n {The intermediate buffers for compressed and uncompressed data\n respectively.}\n FCompressedDataBuffer: array[0..CompressedDataBufferSize - 1] of Byte;\n FUncompressedDataBuffer: array[0..UncompressedDataBufferSize - 1] of Byte;\n {Read buffer control: Used to speed up frequent small reads via\n FUncompressedDataBuffer.}\n FReadBufferSize: Integer;\n FReadBufferAvailableBytes: Integer;\n {The current size and position into FCompressedDataBuffer}\n FCompressedDataBufferSize: Integer;\n FCompressedDataBufferPosition: Integer;\n {The uncompressed size according to the header.}\n FUncompressedSize: Int64;\n {The total number of bytes that have been decompressed.}\n FBytesDecompressed: Int64;\n {The LZMA decompression state}\n FLzmaState: CLzmaDec;\n {Decompresses data from the compressed source to the buffer pointed to by\n APBuffer. Returns the number of actual bytes stored (which may be less\n than the requested size if the end of the compressed stream was reached).}\n function InternalDecompressToBuffer(APBuffer: Pointer; ABufferSize: Integer): Integer;\n {---Property getters/setters---}\n function GetBytesRead: Int64;\n function GetSize: Int64; override;\n public\n constructor Create(ASourceStream: TStream);\n destructor Destroy; override;\n function Read(var ABuffer; ACount: Integer): Integer; override;\n {Writing to a decompression stream is not allowed}\n function Write(const ABuffer; ACount: Integer): Integer; override;\n {Will raise an exception if an attempt is made to seek off the current\n position.}\n function Seek(AOffset: Integer; AOrigin: Word): Integer; override;\n function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;\n {---Public properties---}\n {The number of decompressed bytes read from the decompression stream.}\n property BytesRead: Int64 read GetBytesRead;\n end;\n\nimplementation\n\nuses\n AbCrtl;\n\n{------------Memory management-------------}\n\nfunction SzAlloc(p: Pointer; size: size_t): Pointer; cdecl;\nbegin\n Result := GetMemory(size);\nend;\n\nprocedure SzFree(p, address: Pointer); cdecl;\nbegin\n FreeMemory(address);\nend;\n\nvar\n DelphiMMInterface: ISzAlloc = (Alloc: SzAlloc; Free: SzFree);\n\n{------------Compression \"interface\"-------------}\n\ntype\n\n {The \"interfaces\" for the input and output streams}\n CSeqInStream_Compress = packed record\n Intf: ISeqInStream;\n CompressionStream: TAbLZMACompressionStream;\n end;\n\n CSeqOutStream_Compress = packed record\n Intf: ISeqOutStream;\n OutputStream: TStream;\n end;\n\nfunction ISeqInStream_Compress_Read(p: Pointer; var buf; var size: size_t): SRes; cdecl;\nvar\n LDoNotWaitForMoreData: Boolean;\n LStream: TAbLZMACompressionStream;\n LPSourceBuf, LPTargetBuf: PAnsiChar;\n LTargetSpace, LSourceBytesAvail: Integer;\n LPCurBuf: PAbQueuedBuffer;\nbegin\n try\n LTargetSpace := size;\n LPTargetBuf := @buf;\n LStream := CSeqInStream_Compress(p^).CompressionStream;\n while True do\n begin\n {Copy any buffered data to the LZMA buffer, returning the number of bytes\n written}\n EnterCriticalSection(LStream.FBufferCriticalSection);\n try\n {If the write buffer has been freed that the main thread will not add\n any more buffers for compression.}\n LDoNotWaitForMoreData := LStream.FPIntermediateCompressionBuffer = nil;\n\n {Copy as much queued data to the LZMA compression buffer as we have (or\n will fit).}\n while True do\n begin\n LPCurBuf := LStream.FQueuedData.NextBuffer;\n {No buffers left? -> Break the loop}\n if LPCurBuf = @LStream.FQueuedData then\n Break;\n {Can this buffer be submitted in its entirety, or only a part?}\n LPSourceBuf := LPCurBuf.GetDataPointer(LStream.FCurrentBufferBytesSubmitted);\n LSourceBytesAvail := LPCurBuf.DataSize - LStream.FCurrentBufferBytesSubmitted;\n if LSourceBytesAvail > LTargetSpace then\n begin\n {Submit only part of the buffer}\n System.Move(LPSourceBuf^, LPTargetBuf^, LTargetSpace);\n Inc(LStream.FCurrentBufferBytesSubmitted, LTargetSpace);\n LTargetSpace := 0;\n Break;\n end\n else\n begin\n {Submit all the remaining bytes in the buffer and free it.}\n System.Move(LPSourceBuf^, LPTargetBuf^, LSourceBytesAvail);\n Inc(LPTargetBuf, LSourceBytesAvail);\n Dec(LTargetSpace, LSourceBytesAvail);\n LStream.FCurrentBufferBytesSubmitted := 0;\n LPCurBuf.UnQueueBuffer;\n FreeMem(LPCurBuf);\n end;\n end;\n finally\n LeaveCriticalSection(LStream.FBufferCriticalSection);\n end;\n\n {If data was submitted to the compressor, or the main thread indicated\n that compression is complete then the loop is broken.}\n if (LTargetSpace <> size) or LDoNotWaitForMoreData then\n Break;\n {No data currently queued, but there may still be more coming: Wait for\n the main thread to notify this thread that more work is pending.}\n WaitForSingleObject(LStream.FPendingWorkSemaphore, INFINITE);\n end;\n {Update the number of bytes written}\n Dec(size, LTargetSpace);\n Result := SZ_OK;\n except\n Result := SZ_ERROR_DATA;\n end;\nend;\n\nfunction ISeqOutStream_Compress_Write(p: Pointer; const buf; size: size_t): size_t; cdecl;\nbegin\n try\n Result := CSeqOutStream_Compress(p^).OutputStream.Write(buf, size);\n except\n Result := 0;\n end;\nend;\n\n{ TAbQueuedBuffer }\n\nfunction TAbQueuedBuffer.GetDataPointer(AOffset: Integer): Pointer;\nbegin\n Result := Pointer(PtrUInt(@Self) + SizeOf(TAbQueuedBuffer) + PtrUInt(AOffset));\nend;\n\nprocedure TAbQueuedBuffer.QueueBuffer(ACompressionStream: TAbLZMACompressionStream);\nbegin\n PreviousBuffer:= ACompressionStream.FQueuedData.PreviousBuffer;\n NextBuffer:= @ACompressionStream.FQueuedData;\n ACompressionStream.FQueuedData.PreviousBuffer.NextBuffer := @Self;\n ACompressionStream.FQueuedData.PreviousBuffer := @Self;\nend;\n\nprocedure TAbQueuedBuffer.UnQueueBuffer;\nbegin\n PreviousBuffer.NextBuffer := NextBuffer;\n NextBuffer.PreviousBuffer := PreviousBuffer;\n PreviousBuffer := nil;\n NextBuffer := nil;\nend;\n\n{ TAbLZMACompressionStream }\n\nconstructor TAbLZMACompressionStream.Create(AOutputStream: TStream; ACompressionLevel,\n ADictionarySize: Integer);\nvar\n LLZMAProps: CLzmaEncProps;\n LLZMAPropData: TLZMAPropertyData;\n LHeaderSize: size_t;\nbegin\n inherited Create;\n\n FOutputStream := AOutputStream;\n\n {Initialize the linked list of buffers.}\n FQueuedData.PreviousBuffer := @FQueuedData;\n FQueuedData.NextBuffer := @FQueuedData;\n\n {Allocate the intermediate compression buffer}\n GetMem(FPIntermediateCompressionBuffer, UncompressedDataBufferSize + SizeOf(TAbQueuedBuffer));\n FIntermediateCompressionBufferAvailableBytes := UncompressedDataBufferSize;\n\n {Initialize the critical section used to control access to the queued data\n buffer.}\n InitializeCriticalSection(FBufferCriticalSection);\n {Create the semaphore used to put the worker thread to sleep when the input\n buffer is empty.}\n FPendingWorkSemaphore := CreateSemaphore(nil, 0, 1, nil);\n\n {Create the LZMA encoder}\n FLZMAEncHandle := LzmaEnc_Create(@DelphiMMInterface);\n if FLZMAEncHandle = nil then\n raise Exception.Create('Unable to allocate memory for the LZMA compressor.');\n\n {Set the compression properties}\n LzmaEncProps_Init(LLZMAProps);\n LLZMAProps.level := ACompressionLevel;\n LLZMAProps.dictSize := ADictionarySize;\n LzmaCheck(LzmaEnc_SetProps(FLZMAEncHandle, LLZMAProps));\n\n {Store the header in the output stream, making note of the position in the\n stream where the uncompressed size will be stored when compression is\n completed.}\n LHeaderSize := LZMA_PROPS_SIZE;\n LzmaCheck(LzmaEnc_WriteProperties(FLZMAEncHandle, PByte(@LLZMAPropData), LHeaderSize));\n FOutputStream.WriteBuffer(LLZMAPropData, LHeaderSize);\n FOutputStreamHeaderSizeFieldPosition := FOutputStream.Position;\n FOutputStream.WriteBuffer(FTotalBytesWritten, SizeOf(FTotalBytesWritten));\n\n {Create and start the compression thread.}\n FCompressionThread := TAbLZMACompressionThread.Create(True);\n FCompressionThread.FCompressionStream := Self;\n {$IFDEF HasThreadStart}\n FCompressionThread.Start;\n {$ELSE}\n FCompressionThread.Resume;\n {$ENDIF}\nend;\n\ndestructor TAbLZMACompressionStream.Destroy;\nvar\n LPBuf: PAbQueuedBuffer;\n LOldPos: Int64;\nbegin\n WaitForCompressionToFinish;\n\n {If something went wrong during creation of this object before the thread was\n created, then the encoder handle may be non-nil.}\n if FLZMAEncHandle <> nil then\n begin\n LzmaEnc_Destroy(FLZMAEncHandle, @DelphiMMInterface, @DelphiMMInterface);\n FLZMAEncHandle := nil;\n end;\n\n {Free the critical section and semaphore}\n DeleteCriticalSection(FBufferCriticalSection);\n CloseHandle(FPendingWorkSemaphore);\n\n {Free the intermediate compression buffer if something went wrong before the\n thread could be created.}\n FreeMem(FPIntermediateCompressionBuffer);\n\n {If compression failed there may be uncompressed data in the queue: free\n those buffers.}\n while True do\n begin\n LPBuf := FQueuedData.NextBuffer;\n if LPBuf = @FQueuedData then\n Break;\n LPBuf.UnQueueBuffer;\n FreeMem(LPBuf);\n end;\n\n {Unpdate the uncompressed size in the header}\n if FTotalBytesWritten > 0 then\n begin\n LOldPos := FOutputStream.Position;\n FOutputStream.Position := FOutputStreamHeaderSizeFieldPosition;\n FOutputStream.WriteBuffer(FTotalBytesWritten, SizeOf(FTotalBytesWritten));\n FOutputStream.Position := LOldPos;\n end;\n\n inherited Destroy;\nend;\n\nfunction TAbLZMACompressionStream.IsBusy: Boolean;\nbegin\n Result := (FCompressionThread <> nil) and (not FCompressionThread.Finished);\nend;\n\nprocedure TAbLZMACompressionStream.NoMoreDataToCompress;\nvar\n LUnqueuedBytes: Integer;\nbegin\n if FPIntermediateCompressionBuffer <> nil then\n begin\n EnterCriticalSection(FBufferCriticalSection);\n try\n {No more data may be submitted at this point. Set the flag to indicate\n this, and wake the compression thread so that it can finish up.}\n LUnqueuedBytes := UncompressedDataBufferSize - FIntermediateCompressionBufferAvailableBytes;\n if LUnqueuedBytes > 0 then\n begin\n FPIntermediateCompressionBuffer.DataSize := LUnqueuedBytes;\n FPIntermediateCompressionBuffer.QueueBuffer(Self);\n end\n else\n FreeMem(FPIntermediateCompressionBuffer);\n {The temporary buffer is always released, so no further writes may be\n performed.}\n FPIntermediateCompressionBuffer := nil;\n finally\n LeaveCriticalSection(FBufferCriticalSection);\n end;\n {Wake up the compression thread so it can finish the compression process.}\n WakeCompressionThread;\n end;\nend;\n\nfunction TAbLZMACompressionStream.Read(var ABuffer; ACount: Integer): Longint;\nbegin\n raise Exception.Create('The compression stream does not support reading.');\nend;\n\nfunction TAbLZMACompressionStream.Seek(const AOffset: Int64;\n AOrigin: TSeekOrigin): Int64;\nbegin\n Result := FTotalBytesWritten;\n if ((AOrigin <> soBeginning) or (AOffset <> Result))\n and ((AOrigin = soBeginning) or (AOffset <> 0)) then\n begin\n raise Exception.Create('The compression stream does not support seeking away from the current position.');\n end;\nend;\n\nfunction TAbLZMACompressionStream.Seek(AOffset: Integer; AOrigin: Word): Integer;\nbegin\n Result := Seek(Int64(AOffset), TSeekOrigin(AOrigin));\nend;\n\nfunction TAbLZMACompressionStream.WaitForCompressionToFinish: Integer;\nbegin\n if FCompressionThread <> nil then\n begin\n {Notify the thread that no further data will be submitted.}\n NoMoreDataToCompress;\n {Wait for the compression thread to complete normally and then free it.}\n FCompressionThread.WaitFor;\n FreeAndNil(FCompressionThread);\n end;\n Result := FCompressionErrorCode;\nend;\n\nprocedure TAbLZMACompressionStream.WakeCompressionThread;\nbegin\n ReleaseSemaphore(FPendingWorkSemaphore, 1, nil);\nend;\n\nfunction TAbLZMACompressionStream.Write(const ABuffer; ACount: Integer): Longint;\nvar\n LPSource: PAnsiChar;\n LPBufData: Pointer;\n LPLargeBuf: PAbQueuedBuffer;\nbegin\n if FPIntermediateCompressionBuffer = nil then\n raise Exception.Create('Write may not be called after NoMoreDataToCompress.');\n\n if ACount <= 0 then\n begin\n Result := 0;\n Exit;\n end;\n\n LPSource := @ABuffer;\n {Get a pointer to the position in the intermediate buffer to be written.}\n LPBufData := FPIntermediateCompressionBuffer.GetDataPointer(\n UncompressedDataBufferSize - FIntermediateCompressionBufferAvailableBytes);\n if FIntermediateCompressionBufferAvailableBytes > ACount then\n begin\n {Copy the data into the intermediate buffer and exit.}\n System.Move(LPSource^, LPBufData^, ACount);\n Dec(FIntermediateCompressionBufferAvailableBytes, ACount);\n Result := ACount;\n end\n else\n begin\n {Fill up the intermediate buffer}\n System.Move(LPSource^, LPBufData^, FIntermediateCompressionBufferAvailableBytes);\n Dec(ACount, FIntermediateCompressionBufferAvailableBytes);\n Inc(LPSource, FIntermediateCompressionBufferAvailableBytes);\n Result := FIntermediateCompressionBufferAvailableBytes;\n {If we get here the current intermediate buffer is now full, and must be\n queued.}\n EnterCriticalSection(FBufferCriticalSection);\n try\n {Insert this buffer into the compression queue.}\n FPIntermediateCompressionBuffer.DataSize := UncompressedDataBufferSize;\n FPIntermediateCompressionBuffer.QueueBuffer(Self);\n {Allocate a new intermediate compression buffer}\n GetMem(FPIntermediateCompressionBuffer, UncompressedDataBufferSize + SizeOf(TAbQueuedBuffer));\n FIntermediateCompressionBufferAvailableBytes := UncompressedDataBufferSize;\n {Should the remaining data be copied into the intermediate compression\n buffer, or is it too large and must it be queued separately?}\n if ACount < UncompressedDataBufferSize then\n begin\n LPBufData := FPIntermediateCompressionBuffer.GetDataPointer(0);\n System.Move(LPSource^, LPBufData^, ACount);\n Dec(FIntermediateCompressionBufferAvailableBytes, ACount);\n end\n else\n begin\n {The remaining data is larger than the intermediate buffer: queue it\n separately}\n GetMem(LPLargeBuf, ACount + SizeOf(TAbQueuedBuffer));\n LPLargeBuf.DataSize := ACount;\n LPLargeBuf.QueueBuffer(Self);\n {Copy the data across}\n LPBufData := LPLargeBuf.GetDataPointer(0);\n System.Move(LPSource^, LPBufData^, ACount);\n end;\n {Update the number of bytes written}\n Inc(Result, ACount);\n finally\n LeaveCriticalSection(FBufferCriticalSection);\n end;\n {Wake up the compression thread to compress the newly queued data}\n WakeCompressionThread;\n end;\n\n Inc(FTotalBytesWritten, Result);\nend;\n\n{ TAbLZMACompressionThread }\n\n{$IFNDEF HasThreadFinished}\nprocedure TAbLZMACompressionThread.DoTerminate;\nbegin\n inherited DoTerminate;\n FFinished := True;\nend;\n{$ENDIF}\n\nprocedure TAbLZMACompressionThread.Execute;\nvar\n LInStreamRec: CSeqInStream_Compress;\n LOutStreamRec: CSeqOutStream_Compress;\nbegin\n {Call the compression function and save the error code}\n LInStreamRec.Intf.Read := ISeqInStream_Compress_Read;\n LInStreamRec.CompressionStream := FCompressionStream;\n LOutStreamRec.Intf.Write := ISeqOutStream_Compress_Write;\n LOutStreamRec.OutputStream := FCompressionStream.FOutputStream;\n FCompressionStream.FCompressionErrorCode := LzmaEnc_Encode(FCompressionStream.FLZMAEncHandle,\n @LOutStreamRec.Intf, @LInStreamRec.Intf, nil, @DelphiMMInterface, @DelphiMMInterface);\n {Free the compression handle}\n LzmaEnc_Destroy(FCompressionStream.FLZMAEncHandle, @DelphiMMInterface, @DelphiMMInterface);\n FCompressionStream.FLZMAEncHandle := nil;\nend;\n\n{ TAbLZMADecompressionStream }\n\nconstructor TAbLZMADecompressionStream.Create(ASourceStream: TStream);\nvar\n LLZMAPropData: TLZMAPropertyData;\nbegin\n inherited Create;\n\n FSourceStream := ASourceStream;\n\n {Read the header and uncompressed size from the compressed data stream.}\n FSourceStream.ReadBuffer(LLZMAPropData, LZMA_PROPS_SIZE);\n FSourceStream.ReadBuffer(FUncompressedSize, SizeOf(FUncompressedSize));\n\n {Initialize the decompressor using the information from the header}\n LzmaDec_Construct(FLzmaState);\n LzmaCheck(LzmaDec_Allocate(FLzmaState, PByte(@LLZMAPropData), LZMA_PROPS_SIZE,\n @DelphiMMInterface));\n LzmaDec_Init(FLzmaState);\nend;\n\ndestructor TAbLZMADecompressionStream.Destroy;\nvar\n LUnusedBytes: Integer;\nbegin\n {Release all decompression resources.}\n LzmaDec_Free(FLzmaState, @DelphiMMInterface);\n\n {Any unconsumed bytes in the compressed input buffer should be returned to\n the source stream.}\n LUnusedBytes := FCompressedDataBufferSize - FCompressedDataBufferPosition;\n if LUnusedBytes > 0 then\n FSourceStream.Position := FSourceStream.Position - LUnusedBytes;\n\n inherited Destroy;\nend;\n\nfunction TAbLZMADecompressionStream.GetBytesRead: Int64;\nbegin\n Result := FBytesDecompressed - FReadBufferAvailableBytes;\nend;\n\nfunction TAbLZMADecompressionStream.GetSize: Int64;\nbegin\n Result := FUncompressedSize;\nend;\n\nfunction TAbLZMADecompressionStream.InternalDecompressToBuffer(APBuffer: Pointer;\n ABufferSize: Integer): Integer;\nvar\n LInputBytesProcessed, LOutputBytesProcessed: size_t;\n LFinishMode: Integer;\n LStatus: ELzmaStatus;\nbegin\n Result := 0;\n {Any more data to decompress to the output buffer?}\n while ABufferSize > 0 do\n begin\n {Read more compressed data into the compressed data buffer, if required.}\n if FCompressedDataBufferPosition >= FCompressedDataBufferSize then\n begin\n FCompressedDataBufferSize := FSourceStream.Read(FCompressedDataBuffer,\n CompressedDataBufferSize);\n FCompressedDataBufferPosition := 0;\n end;\n\n {Initialize the \"processed byte count\" variables to the sizes of the input\n and output buffers.}\n LInputBytesProcessed := FCompressedDataBufferSize - FCompressedDataBufferPosition;\n LOutputBytesProcessed := ABufferSize;\n {We may not read more bytes than the number of uncompressed bytes according\n to the header.}\n if (FUncompressedSize - FBytesDecompressed) <= LOutputBytesProcessed then\n begin\n LOutputBytesProcessed := FUncompressedSize - FBytesDecompressed;\n LFinishMode := LZMA_FINISH_END;\n end\n else\n LFinishMode := LZMA_FINISH_ANY;\n\n {Decompress from the input to the output buffer}\n LzmaCheck(LzmaDec_DecodeToBuf(FLzmaState, APBuffer,\n LOutputBytesProcessed, @FCompressedDataBuffer[FCompressedDataBufferPosition],\n LInputBytesProcessed, LFinishMode, LStatus));\n\n {Update the input and output buffer stats}\n Inc(FCompressedDataBufferPosition, LInputBytesProcessed);\n Inc(PAnsiChar(APBuffer), LOutputBytesProcessed);\n Dec(ABufferSize, LOutputBytesProcessed);\n\n {Update the number of bytes decompressed}\n Inc(Result, LOutputBytesProcessed);\n Inc(FBytesDecompressed, LOutputBytesProcessed);\n\n {Was all the data decompressed? If so, break the loop.}\n if FUncompressedSize = FBytesDecompressed then\n Break;\n\n {Was nothing from the input or output streams processed? If so, then\n something has gone wrong.}\n if (LInputBytesProcessed = 0) and (LOutputBytesProcessed = 0) then\n raise Exception.Create('LZMA decompression data error');\n\n end;\nend;\n\nfunction TAbLZMADecompressionStream.Read(var ABuffer; ACount: Integer): Integer;\nvar\n LBytesAlreadyRead: Integer;\nbegin\n {Anything to read?}\n if ACount > 0 then\n begin\n {Do we have enough data in the read buffer to satisfy the request?}\n if FReadBufferAvailableBytes >= ACount then\n begin\n {Enough data in the buffer: Fill the output buffer.}\n System.Move(PAnsiChar(@FUncompressedDataBuffer)[FReadBufferSize - FReadBufferAvailableBytes],\n ABuffer, ACount);\n {Subtract from the available bytes in the read buffer.}\n Dec(FReadBufferAvailableBytes, ACount);\n {Successfully read the number of bytes requested}\n Result := ACount;\n end\n else\n begin\n {Not enough bytes available in the read buffer: Is there anything\n available in the uncompressed data buffer? If so, then transfer what we\n have.}\n if FReadBufferAvailableBytes > 0 then\n begin\n {There is some data in the buffer: Read everything}\n System.Move(PAnsiChar(@FUncompressedDataBuffer)[FReadBufferSize - FReadBufferAvailableBytes],\n ABuffer, FReadBufferAvailableBytes);\n LBytesAlreadyRead := FReadBufferAvailableBytes;\n FReadBufferAvailableBytes := 0;\n end\n else\n LBytesAlreadyRead := 0;\n {If we get here it means the read buffer has been emptied and some data\n still has to be read: Do we need to fill up the read buffer again, or do\n we read directly into the target buffer? Large reads bypass the read\n buffering mechanism.}\n if ACount <= MaximumBlockSizeForBufferedIO then\n begin\n {Try to fill the read buffer again}\n FReadBufferSize := InternalDecompressToBuffer(@FUncompressedDataBuffer, UncompressedDataBufferSize);\n FReadBufferAvailableBytes := FReadBufferSize;\n {No more data available? If so we're done.}\n if FReadBufferAvailableBytes = 0 then begin\n Result := LBytesAlreadyRead;\n Exit;\n end;\n {Is enough data now available?}\n if FReadBufferAvailableBytes >= (ACount - LBytesAlreadyRead) then\n begin\n {Enough data in the buffer: Fill the output buffer.}\n System.Move(FUncompressedDataBuffer,\n PAnsiChar(@ABuffer)[LBytesAlreadyRead],\n ACount - LBytesAlreadyRead);\n {Subtract from the available bytes in the read buffer and return the\n number of bytes read.}\n Dec(FReadBufferAvailableBytes, ACount - LBytesAlreadyRead);\n {Successfully read the number of bytes requested}\n Result := ACount;\n end\n else\n begin\n {Enough data is still not available (the end of the compressed stream\n has been reached): Read what we can.}\n System.Move(FUncompressedDataBuffer,\n PAnsiChar(@ABuffer)[LBytesAlreadyRead],\n FReadBufferAvailableBytes);\n Inc(LBytesAlreadyRead, FReadBufferAvailableBytes);\n FReadBufferAvailableBytes := 0;\n Result := LBytesAlreadyRead;\n end;\n end\n else\n begin\n {Decompress directly into the output buffer.}\n Result := InternalDecompressToBuffer(\n @PAnsiChar(@ABuffer)[LBytesAlreadyRead],\n ACount - LBytesAlreadyRead) + LBytesAlreadyRead;\n end;\n end;\n end\n else\n Result := 0;\nend;\n\nfunction TAbLZMADecompressionStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;\nbegin\n Result := GetBytesRead;\n if ((AOrigin <> soBeginning) or (AOffset <> Result))\n and ((AOrigin <> soCurrent) or (AOffset <> 0)) then\n begin\n raise Exception.Create('Decompression streams do not support seeking away '\n + 'from the current position.');\n end;\nend;\n\nfunction TAbLZMADecompressionStream.Seek(AOffset: Integer; AOrigin: Word): Integer;\nbegin\n Result := Seek(Int64(AOffset), TSeekOrigin(AOrigin));\nend;\n\nfunction TAbLZMADecompressionStream.Write(const ABuffer; ACount: Integer): Integer;\nbegin\n raise Exception.Create('Writing to a LZMA decompression stream is not supported.');\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbMeter.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbMeter.pas *}\n{*********************************************************}\n{* ABBREVIA: Progress meter *}\n{* Use AbQMeter.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbMeter;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n {$IFDEF MSWINDOWS}\n Windows,\n {$ENDIF}\n {$IFDEF LibcAPI}\n Libc,\n {$ENDIF}\n {$IFDEF UsingCLX }\n QControls, QGraphics, QForms, QExtCtrls,\n {$ELSE}\n Controls, Graphics, Forms, ExtCtrls,\n {$ENDIF}\n AbBrowse;\n\ntype\n TAbMeterOrientation = (moHorizontal, moVertical);\n\n TAbCustomMeter = class(TGraphicControl, IAbProgressMeter)\n {.Z+}\n protected {private}\n {property variables}\n FBorderStyle : TBorderStyle;\n FCtl3D : Boolean;\n FOrientation : TAbMeterOrientation;\n FPercent : Integer;\n \tFTickMarks : Byte;\n FUsedColor : TColor;\n FUnusedColor : TColor;\n\n {internal methods}\n function GetVersion : string;\n procedure Paint;\n override;\n procedure SetBorderStyle(const Value : TBorderStyle);\n procedure SetCtl3D(const Value : Boolean);\n procedure SetOrientation(const O : TAbMeterOrientation);\n procedure SetTickMarks(const Value: Byte);\n procedure SetUnusedColor(const C : TColor);\n procedure SetUsedColor(const C : TColor);\n procedure SetVersion(Value : string);\n property Version : string\n read GetVersion write SetVersion stored False;\n\n {.Z-}\n public {methods}\n constructor Create(AOwner : TComponent);\n override;\n procedure DoProgress(Progress : Byte);\n procedure Reset;\n\n public {properties}\n property BorderStyle : TBorderStyle\n read FBorderStyle write SetBorderStyle default bsSingle;\n property Ctl3D : Boolean\n read FCtl3D write SetCtl3D default True;\n property Orientation : TAbMeterOrientation\n read FOrientation write SetOrientation;\n property TickMarks: Byte\n\t\t read FTickMarks write SetTickMarks default 10;\n property UnusedColor : TColor\n read FUnusedColor write SetUnusedColor;\n property UsedColor : TColor\n read FUsedColor write SetUsedColor;\n end;\n\n TAbMeter = class(TAbCustomMeter)\n published\n property Anchors;\n property Constraints;\n property Align;\n property BorderStyle;\n property Ctl3D;\n property Font;\n property OnClick;\n property OnDblClick;\n property OnMouseDown;\n property OnMouseMove;\n property OnMouseUp;\n property Orientation;\n property ParentFont;\n property ParentShowHint;\n property ShowHint;\n property TickMarks;\n property UnusedColor;\n property UsedColor;\n property Version;\n property Visible;\n end;\n {.Z+}\n\n\nimplementation\n\nuses\n Types, AbConst;\n\n{ == TAbCustomMeter ======================================================== }\nconstructor TAbCustomMeter.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\n {$IFNDEF UsingCLX}\n if NewStyleControls then\n ControlStyle := ControlStyle + [csOpaque]\n else\n ControlStyle := ControlStyle + [csOpaque, csFramed];\n {$ELSE}\n ControlStyle := ControlStyle + [csOpaque, csFramed];\n {$ENDIF}\n\n FBorderStyle := bsSingle;\n FCtl3D := True;\n FOrientation := moHorizontal;\n FTickMarks := 10;\n FUnusedColor := clBtnFace;\n FUsedColor := clNavy;\n Width := 150;\n Height := 16;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomMeter.GetVersion : string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.DoProgress(Progress : Byte);\nbegin\n if (Progress <> FPercent) then begin\n FPercent := Progress;\n if (FPercent >= 100) then\n FPercent := 0;\n Refresh;\n Application.ProcessMessages;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.Paint;\nconst\n VSpace = 2;\n HSpace = 1;\n LSpace = 1;\n RSpace = 1;\nvar\n ClRect, R : TRect;\n ClWidth : Integer;\n ClHeight : Integer;\n BlockWidth : Integer;\n BlockCount : Integer;\n i : Integer;\nbegin\n ClRect := ClientRect;\n\n ClWidth := ClRect.Right - CLRect.Left + 1;\n ClHeight := ClRect.Bottom - ClRect.Top + 1;\n\n if (Orientation = moHorizontal) then\n BlockWidth := ((ClWidth - LSpace - RSpace - (9 * VSpace)) div FTickMarks) + 1\n else\n BlockWidth := ((ClHeight - LSpace - RSpace - (9 * HSpace)) div FTickMarks) + 1;\n BlockCount := FPercent div FTickMarks;\n\n if not Assigned((Canvas as TControlCanvas).Control) then begin\n TControlCanvas(Canvas).Control := self;\n end;\n with Canvas do begin\n Brush.Color := FUnusedColor;\n FillRect(Rect(ClRect.Left, ClRect.Top, ClRect.Left + ClWidth - 1,\n ClRect.Top + ClHeight - 1));\n Brush.Color := FUsedColor;\n if (BlockCount > 0) then begin\n if (Orientation = moHorizontal) then begin\n R.Top := ClRect.Top + HSpace;\n R.Bottom := ClRect.Bottom - HSpace;\n for i := 0 to Pred(BlockCount) do begin\n R.Left := ClRect.Left + LSpace + (i * VSpace) +\n (i * BlockWidth);\n R.Right := R.Left + BlockWidth;\n FillRect(R);\n end;\n end else begin {moVertical}\n R.Left := ClRect.Left + VSpace;\n R.Right := ClRect.Right - VSpace;\n for i := 0 to Pred(BlockCount) do begin\n R.Bottom := ClRect.Bottom - LSpace - (i * HSpace) -\n (i * BlockWidth);\n R.Top := R.Bottom - BlockWidth;\n FillRect(R);\n end;\n end;\n end;\n end;\n {$IFNDEF LCL}\n if (BorderStyle <> bsNone) then begin\n if Ctl3D then\n Frame3D(Canvas, ClRect, clBtnShadow, clBtnHighlight, 1)\n else\n Frame3D(Canvas, ClRect, clBlack, clBlack, 1);\n end;\n {$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.Reset;\nbegin\n DoProgress(0);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetBorderStyle(const Value : TBorderStyle);\nbegin\n if (Value <> FBorderStyle) then begin\n FBorderStyle := Value;\n Invalidate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetCtl3D(const Value : Boolean);\nbegin\n if (Value <> FCtl3D) then begin\n FCtl3D := Value;\n Invalidate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetOrientation(const O : TAbMeterOrientation);\nvar\n Temp : Integer;\nbegin\n if (O <> FOrientation) then begin\n FOrientation := O;\n if not (csLoading in ComponentState) then begin\n Temp := Width;\n Width := Height;\n Height := Temp;\n end;\n Invalidate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetTickMarks(const Value: Byte);\nbegin\n\tif Value <= 0 then\n\t FTickMarks := 10\n\telse\n\t FTickMarks := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetUnusedColor(const C : TColor);\nbegin\n if (C <> FUnusedColor) then begin\n FUnusedColor := C;\n Invalidate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetUsedColor(const C : TColor);\nbegin\n if (C <> FUsedColor) then begin\n FUsedColor := C;\n Invalidate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomMeter.SetVersion(Value : string);\nbegin\n {NOP}\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbPPMd.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is Craig Peterson\n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPPMd.pas *}\n{*********************************************************}\n{* ABBREVIA: PPMd decompression *}\n{*********************************************************}\n\nunit AbPPMd;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes;\n\nprocedure DecompressPPMd(aSrc, aDes: TStream);\n\nimplementation\n\nuses\n AbCrtl,\n SysUtils,\n AbExcept;\n\n\n// Compiled with:\n// Release: bcc32 -q -c *.c\n// Debug: bcc32 -q -c -v -y *.c\n\n\n{ Linker derectives ======================================================== }\n\n// Don't re-order these; it will cause linker errors\n{$IF DEFINED(WIN32)}\n {$L Win32\\PPMdVariantI.obj}\n {$L Win32\\PPMdContext.obj}\n {$L Win32\\PPMdSubAllocatorVariantI.obj}\n {$L Win32\\CarrylessRangeCoder.obj}\n{$ELSEIF DEFINED(WIN64)}\n {$L Win64\\PPMdVariantI.obj}\n {$L Win64\\PPMdContext.obj}\n {$L Win64\\PPMdSubAllocatorVariantI.obj}\n {$L Win64\\CarrylessRangeCoder.obj}\n{$IFEND}\n\n\n{ CarrylessRangeCoder.h ==================================================== }\n\ntype\n PInStream = ^TInStream;\n TInStream = record\n\t nextByte: function(Self: PInStream): Byte; cdecl;\n // Private data\n stream: TStream;\n InPos: Integer;\n InCount: Integer;\n InBuf: array[0..4097] of Byte;\n end;\n{ -------------------------------------------------------------------------- }\nfunction TInStream_NextByte(Self: PInStream): Byte; cdecl;\nbegin\n if Self.InPos = Self.InCount then begin\n Self.InCount := Self.stream.Read(Self.InBuf, SizeOf(Self.InBuf));\n if Self.InCount = 0 then\n raise EAbReadError.Create;\n Self.InPos := 0;\n end;\n Result := Self.InBuf[Self.InPos];\n Inc(Self.InPos);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TInStream_Create(aStream: TStream): PInStream;\nbegin\n GetMem(Result, SizeOf(TInStream));\n Result.nextByte := TInStream_NextByte;\n Result.stream := aStream;\n Result.InPos := 0;\n Result.InCount := 0;\nend;\n\n\n{ PPMdVariantI.h =========================================================== }\n\ntype\n PPMdModelVariantI = Pointer;\n\nfunction CreatePPMdModelVariantI(const input: TInStream;\n suballocsize, maxorder, restoration: Integer): PPMdModelVariantI; cdecl; external;\nprocedure FreePPMdModelVariantI(Self: PPMdModelVariantI); cdecl; external;\n\nfunction NextPPMdVariantIByte(Self: PPMdModelVariantI): Integer; cdecl; external;\n\n\n{ Decompression routines =================================================== }\n\nprocedure DecompressPPMd(aSrc, aDes: TStream);\nconst\n OutBufSize = 4096;\nvar\n nextByte: Integer;\n params: word;\n ppmd: PPMdModelVariantI;\n Src: PInStream;\n OutBuf: PByteArray;\n OutPos: Integer;\nbegin\n Src := TInStream_Create(aSrc);\n try\n GetMem(OutBuf, OutBufSize);\n try\n OutPos := 0;\n\n ASrc.ReadBuffer(Params, SizeOf(Params));// Pkzip stream header\n ppmd := CreatePPMdModelVariantI(Src^,\n (((Params shr 4) and $FF) + 1) shl 20,// sub-allocator size\n (Params and $0F) + 1, // model order\n Params shr 12); // model restoration method\n try\n while True do begin\n nextByte := NextPPMdVariantIByte(ppmd);\n if nextByte < 0 then Break;\n OutBuf[OutPos] := Byte(nextByte);\n Inc(OutPos);\n if OutPos = OutBufSize then begin\n aDes.WriteBuffer(OutBuf^, OutBufSize);\n OutPos := 0;\n end;\n end;\n if OutPos > 0 then\n aDes.WriteBuffer(OutBuf^, OutPos);\n finally\n FreePPMdModelVariantI(ppmd);\n end;\n finally\n FreeMem(OutBuf);\n end;\n finally\n FreeMem(Src);\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbPeCol.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPeCol.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - ZipView column headings *}\n{* Use AbQPeCol.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbPeCol;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF UsingClx}\n QGraphics,\n QForms,\n QControls,\n QStdCtrls,\n QButtons,\n QExtCtrls,\n AbQView,\n AbBseCLX,\n{$ELSE}\n Graphics,\n Forms,\n Controls,\n StdCtrls,\n Buttons,\n ExtCtrls,\n AbView,\n AbBseVcl,\n{$ENDIF}\n DesignIntf,\n DesignEditors,\n AbConst,\n SysUtils,\n Classes;\n\ntype\n TAbColHeadingsEditor = class(TForm)\n Panel1: TPanel;\n Label1: TLabel;\n Attribute1: TComboBox;\n Done1: TBitBtn;\n Apply1: TBitBtn;\n Label2: TLabel;\n Heading1: TEdit;\n Button1: TButton;\n procedure FormShow(Sender: TObject);\n procedure Attribute1Click(Sender: TObject);\n procedure Apply1Click(Sender: TObject);\n procedure Heading1Exit(Sender: TObject);\n private\n { Private declarations }\n public\n Viewer : TAbBaseViewer;\n\n end;\n\n TAbColHeadingsProperty = class(TClassProperty)\n public\n procedure Edit; override;\n function GetAttributes: TPropertyAttributes; override;\n end;\n\n\nvar\n AbColHeadingsEditor: TAbColHeadingsEditor;\n\nimplementation\n\nuses\n AbResString;\n\n{$IFNDEF UsingCLX}\n{$R *.dfm}\n{$ENDIF}\n\ntype\n TAbViewerFriend = class(TAbBaseViewer);\n\n\n{===TAbColHeadingsProperty==========================================}\nprocedure TAbColHeadingsProperty.Edit;\nvar\n hEditor : TAbColHeadingsEditor;\nbegin\n hEditor := TAbColHeadingsEditor.Create(Application);\n try\n hEditor.Viewer := TAbViewerFriend(GetComponent(0));\n hEditor.ShowModal;\n Designer.Modified;\n finally\n hEditor.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbColHeadingsProperty.GetAttributes: TPropertyAttributes;\n begin\n Result := inherited GetAttributes + [paDialog, paAutoUpdate];\n end;\n\n\n{===TAbColHeadingsEditor============================================}\n\nprocedure TAbColHeadingsEditor.FormShow(Sender: TObject);\nconst\n cResString: array[TAbViewAttribute] of string = (AbItemNameHeadingS,\n AbPackedHeadingS, AbMethodHeadingS, AbRatioHeadingS, AbCRCHeadingS,\n AbFileAttrHeadingS, AbFileFormatHeadingS, AbEncryptionHeadingS,\n AbTimeStampHeadingS, AbFileSizeHeadingS, AbVersionMadeHeadingS,\n AbVersionNeededHeadingS, AbPathHeadingS);\nvar\n i : TAbViewAttribute;\nbegin\n with Attribute1 do begin\n Clear;\n for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do\n Items.Add(cResString[i]);\n\n ItemIndex := 0;\n end;\n Attribute1Click(nil);\nend;\n\nprocedure TAbColHeadingsEditor.Attribute1Click(Sender: TObject);\nbegin\n if (Attribute1.ItemIndex > -1) then\n Heading1.Text := TAbViewerFriend(Viewer).Headings[Attribute1.ItemIndex];\nend;\n\nprocedure TAbColHeadingsEditor.Apply1Click(Sender: TObject);\nbegin\n if (Attribute1.ItemIndex > -1) then begin\n TAbViewerFriend(Viewer).Headings[Attribute1.ItemIndex] := Heading1.Text;\n TAbViewerFriend(Viewer).InvalidateRow(0);\n end;\nend;\n\nprocedure TAbColHeadingsEditor.Heading1Exit(Sender: TObject);\nbegin\n Apply1Click(nil);\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbPeDir.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPeDir.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - Directory *}\n{* Use AbQPeDir.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbPeDir;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF UsingClx}\n QGraphics,\n QForms,\n QControls,\n QStdCtrls,\n QButtons,\n QExtCtrls,\n{$ELSE}\n Graphics,\n Forms,\n Controls,\n StdCtrls,\n Buttons,\n ExtCtrls,\n{$ENDIF}\n DesignIntf,\n DesignEditors,\n SysUtils,\n Classes;\n\ntype\n TAbDirectoryProperty = class( TStringProperty )\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\nimplementation\n\nuses\n{$IFDEF UsingClx}\n AbQDgDir;\n{$ELSE}\n AbDlgDir;\n{$ENDIF}\n\n\nfunction TAbDirectoryProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog];\nend;\n\n{$IFDEF MSWINDOWS}\nprocedure TAbDirectoryProperty.Edit;\nvar\n D : TAbDirDlg;\nbegin\n D := TAbDirDlg.Create(Application);\n try\n D.Caption := 'Directory';\n D.AdditionalText := 'Select Directory';\n if D.Execute then\n Value := D.SelectedFolder;\n finally\n D.Free;\n end;\nend;\n{$ELSE}\nprocedure TAbDirectoryProperty.Edit;\nvar\n D : TDirDlg;\nbegin\n D := TDirDlg.Create(Application);\n try\n{$IFDEF MSWINDOWS}\n D.DirectoryListBox1.Directory := Value;\n{$ENDIF}\n D.ShowModal;\n if D.ModalResult = mrOK then\n Value := D.SelectedFolder;\n finally\n D.Free;\n end;\nend;\n{$ENDIF}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbPeFn.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPeFn.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - FileName *}\n{* Use AbQPeFn.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbPeFn;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF UsingClx }\n QDialogs, QForms,\n{$ELSE}\n Dialogs, Forms,\n{$ENDIF}\n DesignIntf,\n DesignEditors,\n SysUtils;\n\n\ntype\n TAbFileNameProperty = class(TStringProperty)\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\n TAbExeNameProperty = class(TStringProperty)\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\n TAbCabNameProperty = class( TStringProperty )\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\n TAbLogNameProperty = class( TStringProperty )\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\nimplementation\n\nuses\n AbResString,\n AbArcTyp;\n\n{ -------------------------------------------------------------------------- }\nprocedure AbGetFilename(const Ext : string;\n const Filter : string;\n const Title : string;\n var aFilename : string);\nvar\n D : TOpenDialog;\nbegin\n D := TOpenDialog.Create( Application );\n try\n D.DefaultExt := Ext;\n D.Filter := Filter;\n D.FilterIndex := 0;\n D.Options := [];\n D.Title := Title;\n D.FileName := aFilename;\n if D.Execute then\n aFilename := D.FileName;\n finally\n D.Free;\n end;\nend;\n\n{ == for zip files ========================================================= }\nfunction TAbFileNameProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog];\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbFileNameProperty.Edit;\nvar\n FN : string;\nbegin\n FN := Value;\n AbGetFilename(AbDefaultExtS, AbFilterS, AbFileNameTitleS, FN);\n Value := FN;\nend;\n\n{ == for exe files ========================================================= }\nfunction TAbExeNameProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog];\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbExeNameProperty.Edit;\nvar\n FN : string;\nbegin\n FN := Value;\n AbGetFilename(AbExeExtS, AbExeFilterS, AbFileNameTitleS, FN);\n Value := FN;\nend;\n\n{ == for cab files ========================================================= }\nfunction TAbCabNameProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog];\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCabNameProperty.Edit;\nvar\n FN : string;\nbegin\n FN := Value;\n AbGetFilename(AbCabExtS, AbCabFilterS, AbFileNameTitleS, FN);\n Value := FN;\nend;\n\n{ == for log files ========================================================= }\nfunction TAbLogNameProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog];\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbLogNameProperty.Edit;\nvar\n FN : string;\nbegin\n FN := Value;\n AbGetFilename(AbLogExtS, AbLogFilterS, AbFileNameTitleS, FN);\n Value := FN;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbPePass.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPePass.pas *}\n{*********************************************************}\n{* ABBREVIA: Password property editor *}\n{* Use AbQPePas.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbPePass;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF UsingClx}\n QGraphics,\n QForms,\n QControls,\n QStdCtrls,\n QButtons,\n QExtCtrls,\n{$ELSE}\n Graphics,\n Forms,\n Controls,\n StdCtrls,\n Buttons,\n ExtCtrls,\n{$ENDIF}\n DesignIntf,\n DesignEditors,\n SysUtils,\n Classes;\n\ntype\n TAbPasswordProperty = class( TStringProperty )\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\nimplementation\n\nuses\n{$IFDEF UsingClx}\n AbQDgPwd;\n{$ELSE}\n AbDlgPwd;\n{$ENDIF}\n\nfunction TAbPasswordProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog];\nend;\n\nprocedure TAbPasswordProperty.Edit;\nvar\n D : TPasswordDlg;\nbegin\n D := TPasswordDlg.Create( Application );\n try\n D.Edit1.Text := Value;\n D.ShowModal;\n if D.ModalResult = mrOK then\n Value := D.Edit1.Text;\n finally\n D.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbPeVer.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPeVer.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - Version *}\n{* Use AbQPeVer.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbPeVer;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n ShellAPI,\n{$ENDIF}\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n{$IFDEF UsingClx}\n QGraphics,\n QForms,\n QControls,\n QStdCtrls,\n QButtons,\n QExtCtrls,\n QDialogs,\n{$ELSE}\n Graphics,\n Forms,\n Controls,\n StdCtrls,\n Buttons,\n ExtCtrls,\n Dialogs,\n{$ENDIF}\n DesignIntf,\n DesignEditors,\n SysUtils,\n Classes;\n\ntype\n TAbAboutBox = class(TForm)\n lblVersion: TLabel;\n Panel1: TPanel;\n Image1: TImage;\n btnOK: TButton;\n Panel2: TPanel;\n WebLbl: TLabel;\n NewsLbl: TLabel;\n Bevel1: TBevel;\n Label1: TLabel;\n Label2: TLabel;\n Label3: TLabel;\n Label5: TLabel;\n Label6: TLabel;\n Label7: TLabel;\n Label10: TLabel;\n Label11: TLabel;\n procedure FormCreate(Sender: TObject);\n procedure btnOKClick(Sender: TObject);\n procedure WebLblClick(Sender: TObject);\n procedure WebLblMouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\n procedure NewsLblClick(Sender: TObject);\n procedure NewsLblMouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\n procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\n procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\n\n TAbVersionProperty = class( TStringProperty )\n public\n function GetAttributes: TPropertyAttributes;\n override;\n procedure Edit;\n override;\n end;\n\nvar\n AbAboutBox : TAbAboutBox;\n\nimplementation\n\n{$IFNDEF UsingCLX}\n{$R *.dfm}\n{$ENDIF}\n\nuses\n AbArcTyp,\n AbConst,\n AbResString;\n\n{$IFDEF LINUX}\nconst\n { String Constants }\n sCannotStartBrowser = 'Unable to start web browser. Make sure you have it properly set-up on your system.';\n\nconst\n MaxBrowsers = 1;\n\ntype\n ECannotStartBrowser = class(Exception);\n\ntype\n TBrowserStartCmd = record\n Command : string [64];\n Parameters : string [255];\n XTerm : Boolean; { Start browser in an XTerm }\n end;\n\nconst\n { The list of browsers we can launch. }\n\n BrowserList : array [1..MaxBrowsers] of TBrowserStartCmd =\n ((Command : 'netscape'; Parameters : ''; Xterm : False));\n\n\nprocedure GetCurrentPath (PathList : TStringList);\nvar\n WorkPath : PChar;\n StartPos : PChar;\n CurrentPath : PChar;\n State : (Scanning, GotColon);\nbegin\n WorkPath := getenv ('PATH');\n\n PathList.Clear;\n\n StartPos := WorkPath;\n State := Scanning;\n while (WorkPath^ <> #0) do begin\n case State of\n Scanning :\n begin\n if (WorkPath^ = ':') then begin\n State := GotColon;\n if (WorkPath <> StartPos) then begin\n CurrentPath := StrAlloc(WorkPath - StartPos + 1);\n StrLCopy(CurrentPath, StartPos, WorkPath-StartPos);\n PathList.Add (CurrentPath);\n StrDispose(CurrentPath);\n end;\n end;\n end;\n GotColon :\n begin\n if (WorkPath^ <> ':') then begin\n StartPos := WorkPath;\n State := Scanning;\n end;\n end;\n end;{case}\n inc(WorkPath);\n end;\n if (State = Scanning) and (WorkPath <> StartPos) then begin\n CurrentPath := StrAlloc(WorkPath - StartPos + 1);\n StrLCopy(CurrentPath, StartPos, WorkPath-StartPos);\n PathList.Add (CurrentPath);\n StrDispose(CurrentPath);\n end;\nend;\n\n\nfunction IsBrowserPresent (PathList : TStringList;\n Browser : string) : Boolean;\nvar\n i : integer;\nbegin\n Result := False;\n for i := 0 to PathList.Count - 1 do begin\n if FileExists (PathList[i] + '/' + Browser) then begin\n Result := True;\n exit;\n end;\n end;\nend;\n\nprocedure CallBrowser (Browser : string;\n Parameters : string;\n Website : string;\n XTerm : Boolean);\nbegin\n if Pos ('', Parameters) > 0 then begin\n Parameters := Copy (Parameters, 1, Pos ('', Parameters) - 1) +\n Website +\n Copy (Parameters, Pos ('', Parameters) + 6, 255);\n end else\n Parameters := Parameters + ' ' + Website;\n if XTerm then begin\n Parameters := '-e ' + Browser + ' ' + Parameters;\n Browser := 'xterm';\n end;\n Libc.system (PChar (Browser + ' ' + Parameters + ' &'));\nend;\n\nprocedure StartBrowser (Website : string);\n\nvar\n PathList : TStringList;\n i : integer;\n\nbegin\n PathList := TStringList.Create;\n try\n GetCurrentPath (PathList);\n for i := 1 to MaxBrowsers do begin\n if IsBrowserPresent (PathList, BrowserList[i].Command) then begin\n CallBrowser (BrowserList[i].Command, BrowserList[i].Parameters,\n Website, BrowserList[i].XTerm);\n exit;\n end;\n end;\n raise ECannotStartBrowser.Create(sCannotStartBrowser);\n finally\n PathList.Free;\n end;\nend;\n{$ENDIF}\n\n\nprocedure TAbAboutBox.FormCreate(Sender: TObject);\nbegin\n Top := (Screen.Height - Height ) div 3;\n Left := (Screen.Width - Width ) div 2;\n lblVersion.Caption := Format(AbVersionFormatS, [AbVersionS] );\nend;\n\nfunction TAbVersionProperty.GetAttributes: TPropertyAttributes;\nbegin\n Result := [paDialog, paReadOnly];\nend;\n\nprocedure TAbVersionProperty.Edit;\nbegin\n with TAbAboutBox.Create( Application ) do\n try\n ShowModal;\n finally\n Free;\n end;\nend;\n\nprocedure TAbAboutBox.btnOKClick(Sender: TObject);\nbegin\n Close;\nend;\n\nprocedure TAbAboutBox.WebLblClick(Sender: TObject);\nbegin\n{$IFDEF MSWINDOWS }\n if ShellExecute(0, 'open', 'http://www.sourceforge.net/projects/tpabbrevia', '', '',\n SW_SHOWNORMAL) <= 32 then\n ShowMessage('Unable to start web browser');\n{$ENDIF MSWINDOWS }\n{$IFDEF LINUX }\n try\n StartBrowser('http://www.sourceforge.net/projects/tpabbrevia');\n except\n on ECannotStartBrowser do\n ShowMessage('Unable to start web browser');\n end;\n{$ENDIF LINUX }\n WebLbl.Font.Color := clNavy;\nend;\n\nprocedure TAbAboutBox.WebLblMouseMove(Sender: TObject; Shift: TShiftState;\n X, Y: Integer);\nbegin\n WebLbl.Font.Color := clRed;\nend;\n\nprocedure TAbAboutBox.NewsLblClick(Sender: TObject);\nbegin\n{$IFDEF MSWINDOWS }\n if ShellExecute(0, 'open', 'http://www.sourceforge.net/forum/forum.php?forum_id=241865', '', '',\n SW_SHOWNORMAL) <= 32 then\n ShowMessage('Unable to start web browser');\n{$ENDIF MSWINDOWS }\n{$IFDEF LINUX }\n try\n StartBrowser('http://www.sourceforge.net/forum/forum.php?forum_id=241865');\n except\n on ECannotStartBrowser do\n ShowMessage('Unable to start web browser');\n end;\n{$ENDIF LINUX }\n NewsLbl.Font.Color := clNavy;\nend;\n\nprocedure TAbAboutBox.NewsLblMouseMove(Sender: TObject; Shift: TShiftState;\n X, Y: Integer);\nbegin\n NewsLbl.Font.Color := clRed;\nend;\n\nprocedure TAbAboutBox.Panel2MouseMove(Sender: TObject; Shift: TShiftState;\n X, Y: Integer);\nbegin\n NewsLbl.Font.Color := clNavy;\nend;\n\nprocedure TAbAboutBox.FormMouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\nbegin\n WebLbl.Font.Color := clNavy;\n NewsLbl.Font.Color := clNavy;\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbQCView.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQCView.pas *}\n{*********************************************************}\n{* ABBREVIA: Cabinet archive viewer component (CLX) *}\n{* Use AbCView.pas for VCL *}\n{*********************************************************}\n\nUnit AbQCView;\n\n{$DEFINE UsingCLX}\n\n{$I AbCView.pas}\n\n\n"
},
{
"path": "lib/abbrevia/source/AbQCmpnd.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQCmpnd.pas *}\n{*********************************************************}\n{* ABBREVIA: Compound File classes and component (CLX) *}\n{* Use AbCompnd.pas for VCL *}\n{*********************************************************}\n\nunit AbQCmpnd;\n\n{$DEFINE UsingCLX}\n\n{$I AbCompnd.pas}\n\n\n"
},
{
"path": "lib/abbrevia/source/AbQDgDir.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQDgDir.pas *}\n{*********************************************************}\n{* ABBREVIA: Dialog - Directory (CLX) *}\n{* Use AbDlgDir.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingClx }\n\nunit AbQDgDir;\n\n{$R *.xfm}\n\n{$I AbDlgDir.pas}\n\n"
},
{
"path": "lib/abbrevia/source/AbQDgPwd.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQDgPwd.pas *}\n{*********************************************************}\n{* ABBREVIA: Dialog - Password (CLX) *}\n{* Use AbDlgPwd.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingClx}\n\nunit AbQDgPwd;\n\n{$R *.xfm}\n\n{$I AbDlgPwd.pas}\n\n"
},
{
"path": "lib/abbrevia/source/AbQHexVw.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQCmpnd.pas *}\n{*********************************************************}\n{* ABBREVIA: Compound File classes and component (CLX) *}\n{* Use AbCompnd.pas for VCL *}\n{*********************************************************}\n\nunit AbQHexVw;\n\n{$DEFINE UsingCLX}\n\n{$I AbHexVw.pas}\n\n\n"
},
{
"path": "lib/abbrevia/source/AbQMeter.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQMeter.pas *}\n{*********************************************************}\n{* ABBREVIA: Progress meter (CLX) *}\n{* Use AbMeter.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingCLX}\n\nunit AbQMeter;\n\n{$I AbMeter.pas}\n\n"
},
{
"path": "lib/abbrevia/source/AbQPeCol.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQPeCol.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - ZipView column headings *}\n{* (CLX) *}\n{* Use AbPeCol.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingClx}\n\nunit AbQPeCol;\n\n{$R *.xfm}\n\n{$I AbPeCol.pas}\n\n\n\n"
},
{
"path": "lib/abbrevia/source/AbQPeDir.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbPeDir.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - Directory (CLX) *}\n{* Use AbPeDir.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingCLX}\n\nunit AbQPeDir;\n\n{$I AbPeDir.pas}\n"
},
{
"path": "lib/abbrevia/source/AbQPeFn.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQPeFn.PAS *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - FileName (CLX) *}\n{* Use AbPeFn.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingClx}\n\nunit AbQPeFn;\n\n{$I AbPeFn.pas}\n\n"
},
{
"path": "lib/abbrevia/source/AbQPePas.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQPePas.pas *}\n{*********************************************************}\n{* ABBREVIA: Password property editor (CLX) *}\n{* Use AbPePass.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingClx}\n\nunit AbQPePas;\n\n{$I AbPePass.pas}\n\n\n"
},
{
"path": "lib/abbrevia/source/AbQPeVer.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQPeVer.pas *}\n{*********************************************************}\n{* ABBREVIA: Property Editor - Version (CLX) *}\n{* See AbPeVer.pas for the VCL header *}\n{*********************************************************}\n\n{$DEFINE UsingClx}\n\nunit AbQPeVer;\n\n{$R *.xfm}\n\n{$I AbPeVer.pas}\n\n"
},
{
"path": "lib/abbrevia/source/AbQView.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQView.pas *}\n{*********************************************************}\n{* ABBREVIA: Base archive viewer component (CLX) *}\n{* Use AbView.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingCLX}\n\nunit AbQView;\n\n{$I AbView.pas}\n\n"
},
{
"path": "lib/abbrevia/source/AbQZView.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQZView.pas *}\n{*********************************************************}\n{* ABBREVIA: Zip archive viewer component (CLX) *}\n{* Use AbZView.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingCLX}\n\nunit AbQZView;\n\n{$I AbZView.pas}\n\n\n"
},
{
"path": "lib/abbrevia/source/AbQZpOut.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbQZpOut.pas *}\n{*********************************************************}\n{* ABBREVIA: Visual Component with Zip and unzip support *}\n{* (CLX) *}\n{* Use AbZipOut.pas for VCL *}\n{*********************************************************}\n\n{$DEFINE UsingCLX}\n\nunit AbQZpOut;\n\n{$I AbZipOut.pas}\n\n\n"
},
{
"path": "lib/abbrevia/source/AbReg.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbReg.pas *}\n{*********************************************************}\n{* ABBREVIA: Registrations (VCL) *}\n{*********************************************************}\n\nunit AbReg;\n\n{$I AbDefine.inc}\n{$UNDEF UsingClx }\n\n{$R AbReg.res}\n\ninterface\n\nuses\n Classes,\n {$IFDEF LCL}\n LResources,\n {$ENDIF}\n {$IFDEF MSWINDOWS}\n AbCBrows, AbCabExt, AbCabMak, AbCabKit,\n {$ENDIF}\n AbZBrows, AbUnzper, AbZipper, AbZipKit, AbSelfEx;\n\nprocedure Register;\n\nimplementation\n\n{$IFNDEF FPC}\nuses\n AbUtils,\n AbPeDir,\n AbPeFn,\n AbPePass,\n AbPeVer,\n AbPeCol,\n DesignIntf,\n DesignEditors,\n SysUtils;\n{$ENDIF}\n\nprocedure Register;\nbegin\n{$IFNDEF FPC}\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'Version',\n TAbVersionProperty );\n{$ENDIF}\n\n RegisterComponents( 'Abbrevia',\n [ TAbZipBrowser,\n TAbUnzipper,\n TAbZipper,\n TAbZipKit,\n {$IFDEF MSWINDOWS}\n TAbCabBrowser,\n TAbCabExtractor,\n TAbMakeCab,\n TAbCabKit,\n {$ENDIF}\n TAbMakeSelfExe ]);\nend;\n\n{$IFDEF LCL}\ninitialization\n {$I abbrevia.lrs}\n{$ENDIF}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbRegClx.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbRegClx.pas *}\n{*********************************************************}\n{* ABBREVIA: Registrations (CLX) *}\n{*********************************************************}\n\nunit AbRegClx;\n\n{$I AbDefine.inc}\n{$DEFINE UsingCLX}\n\n{$R AbReg.res}\n\ninterface\n\n{$IFDEF LINUX}\n !! Error, this unit is for CLX on Windows, use AbRegLinux.pas for Linux\n{$ENDIF}\n\nuses\n Classes,\n AbCBrows, AbCabExt, AbCabMak, AbCabKit,\n AbZBrows, AbUnzper, AbZipper, AbZipKit, AbSelfEx,\n AbQCView, AbQZpOut, AbQView, AbQZView, AbQMeter;\n\nprocedure Register;\n\nimplementation\n\nuses\n AbUtils,\n AbQPeDir,\n AbQPeFn,\n AbQPePas,\n AbQPeVer,\n AbQPeCol,\n AbQDgDir,\n AbQDgPwd,\n DesignIntf,\n DesignEditors,\n SysUtils;\n\nprocedure Register;\nbegin\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile',\n TAbFileNameProperty );\n\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMeter, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings',\n TAbColHeadingsProperty );\n{$IFDEF MSWINDOWS}\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbCabView, 'Headings',\n TAbColHeadingsProperty );\n{$ENDIF}\n\n RegisterComponents( 'Abbrevia',\n [ TAbZipBrowser,\n TAbUnzipper,\n TAbZipper,\n TAbZipKit,\n TAbZipView,\n TAbZipOutline,\n\n{$IFDEF MSWINDOWS}\n TAbCabBrowser,\n TAbCabExtractor,\n TAbMakeCab,\n TAbCabKit,\n TAbCabView,\n{$ENDIF}\n\n TAbMeter,\n TAbMakeSelfExe ]);\n\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings',\n TAbColHeadingsProperty );\n\n RegisterComponents( 'Abbrevia',\n [\n TAbMeter,\n TAbCabView,\n TAbZipView,\n TAbZipOutline\n ]);\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbRegLinux.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbRegLinux.pas *}\n{*********************************************************}\n{* ABBREVIA: Registrations *}\n{*********************************************************}\n\nunit AbRegLinux;\n\n{$I AbDefine.inc}\n{$R AbReg.res}\n\ninterface\n\n{$IFDEF MSWINDOWS}\n !! Error, this unit is for CLX on Linux, use AbRegClx.pas for Windows\n{$ENDIF}\n\nuses\n Classes,\n AbQZpOut, AbQView, AbQZView, AbQMeter;\n\nprocedure Register;\n\nimplementation\n\nuses\n AbUtils,\n AbQPeDir,\n AbQPeFn,\n AbQPePas,\n AbQPeVer,\n AbQPeCol,\n AbZBrows,\n AbZipper,\n AbUnzper,\n AbZipKit,\n AbSelfEx,\n DesignIntf,\n DesignEditors;\n\nprocedure Register;\nbegin\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMeter, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings',\n TAbColHeadingsProperty );\n RegisterComponents( 'Abbrevia',\n [TAbZipBrowser,\n TAbUnzipper,\n TAbZipper,\n TAbZipKit,\n TAbZipOutline,\n TAbZipView,\n TAbMeter,\n TAbMakeSelfExe]);\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbRegVcl.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbRegVcl.pas *}\n{*********************************************************}\n{* ABBREVIA: Registrations (VCL) *}\n{*********************************************************}\n\nunit AbRegVcl;\n\n{$I AbDefine.inc}\n{$UNDEF UsingClx }\n\n{$R AbReg.res}\n\ninterface\n\nuses\n Classes,\n AbCBrows, AbCabExt, AbCabMak, AbCabKit, AbCView,\n AbCompnd, AbHexVw, AbZBrows, AbUnzper, AbZipper, AbZipKit, AbZipOut, \n AbView, AbComCtrls, AbZView, AbMeter, AbSelfEx, AbZipExt;\n\nprocedure Register;\n\nimplementation\n\nuses\n AbConst,\n AbUtils,\n AbPeDir,\n AbPeFn,\n AbPePass,\n AbPeVer,\n AbPeCol,\n DesignIntf,\n DesignEditors,\n Graphics,\n ToolsAPI,\n SysUtils,\n Windows;\n\nprocedure Register;\nbegin\n\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'FileName',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'SelfExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'StubExe',\n TAbExeNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'ZipFile',\n TAbFileNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbListView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbTreeView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMeter, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbProgressBar, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeSelfExe, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipBrowser, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbUnZipper, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipKit, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbZipOutline, 'Password',\n TAbPasswordProperty );\n RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbZipView, 'Headings',\n TAbColHeadingsProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'FileName',\n TAbCabNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'BaseDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'LogFile',\n TAbLogNameProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'TempDirectory',\n TAbDirectoryProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabBrowser, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbMakeCab, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabExtractor, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabKit, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( string ), TAbCabView, 'Version',\n TAbVersionProperty );\n RegisterPropertyEditor( TypeInfo( TAbColHeadings ), TAbCabView, 'Headings',\n TAbColHeadingsProperty );\n\n RegisterComponents( 'Abbrevia',\n [ TAbZipBrowser,\n TAbUnzipper,\n TAbZipper,\n TAbZipKit,\n TAbZipView,\n TAbZipOutline,\n TAbTreeView,\n TAbListView,\n TAbCabBrowser,\n TAbCabExtractor,\n TAbMakeCab,\n TAbCabKit,\n TAbCabView,\n TAbProgressBar,\n TAbMeter,\n TAbMakeSelfExe ]);\nend;\n\n{$IF DECLARED(IOTAAboutBoxServices)}\nvar\n AboutBoxIndex: Integer = -1;\n\nprocedure RegisterAboutBox;\nbegin\n SplashScreenServices.AddPluginBitmap(\n 'Abbrevia: Advanced data compression toolkit, v' + AbVersionS,\n LoadBitmap(HInstance, 'SPLASH'));\n AboutBoxIndex := (BorlandIDEServices as IOTAAboutBoxServices).AddPluginInfo(\n 'Abbrevia ' + AbVersionS,\n 'Abbrevia: Advanced data compression toolkit, v' + AbVersionS + sLineBreak +\n 'http://tpabbrevia.sourceforge.net/' + sLineBreak +\n sLineBreak +\n 'Copyright (c) 1997-2011 Abbrevia development team' + sLineBreak +\n 'Covered under the Mozilla Public License (MPL) v1.1' + sLineBreak +\n 'Abbrevia includes source code from bzip2, the LZMA SDK,' + sLineBreak +\n 'Dag gren''s version of PPMd, and the WavPack SDK.',\n LoadBitmap(HInstance, 'SPLASH'));\nend;\n\nprocedure UnregisterAboutBox;\nbegin\n if AboutBoxIndex <> -1 then\n (BorlandIDEServices as IOTAAboutBoxServices).RemovePluginInfo(AboutBoxIndex);\nend;\n\ninitialization\n RegisterAboutBox;\n\nfinalization\n UnRegisterAboutBox;\n{$IFEND}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbResString.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Roman Kassebaum\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* Abbrevia: AbResString.pas *}\n{*********************************************************}\n{* Abbrevia: Resource strings *}\n{*********************************************************}\n\nunit AbResString;\n\n{$I AbDefine.inc}\n\ninterface\n\nresourcestring\n AbErrZipInvalidS = 'Invalid file - not a PKZip file';\n AbZipVersionNeededS = 'Cannot extract file - newer version required';\n AbUnknownCompressionMethodS = 'Cannot extract file - unsupported compression method';\n AbNoExtractionMethodS = 'Cannot extract file - no extraction support provided';\n AbInvalidPasswordS = 'Cannot extract file - invalid password';\n AbNoInsertionMethodS = 'Cannot insert file - no insertion support provided';\n AbInvalidFactorS = 'Invalid Reduce Factor';\n AbDuplicateNameS = 'Cannot insert file - duplicates stored name';\n AbUnsupportedCompressionMethodS = 'Cannot insert file - unsupported compression method';\n AbUserAbortS = 'Process aborted by user';\n AbArchiveBusyS = 'Archive is busy - cannot process new requests';\n AbLastDiskRequestS = 'Insert the last disk in the spanned disk set';\n AbDiskRequestS = 'Insert floppy';\n AbImageRequestS = 'Image file name';\n AbBadSpanStreamS = 'Spanned archives must be opened as file streams';\n AbDiskNumRequestS = 'Insert disk number %d of the spanned disk set';\n AbImageNumRequestS = 'Insert span number %d of the spanned file set';\n AbNoOverwriteSpanStreamS = 'Cannot update an existing spanned disk set';\n AbNoSpannedSelfExtractS = 'Cannot make a self-extracting spanned disk set';\n AbBlankDiskS = 'Insert a blank floppy disk';\n AbStreamFullS = 'Stream write error';\n AbNoSuchDirectoryS = 'Directory does not exist';\n AbInflateBlockErrorS = 'Cannot inflate block';\n AbBadStreamTypeS = 'Invalid Stream';\n AbTruncateErrorS = 'Error truncating Zip File';\n AbZipBadCRCS = 'Failed CRC Check';\n AbZipBadStubS = 'Stub must be an executable';\n AbFileNotFoundS = 'File not found';\n AbInvalidLFHS = 'Invalid Local File Header entry';\n AbNoArchiveS = 'Archive does not exist - Filename is blank';\n AbReadErrorS = 'Error reading archive';\n AbInvalidIndexS = 'Invalid archive item index';\n AbInvalidThresholdS = 'Invalid archive size threshold';\n AbUnhandledFileTypeS = 'Unhandled Archive Type';\n AbSpanningNotSupportedS = 'Spanning not supported by this Archive type';\n AbLogCreateErrorS = 'Error creating Log File';\n AbMoveFileErrorS = 'Error Moving File %s to %s';\n AbFileSizeTooBigS = 'File size is too big for archive type';\n\n AbNoCabinetDllErrorS = 'Cannot load cabinet.dll';\n AbFCIFileOpenErrorS = 'FCI cannot open file';\n AbFCIFileReadErrorS = 'FCI cannot read file';\n AbFCIFileWriteErrorS = 'FCI cannot write file';\n AbFCIFileCloseErrorS = 'FCI close file error';\n AbFCIFileSeekErrorS = 'FCI file seek error';\n AbFCIFileDeleteErrorS = 'FCI file delete error';\n AbFCIAddFileErrorS = 'FCI cannot add file';\n AbFCICreateErrorS = 'FCI cannot create context';\n AbFCIFlushCabinetErrorS = 'FCI cannot flush cabinet';\n AbFCIFlushFolderErrorS = 'FCI cannot flush folder';\n AbFDICopyErrorS = 'FDI cannot enumerate files';\n AbFDICreateErrorS = 'FDI cannot create context';\n AbInvalidCabTemplateS = 'Invalid cab file template';\n AbInvalidCabFileS = 'Invalid file - not a cabinet file';\n\n AbZipStored = 'Stored';\n AbZipShrunk = 'Shrunk';\n AbZipReduced = 'Reduced';\n AbZipImploded = 'Imploded';\n AbZipTokenized = 'Tokenized';\n AbZipDeflated = 'Deflated';\n AbZipDeflate64 = 'Enhanced Deflation';\n AbZipDCLImploded = 'DCL Imploded';\n AbZipBzip2 = 'Bzip2';\n AbZipLZMA = 'LZMA';\n AbZipIBMTerse = 'IBM Terse';\n AbZipLZ77 = 'IBM LZ77';\n AbZipJPEG = 'JPEG';\n AbZipWavPack = 'WavPack';\n AbZipPPMd = 'PPMd';\n AbZipUnknown = 'Unknown (%d)';\n AbZipBestMethod = 'Best Method';\n\n AbVersionFormatS = 'Version %s';\n AbCompressedSizeFormatS = 'Compressed Size: %d';\n AbUncompressedSizeFormatS = 'Uncompressed Size: %d';\n AbCompressionMethodFormatS = 'Compression Method: %s';\n AbCompressionRatioFormatS = 'Compression Ratio: %2.0f%%';\n AbCRCFormatS = 'CRC: %x';\n AbReadOnlyS = 'r';\n AbHiddenS = 'h';\n AbSystemS = 's';\n AbArchivedS = 'a';\n AbEFAFormatS = 'External File Attributes: %s';\n AbIFAFormatS = 'File Type: %s';\n AbTextS = 'Text';\n AbBinaryS = 'Binary';\n AbEncryptionFormatS = 'Encryption: %s';\n AbEncryptedS = 'Encrypted';\n AbNotEncryptedS = 'Not Encrypted';\n AbUnknownS = 'Unknown';\n AbTimeStampFormatS = 'Time Stamp: %s';\n AbMadeByFormatS = 'Made by Version: %f';\n AbNeededFormatS = 'Version Needed to Extract: %f';\n AbCommentFormatS = 'Comment: %s';\n AbDefaultExtS = '*.zip';\n AbFilterS = 'PKZip Archives (*.zip)|*.zip|Self Extracting Archives (*.exe)|*.exe|All Files (*.*)|*.*';\n AbFileNameTitleS = 'Select File Name';\n\n AbOKS = 'OK';\n AbCancelS = 'Cancel';\n AbSelectDirectoryS = 'Select Directory';\n\n AbEnterPasswordS = 'Enter Password';\n AbPasswordS = '&Password';\n AbVerifyS = '&Verify';\n\n AbCabExtS = '*.cab';\n AbCabFilterS = 'Cabinet Archives (*.cab)|*.CAB|All Files (*.*)|*.*';\n AbLogExtS = '*.txt';\n AbLogFilterS = 'Text Files (*.txt)|*.TXT|All Files (*.*)|*.*';\n AbExeExtS = '*.exe';\n AbExeFilterS = 'Self-Extracting Zip Files (*.exe)|*.EXE|All Files (*.*)|*.*';\n\n AbVMSReadTooManyBytesS = 'VMS: request to read too many bytes [%d]';\n AbVMSInvalidOriginS = 'VMS: invalid origin %d, should be 0, 1, 2';\n AbVMSErrorOpenSwapS = 'VMS: Cannot open swap file %s';\n AbVMSSeekFailS = 'VMS: Failed to seek in swap file %s';\n AbVMSReadFailS = 'VMS: Failed to read %d bytes from swap file %s';\n AbVMSWriteFailS = 'VMS: Failed to write %d bytes to swap file %s';\n AbVMSWriteTooManyBytesS = 'VMS: request to write too many bytes [%d]';\n\n AbBBSReadTooManyBytesS = 'BBS: request to read too many bytes [%d]';\n AbBBSSeekOutsideBufferS = 'BBS: New position is outside the buffer';\n AbBBSInvalidOriginS = 'BBS: Invalid Origin value';\n AbBBSWriteTooManyBytesS = 'BBS: request to write too many bytes [%d]';\n\n AbSWSNotEndofStreamS = 'TabSlidingWindowStream.Write: Not at end of stream';\n AbSWSSeekFailedS = 'TabSlidingWindowStream.bsWriteChunk: seek failed';\n AbSWSWriteFailedS = 'TabSlidingWindowStream.bsWriteChunk: write failed';\n AbSWSInvalidOriginS = 'TabSlidingWindowStream.Seek: invalid origin';\n AbSWSInvalidNewOriginS = 'TabSlidingWindowStream.Seek: invalid new position';\n\n AbItemNameHeadingS = 'Name';\n AbPackedHeadingS = 'Packed';\n AbMethodHeadingS = 'Method';\n AbRatioHeadingS = 'Ratio (%)';\n AbCRCHeadingS = 'CRC32';\n AbFileAttrHeadingS = 'Attributes';\n AbFileFormatHeadingS = 'Format';\n AbEncryptionHeadingS = 'Encrypted';\n AbTimeStampHeadingS = 'Time Stamp';\n AbFileSizeHeadingS = 'Size';\n AbVersionMadeHeadingS = 'Version Made';\n AbVersionNeededHeadingS = 'Version Needed';\n AbPathHeadingS = 'Path';\n AbPartialHeadingS = 'Partial';\n AbExecutableHeadingS = 'Executable';\n AbFileTypeHeadingS = 'Type';\n AbLastModifiedHeadingS = 'Modified';\n\n AbCabMethod0S = 'None';\n AbCabMethod1S = 'MSZip';\n\n AbLtAddS = ' added ';\n AbLtDeleteS = ' deleted ';\n AbLtExtractS = ' extracted ';\n AbLtFreshenS = ' freshened ';\n AbLtMoveS = ' moved ';\n AbLtReplaceS = ' replaced ';\n AbLtStartS = ' logging ';\n\n AbGzipInvalidS = 'Invalid Gzip';\n AbGzipBadCRCS = 'Bad CRC';\n AbGzipBadFileSizeS = 'Bad File Size';\n\n AbTarInvalidS = 'Invalid Tar';\n AbTarBadFileNameS = 'File name too long';\n AbTarBadLinkNameS = 'Symbolic link path too long';\n AbTarBadOpS = 'Unsupported Operation';\n\n AbUnhandledEntityS = 'Unhandled Entity';\n\n { pre-defined \"operating system\" (really more FILE system) identifiers for the\n Gzip header }\n AbGzOsFat = 'FAT File System (MS-DOS, OS/2, NT/Win32)';\n AbGzOsAmiga = 'Amiga';\n AbGzOsVMS = 'VMS (or OpenVMS)';\n AbGzOsUnix = 'Unix';\n AbGzOsVM_CMS = 'VM/CMS';\n AbGzOsAtari = 'Atari TOS';\n AbGzOsHPFS = 'HPFS File System (OS/2, NT)';\n AbGzOsMacintosh = 'Macintosh';\n AbGzOsZ_System = 'Z-System';\n AbGzOsCP_M = 'CP/M';\n AbGzOsTOPS_20 = 'TOPS-20';\n AbGzOsNTFS = 'NTFS File System (NT)';\n AbGzOsQDOS = 'QDOS';\n AbGzOsAcornRISCOS = 'Acorn RISCOS';\n AbGzOsVFAT = 'VFAT File System (Win95, NT)';\n AbGzOsMVS = 'MVS';\n AbGzOsBeOS = 'BeOS (BeBox or PowerMac)';\n AbGzOsTandem = 'Tandem/NSK';\n AbGzOsTHEOS = 'THEOS';\n AbGzOsunknown = 'unknown';\n AbGzOsUndefined = 'ID undefined by gzip';\n\n{ Compound File specific error messages }\nresourcestring\n AbCmpndIndexOutOfBounds = 'Index out of bounds';\n AbCmpndBusyUpdating = 'Compound file is busy updating';\n AbCmpndInvalidFile = 'Invalid compound file';\n AbCmpndFileNotFound = 'File/Directory not found';\n AbCmpndFolderNotEmpty = 'Folder not empty';\n AbCmpndExceedsMaxFileSize = 'File size exceeds maximum allowable';\n\n\n\nimplementation\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbSWStm.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbSWStm.pas *}\n{*********************************************************}\n{* ABBREVIA: TabSlidingWindowStream class *}\n{*********************************************************}\n\nunit AbSWStm; \n \n{$I AbDefine.inc}\n \n{Notes: The TabSlidingWindowStream class provides a simple buffered\n stream for sliding window compression/decompression routines.\n The sliding window stream is limited when compared with a true\n buffered stream:\n - it is assumed that the underlying stream is just going to\n be written to and is initially empty\n - the buffer is fixed in size to 40KB\n - write operations can only occur at the end of the stream\n - the stream can only be positioned with a certain limited\n range \n - we can only read up to 32KB\n - we can only write up to 32KB\n The stream is written as a wrapper around another stream\n (presumably a file stream) which is used for actual reads to\n the buffer and writes from the buffer.\n The stream buffer is organized as five 8KB chunks in an\n array. The last chunk is the only one used for writing, the\n other four are a 32KB buffer for reading. As the final chunk\n gets filled, the class will drop off the first chunk (writing\n it to the underlying stream, and shift the other chunks in the\n array.} \n \n \n{Define this if you wish to see a trace of the stream usage in a file\n called C:\\SlideWin.LOG}\n{.$DEFINE DebugTrace}\n \ninterface \n \nuses \n SysUtils, \n Classes; \n \nconst \n abSWChunkCount = 5;\n \ntype \n TabSlidingWindowStream = class(TStream)\n protected {private}\n bsChunks : array [0..pred(abSWChunkCount)] of PByteArray;\n bsBufferStart : longint;\n bsLastPos : integer;\n bsCurChunk : integer;\n bsPosInChunk : integer;\n bsPosInBuffer : longint;\n bsSize : Longint; {count of bytes in stream}\n bsDirty : boolean; {whether the buffer is dirty or not}\n bsStream : TStream; {actual stream containing data}\n {$IFDEF DebugTrace}\n bsF : System.Text;\n {$ENDIF} \n protected \n procedure bsWriteChunk(aIndex : integer);\n procedure bsSlide;\n \n public \n constructor Create(aStream : TStream);\n {-create the buffered stream}\n destructor Destroy; override;\n {-destroy the buffered stream}\n \n procedure Flush;\n {-ensures that all dirty buffered data is flushed}\n function Read(var Buffer; Count : Longint) : Longint; override;\n {-read from the stream into a buffer}\n function Seek(Offset : Longint; Origin : Word) : Longint; override;\n {-seek to a particular point in the stream}\n function Write(const Buffer; Count : Longint) : Longint; override;\n {-write to the stream from a buffer}\n end; \n \nimplementation \n \nconst\n ChunkSize = 8192; {cannot be greater than MaxInt}\n\n\n{===Helper routines==================================================}\nprocedure RaiseException(const S : string);\nbegin \n raise Exception.Create(S);\nend; \n{====================================================================}\n \n \n{===TabSlidingWindowStream===========================================}\nconstructor TabSlidingWindowStream.Create(aStream : TStream);\nvar \n i : integer; \nbegin \n inherited Create;\n {save the actual stream}\n bsStream := aStream;\n {allocate the chunks-they must be set to binary zeros}\n for i := 0 to pred(abSWChunkCount) do\n bsChunks[i] := AllocMem(ChunkSize);\n {set the page/buffer variables to the start of the stream; remember\n we only write to the last chunk--the previous chunks are set to\n binary zeros} \n aStream.Position := 0;\n bsSize := 0; \n bsBufferStart := -ChunkSize * pred(abSWChunkCount);\n bsPosInBuffer := ChunkSize * pred(abSWChunkCount);\n bsCurChunk := pred(abSWChunkCount);\n bsPosInChunk := 0;\n bsDirty := false;\n {$IFDEF DebugTrace}\n System.Assign(bsF, 'c:\\SlideWin.LOG');\n if FileExists('c:\\SlideWin.LOG') then\n System.Append(bsF)\n else \n System.Rewrite(bsF);\n writeln(bsF, '---NEW LOG---');\n {$ENDIF} \nend; \n{--------} \ndestructor TabSlidingWindowStream.Destroy;\nvar \n i : integer; \nbegin \n {destroy the buffer, after writing it to the actual stream}\n if bsDirty then\n Flush; \n for i := 0 to pred(abSWChunkCount) do\n if (bsChunks[i] <> nil) then\n FreeMem(bsChunks[i], ChunkSize);\n {$IFDEF DebugTrace}\n System.Close(bsF);\n {$ENDIF} \n {let our ancestor clean up}\n inherited Destroy;\nend; \n{--------} \nprocedure TabSlidingWindowStream.bsSlide;\nvar \n SavePtr : PByteArray;\n i : integer;\nbegin \n {write out the first chunk}\n bsWriteChunk(0);\n {slide the chunks around}\n SavePtr := bsChunks[0];\n for i := 0 to abSWChunkCount-2 do\n bsChunks[i] := bsChunks[i+1];\n bsChunks[pred(abSWChunkCount)] := SavePtr;\n {advance the buffer start position}\n inc(bsBufferStart, ChunkSize);\n {reset the write position}\n bsPosInChunk := 0;\n bsPosInBuffer := ChunkSize * pred(abSWChunkCount);\n bsLastPos := 0;\nend; \n{--------} \nprocedure TabSlidingWindowStream.bsWriteChunk(aIndex : integer);\nvar \n SeekResult : longint;\n BytesWrit : longint;\n Offset : longint;\n BytesToWrite : integer;\nbegin \n Offset := bsBufferStart + (longint(aIndex) * ChunkSize);\n if (Offset >= 0) then begin\n SeekResult := bsStream.Seek(Offset, 0);\n if (SeekResult = -1) then\n RaiseException('TabSlidingWindowStream.bsWriteChunk: seek failed');\n if (aIndex <> pred(abSWChunkCount)) then\n BytesToWrite := ChunkSize\n else \n BytesToWrite := bsLastPos;\n BytesWrit := bsStream.Write(bsChunks[aIndex]^, BytesToWrite);\n if (BytesWrit <> BytesToWrite) then\n RaiseException('TabSlidingWindowStream.bsWriteChunk: write failed');\n end; \nend; \n{--------} \nprocedure TabSlidingWindowStream.Flush;\nvar \n i : integer; \nbegin \n if bsDirty then begin\n for i := 0 to pred(abSWChunkCount) do\n bsWriteChunk(i);\n bsDirty := false;\n end; \nend; \n{--------} \nfunction TabSlidingWindowStream.Read(var Buffer; Count : Longint) : Longint;\nvar \n BufPtr : PByte;\n BytesToGo : Longint;\n BytesToRead : integer;\nbegin\n BufPtr := @Buffer;\n\n {$IFDEF DebugTrace}\n System.Writeln(bsF, 'Read: ', Count, ' bytes');\n {$ENDIF} \n {we do not support reads greater than 32KB bytes}\n if (Count > 32*1024) then\n Count := 32*1024;\n \n {reading is complicated by the fact we can only read in chunks of\n ChunkSize: we need to partition out the overall read into a\n read from part of the chunk, zero or more reads from complete\n chunks and then a possible read from part of a chunk}\n \n {calculate the actual number of bytes we can read - this depends on\n the current position and size of the stream as well as the number\n of bytes requested}\n BytesToGo := Count;\n if (bsSize < (bsBufferStart + bsPosInBuffer + Count)) then\n BytesToGo := bsSize - (bsBufferStart + bsPosInBuffer);\n if (BytesToGo <= 0) then begin\n Result := 0; \n Exit; \n end; \n {remember to return the result of our calculation}\n Result := BytesToGo;\n \n {calculate the number of bytes we can read prior to the loop}\n BytesToRead := ChunkSize - bsPosInChunk;\n if (BytesToRead > BytesToGo) then\n BytesToRead := BytesToGo;\n {copy from the stream buffer to the caller's buffer}\n if (BytesToRead = 1) then\n BufPtr^ := bsChunks[bsCurChunk]^[bsPosInChunk]\n else \n Move(bsChunks[bsCurChunk]^[bsPosInChunk], BufPtr^, BytesToRead);\n {calculate the number of bytes still to read}\n dec(BytesToGo, BytesToRead);\n \n {while we have bytes to read, read them}\n while (BytesToGo > 0) do begin\n {advance the pointer for the caller's buffer}\n inc(BufPtr, BytesToRead);\n {as we've exhausted this chunk, advance to the next}\n inc(bsCurChunk);\n bsPosInChunk := 0;\n {calculate the number of bytes we can read in this cycle}\n BytesToRead := ChunkSize;\n if (BytesToRead > BytesToGo) then\n BytesToRead := BytesToGo;\n {copy from the stream buffer to the caller's buffer}\n Move(bsChunks[bsCurChunk]^, BufPtr^, BytesToRead);\n {calculate the number of bytes still to read}\n dec(BytesToGo, BytesToRead);\n end; \n {remember our new position}\n inc(bsPosInChunk, BytesToRead);\nend; \n{--------} \nfunction TabSlidingWindowStream.Seek(Offset : Longint;\n Origin : Word) : Longint;\n{$IFDEF DebugTrace}\nconst \n OriginStr : array [0..2] of string[7] = ('start', 'current', 'end');\n{$ENDIF} \nvar \n NewPos : Longint;\nbegin \n {$IFDEF DebugTrace}\n System.Writeln(bsF, 'Seek: ', Offset, ' bytes from ', OriginStr[Origin]);\n {$ENDIF} \n {calculate the new position}\n case Origin of \n soFromBeginning : NewPos := Offset;\n soFromCurrent : NewPos := bsBufferStart + bsPosInBuffer + Offset;\n soFromEnd : NewPos := bsSize + Offset;\n else \n NewPos := 0; \n RaiseException('TabSlidingWindowStream.Seek: invalid origin');\n end; \n {if the new position is invalid, say so}\n if (NewPos < bsBufferStart) or (NewPos > bsSize) then\n RaiseException('TabSlidingWindowStream.Seek: invalid new position');\n {calculate the chunk number and the position in buffer & chunk}\n bsPosInBuffer := NewPos - bsBufferStart;\n bsCurChunk := bsPosInBuffer div ChunkSize;\n bsPosInChunk := bsPosInBuffer mod ChunkSize;\n {return the new position}\n Result := NewPos;\nend; \n{--------} \nfunction TabSlidingWindowStream.Write(const Buffer; Count : Longint) : Longint;\nvar \n BufPtr : PByte;\n BytesToGo : Longint;\n BytesToWrite: integer;\nbegin\n BufPtr := @Buffer;\n\n {$IFDEF DebugTrace}\n System.Writeln(bsF, 'Write: ', Count, ' bytes');\n {$ENDIF} \n {we ONLY write at the end of the stream}\n if ((bsBufferStart + bsPosInBuffer) <> bsSize) then\n RaiseException('TabSlidingWindowStream.Write: Not at end of stream');\n \n {we do not support writes greater than 32KB bytes}\n if (Count > 32*1024) then\n Count := 32*1024;\n \n {writing is complicated by the fact we write in chunks of Chunksize\n bytes: we need to partition out the overall write into a write\n to part of the chunk, zero or more writes to complete chunks and\n then a possible write to part of a chunk; every time we fill a\n chunk we have toi slide the buffer}\n \n {when we write to this stream we always assume that we can write the\n requested number of bytes: if we can't (eg, the disk is full) we'll\n get an exception somewhere eventually}\n BytesToGo := Count;\n {remember to return the result of our calculation}\n Result := BytesToGo;\n \n {calculate the number of bytes we can write prior to the loop}\n BytesToWrite := ChunkSize - bsPosInChunk;\n if (BytesToWrite > BytesToGo) then\n BytesToWrite := BytesToGo;\n {copy from the caller's buffer to the stream buffer}\n if (BytesToWrite = 1) then\n bsChunks[pred(abSWChunkCount)]^[bsPosInChunk] := BufPtr^\n else \n Move(BufPtr^,\n bsChunks[pred(abSWChunkCount)]^[bsPosInChunk],\n BytesToWrite);\n {mark our buffer as requiring a save to the actual stream}\n bsDirty := true;\n {calculate the number of bytes still to write}\n dec(BytesToGo, BytesToWrite);\n \n {while we have bytes to write, write them}\n while (BytesToGo > 0) do begin\n {slide the buffer}\n bsSlide; \n {advance the pointer for the caller's buffer}\n inc(BufPtr, BytesToWrite);\n {calculate the number of bytes we can write in this cycle}\n BytesToWrite := ChunkSize;\n if (BytesToWrite > BytesToGo) then\n BytesToWrite := BytesToGo;\n {copy from the caller's buffer to our buffer}\n Move(BufPtr^,\n bsChunks[pred(abSWChunkCount)]^,\n BytesToWrite);\n {calculate the number of bytes still to write}\n dec(BytesToGo, BytesToWrite);\n end; \n {remember our new position}\n inc(bsPosInChunk, BytesToWrite);\n bsPosInBuffer := (longint(ChunkSize) * pred(abSWChunkCount)) + bsPosInChunk;\n bsLastPos := bsPosInChunk;\n {make sure the stream size is correct}\n inc(bsSize, Result);\n {if we're at the end of the chunk, slide the buffer ready for next\n time we write}\n if (bsPosInChunk = ChunkSize) then\n bsSlide; \nend; \n{====================================================================}\n \nend. \n"
},
{
"path": "lib/abbrevia/source/AbSelfEx.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbSelfEx.pas *}\n{*********************************************************}\n{* ABBREVIA: Component for building self-extracting zips *}\n{*********************************************************}\n\nunit AbSelfEx;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbBase;\n\ntype\n TAbGetFileEvent = procedure(Sender : TObject; var aFilename : string;\n var Abort : Boolean) of object;\n\ntype\n TAbMakeSelfExe = class(TAbBaseComponent)\n protected {private}\n FStubExe : string;\n FZipFile : string;\n FSelfExe : string;\n FStubStream : TFileStream;\n FZipStream : TFileStream;\n FSelfStream : TFileStream;\n FOnGetStubExe : TAbGetFileEvent;\n FOnGetZipFile : TAbGetFileEvent;\n\n procedure DoGetStubExe(var Abort : Boolean);\n procedure DoGetZipFile(var Abort : Boolean);\n\n public\n function Execute : Boolean;\n\n published\n property SelfExe : string\n read FSelfExe\n write FSelfExe;\n property StubExe : string\n read FStubExe\n write FStubExe;\n property ZipFile : string\n read FZipFile\n write FZipFile;\n property OnGetStubExe : TAbGetFileEvent\n read FOnGetStubExe\n write FOnGetStubExe;\n property OnGetZipFile : TAbGetFileEvent\n read FOnGetZipFile\n write FOnGetZipFile;\n property Version;\n end;\n\n\nimplementation\n\nuses\n SysUtils,\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n AbExcept, AbZipTyp;\n\n{ -------------------------------------------------------------------------- }\nfunction TAbMakeSelfExe.Execute : Boolean;\nvar\n Abort : Boolean;\nbegin\n Abort := False;\n if (FStubExe = '') then\n DoGetStubExe(Abort);\n if Abort then\n raise EAbUserAbort.Create;\n if not FileExists(FStubExe) then\n raise EAbFileNotFound.Create;\n if (FZipFile = '') then\n DoGetZipFile(Abort);\n if Abort then\n raise EAbUserAbort.Create;\n if not FileExists(FZipFile) then\n raise EAbFileNotFound.Create;\n\n FStubStream := TFileStream.Create(FStubExe, fmOpenRead or fmShareDenyWrite);\n FZipStream := TFileStream.Create(FZipFile, fmOpenRead or fmShareDenyWrite);\n if (FSelfExe = '') then\n FSelfExe := ChangeFileExt(FZipFile, '.exe');\n FSelfStream := TFileStream.Create(FSelfExe, fmCreate or fmShareExclusive);\n try\n MakeSelfExtracting(FStubStream, FZipStream, FSelfStream);\n Result := True;\n finally\n FStubStream.Free;\n FZipStream.Free;\n FSelfStream.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbMakeSelfExe.DoGetStubExe(var Abort: Boolean);\nbegin\n if Assigned(FOnGetStubExe) then\n FOnGetStubExe(Self, FStubExe, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbMakeSelfExe.DoGetZipFile(var Abort : Boolean);\nbegin\n if Assigned(FOnGetZipFile) then\n FOnGetZipFile(Self, FZipFile, Abort);\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbSpanSt.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbSpanSt.pas *}\n{*********************************************************}\n{* ABBREVIA: TAbSpan*Stream Classes *}\n{*********************************************************}\n{* Streams to handle splitting ZIP files or spanning *}\n{* them to diskettes *}\n{*********************************************************}\n\nunit AbSpanSt;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbArcTyp;\n\ntype\n{ TAbSpanBaseStream interface ============================================== }\n TAbSpanBaseStream = class(TStream)\n protected {private}\n FArchiveName: string;\n\n FOnRequestImage: TAbRequestImageEvent;\n\n protected {methods}\n function GetImageName( ImageNumber: Integer ): string;\n\n public {methods}\n constructor Create( const ArchiveName: string );\n\n public {events}\n property OnRequestImage : TAbRequestImageEvent\n read FOnRequestImage\n write FOnRequestImage;\n end;\n\n{ TAbSpanReadStream interface ============================================== }\n TAbSpanReadStream = class(TAbSpanBaseStream)\n protected {private}\n FCurrentImage: LongWord;\n FIsSplit: Boolean;\n FLastImage: LongWord;\n FStream: TStream;\n\n FOnRequestNthDisk : TAbRequestNthDiskEvent;\n\n protected {methods}\n procedure GotoImage( ImageNumber: Integer );\n procedure SetOnRequestImage(Value: TAbRequestImageEvent);\n\n public {methods}\n constructor Create( const ArchiveName: string; CurrentImage: LongWord;\n Stream: TStream );\n destructor Destroy;\n override;\n function Read(var Buffer; Count: Longint): Longint;\n override;\n function Write(const Buffer; Count: Longint): Longint;\n override;\n function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\n override;\n procedure SeekImage( Image: LongWord; const Offset: Int64);\n\n public {events}\n property OnRequestImage\n write SetOnRequestImage;\n property OnRequestNthDisk : TAbRequestNthDiskEvent\n read FOnRequestNthDisk\n write FOnRequestNthDisk;\n end;\n\n{ TAbSpanWriteStream interface ============================================= }\n TAbSpanWriteStream = class(TAbSpanBaseStream)\n protected {private}\n FCurrentImage: LongWord;\n FImageSize: Int64;\n FStream: TStream;\n FThreshold: Int64;\n\n FOnRequestBlankDisk : TAbRequestDiskEvent;\n\n protected {methods}\n procedure NewImage;\n\n public {methods}\n constructor Create( const ArchiveName: string; Stream: TStream;\n Threshold: Int64 );\n destructor Destroy;\n override;\n function Read(var Buffer; Count: Longint): Longint;\n override;\n function Write(const Buffer; Count: Longint): Longint;\n override;\n function WriteUnspanned(const Buffer; Count: Longint;\n FailOnSpan: Boolean = False): Boolean;\n function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\n override;\n function ReleaseStream: TStream;\n\n public {properties}\n property CurrentImage : LongWord\n read FCurrentImage;\n\n public {events}\n property OnRequestBlankDisk : TAbRequestDiskEvent\n read FOnRequestBlankDisk\n write FOnRequestBlankDisk;\n end;\n\nimplementation\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n Math, RTLConsts, SysUtils, AbUtils, AbExcept;\n\n\n{============================================================================}\n{ TAbSpanBaseStream implementation ========================================= }\nconstructor TAbSpanBaseStream.Create( const ArchiveName: string );\nbegin\n inherited Create;\n FArchiveName := ArchiveName;\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanBaseStream.GetImageName( ImageNumber: Integer ): string;\nvar\n Abort : Boolean;\n Ext : string;\nbegin\n {generate default name}\n Ext := ExtractFileExt(FArchiveName);\n if (Length(Ext) < 2) then\n Ext := '.' + Format('%.2d', [ImageNumber])\n else\n Ext := Ext[1] + Ext[2] + Format('%.2d', [ImageNumber]);\n Result := ChangeFileExt(FArchiveName, Ext);\n {call event}\n if Assigned(FOnRequestImage) then begin\n Abort := False;\n FOnRequestImage(Self, ImageNumber, Result, Abort);\n if Abort then\n raise EAbUserAbort.Create;\n end;\nend;\n\n{============================================================================}\n{ TAbSpanReadStream implementation ========================================= }\nconstructor TAbSpanReadStream.Create( const ArchiveName: string;\n CurrentImage: LongWord; Stream: TStream );\nbegin\n inherited Create(ArchiveName);\n FCurrentImage := CurrentImage;\n FIsSplit := FileExists(GetImageName(1)) or not AbDriveIsRemovable(ArchiveName);\n FLastImage := CurrentImage;\n FStream := Stream;\nend;\n{------------------------------------------------------------------------------}\ndestructor TAbSpanReadStream.Destroy;\nbegin\n FreeAndNil(FStream);\n inherited;\nend;\n{------------------------------------------------------------------------------}\nprocedure TAbSpanReadStream.GotoImage( ImageNumber: Integer );\nvar\n Abort: Boolean;\n ImageName: string;\nbegin\n { switch to the requested image. ImageNumber is passed in as 0-based to\n match the zip spec, but all of the callbacks receive 1-based values. }\n FreeAndNil(FStream);\n FCurrentImage := ImageNumber;\n Inc(ImageNumber);\n ImageName := FArchiveName;\n if FIsSplit then begin\n { the last image uses the original filename }\n if FCurrentImage <> FLastImage then\n ImageName := GetImageName(ImageNumber)\n end\n else if Assigned(FOnRequestNthDisk) then begin\n Abort := False;\n repeat\n FOnRequestNthDisk(Self, ImageNumber, Abort);\n if Abort then\n raise EAbUserAbort.Create;\n until AbGetDriveFreeSpace(ImageName) <> -1;\n end\n else\n raise EAbUserAbort.Create;\n FStream := TFileStream.Create(ImageName, fmOpenRead or fmShareDenyWrite);\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanReadStream.Read(var Buffer; Count: Longint): Longint;\nvar\n BytesRead, BytesLeft: LongInt;\n PBuf: PByte;\nbegin\n { read until the buffer's full, switching images if necessary }\n Result := 0;\n if FStream = nil then\n Exit;\n PBuf := @Buffer;\n BytesLeft := Count;\n while Result < Count do begin\n BytesRead := FStream.Read(PBuf^, BytesLeft);\n Inc(Result, BytesRead);\n Inc(PBuf, BytesRead);\n Dec(BytesLeft, BytesRead);\n if BytesRead < BytesLeft then begin\n if FCurrentImage <> FLastImage then\n GotoImage(FCurrentImage + 1)\n else\n Break;\n end;\n end;\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanReadStream.Write(const Buffer; Count: Longint): Longint;\nbegin\n raise EAbException.Create('TAbSpanReadStream.Write unsupported');\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanReadStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\nbegin\n if FStream = nil then\n Result := 0\n else if (Offset = 0) and (Origin = soCurrent) then\n Result := FStream.Position\n else\n raise EAbException.Create('TAbSpanReadStream.Seek unsupported');\nend;\n{------------------------------------------------------------------------------}\nprocedure TAbSpanReadStream.SeekImage( Image: LongWord; const Offset: Int64);\nbegin\n if FStream = nil then\n Exit;\n if FCurrentImage <> Image then\n GotoImage(Image);\n FStream.Position := Offset;\nend;\n{------------------------------------------------------------------------------}\nprocedure TAbSpanReadStream.SetOnRequestImage(Value: TAbRequestImageEvent);\nbegin\n FOnRequestImage := Value;\n FIsSplit := FileExists(GetImageName(1)) or not AbDriveIsRemovable(FArchiveName);\nend;\n\n{============================================================================}\n{ TAbSpanWriteStream implementation ======================================== }\nconstructor TAbSpanWriteStream.Create( const ArchiveName: string;\n Stream: TStream; Threshold: Int64 );\nbegin\n inherited Create(ArchiveName);\n FCurrentImage := 0;\n FStream := Stream;\n FThreshold := Threshold;\nend;\n{------------------------------------------------------------------------------}\ndestructor TAbSpanWriteStream.Destroy;\nbegin\n FStream.Free;\n inherited;\nend;\n{------------------------------------------------------------------------------}\nprocedure TAbSpanWriteStream.NewImage;\nvar\n Abort: Boolean;\nbegin\n { start a new span or blank disk. FCurrentImage is 0-based to match the zip\n spec, but all of the callbacks receive 1-based values. }\n FreeAndNil(FStream);\n Inc(FCurrentImage);\n if FThreshold > 0 then\n RenameFile(FArchiveName, GetImageName(FCurrentImage))\n else begin\n if Assigned(FOnRequestBlankDisk) then begin\n Abort := False;\n repeat\n FOnRequestBlankDisk(Self, Abort);\n if Abort then\n raise EAbUserAbort.Create;\n until AbGetDriveFreeSpace(FArchiveName) <> -1;\n end\n else\n raise EAbUserAbort.Create;\n AbSetSpanVolumeLabel(AbDrive(FArchiveName), FCurrentImage);\n end;\n FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite);\n FImageSize := 0;\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanWriteStream.Read(var Buffer; Count: Longint): Longint;\nbegin\n raise EAbException.Create('TAbSpanWriteStream.Read unsupported');\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanWriteStream.Write(const Buffer; Count: Longint): Longint;\nvar\n BytesWritten, BytesLeft: LongInt;\n PBuf: PByte;\nbegin\n { write until the buffer is done, starting new spans if necessary }\n Result := 0;\n if FStream = nil then\n Exit;\n PBuf := @Buffer;\n BytesLeft := Count;\n while Result < Count do begin\n if FThreshold > 0 then\n BytesWritten := FStream.Write(PBuf^, Min(BytesLeft, FThreshold - FImageSize))\n else\n BytesWritten := FStream.Write(PBuf^, BytesLeft);\n Inc(FImageSize, BytesWritten);\n Inc(Result, BytesWritten);\n Inc(PBuf, BytesWritten);\n Dec(BytesLeft, BytesWritten);\n if BytesWritten < BytesLeft then\n NewImage;\n end;\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanWriteStream.WriteUnspanned(const Buffer; Count: Longint;\n FailOnSpan: Boolean = False): Boolean;\nvar\n BytesWritten: LongInt;\nbegin\n { write as a contiguous block, starting a new span if there isn't room.\n FailOnSpan (and result = false) can be used to update data before it's\n written again }\n if FStream = nil then\n raise EWriteError.Create(SWriteError);\n if (FThreshold > 0) and (FThreshold - FImageSize < Count) then\n BytesWritten := 0\n else\n BytesWritten := FStream.Write(Buffer, Count);\n if BytesWritten < Count then begin\n if BytesWritten > 0 then\n FStream.Size := FStream.Size - BytesWritten;\n NewImage;\n if FailOnSpan then\n BytesWritten := 0\n else begin\n BytesWritten := Count;\n FStream.WriteBuffer(Buffer, Count);\n end;\n end;\n Inc(FImageSize, BytesWritten);\n Result := (BytesWritten = Count);\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanWriteStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\nbegin\n if FStream = nil then\n Result := 0\n else if (Offset = 0) and (Origin = soCurrent) then\n Result := FStream.Position\n else\n raise EAbException.Create('TAbSpanWriteStream.Seek unsupported');\nend;\n{------------------------------------------------------------------------------}\nfunction TAbSpanWriteStream.ReleaseStream: TStream;\nbegin\n Result := FStream;\n FStream := nil;\nend;\n{------------------------------------------------------------------------------}\nend.\n"
},
{
"path": "lib/abbrevia/source/AbTarTyp.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Joel Haynie\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbTarTyp.pas *}\n{*********************************************************}\n{* ABBREVIA: TAbTarArchive, TAbTarItem classes *}\n{*********************************************************}\n{* Misc. constants, types, and routines for working *}\n{* with Tar files *}\n{*********************************************************}\n\nunit AbTarTyp;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbUtils, AbArcTyp;\n\nconst\n AB_TAR_RECORDSIZE = 512; {Note: SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE}\n AB_TAR_NAMESIZE = 100;\n AB_TAR_V7_EMPTY_SIZE = 167;\n AB_TAR_USTAR_PREFIX_SIZE = 155;\n AB_TAR_STAR_PREFIX_SIZE = 131;\n AB_TAR_OLD_GNU_EMPTY1_SIZE = 5;\n AB_TAR_OLD_GNU_SPARSE_SIZE = 96;\n AB_TAR_OLD_GNU_EMPTY2_SIZE = 17;\n AB_TAR_SIZE_AFTER_STDHDR = 167;\n AB_TAR_TUSRNAMELEN = 32;\n AB_TAR_TGRPNAMELEN = 32;\n\n\n{ The checksum field is filled with this while the checksum is computed. }\n AB_TAR_CHKBLANKS = ' '; { 8 blank spaces(#20), no null }\n AB_TAR_L_HDR_NAME = '././@LongLink'; { As seen in the GNU File Examples}\n AB_TAR_L_HDR_USR_NAME='root'; { On Cygwin this is #0, Redhat it is 'root' }\n AB_TAR_L_HDR_GRP_NAME='root'; { Same on all OS's }\n AB_TAR_L_HDR_ARR8_0 ='0000000'#0; { 7 zeros and one null }\n AB_TAR_L_HDR_ARR12_0 ='00000000000'#0;{ 11 zeros and one null }\n AB_TAR_MAGIC_VAL = 'ustar'#0; { 5 chars & a nul }\n AB_TAR_MAGIC_VER = '00'; { 2 chars }\n AB_TAR_MAGIC_GNUOLD = 'ustar '#0; { 7 chars & a null }\n AB_TAR_MAGIC_V7_NONE = #0#0#0#0#0#0#0#0;{ 8, #0 }\n\n{ The linkflag defines the type of file(FH), and Meta Data about File(MDH) }\n AB_TAR_LF_OLDNORMAL = #0; { FH, Normal disk file, Unix compatible } { Historically used for V7 }\n AB_TAR_LF_NORMAL = '0'; { FH, Normal disk file }\n AB_TAR_LF_LINK = '1'; { FH, Link to previously archived file }\n AB_TAR_LF_SYMLINK = '2'; { FH, Symbolic(soft) link }\n AB_TAR_LF_CHR = '3'; { FH, Character special file }{ Used for device nodes, Conditionally compiled into GNUTAR }\n AB_TAR_LF_BLK = '4'; { FH, Block special file }{ Used for device nodes, Conditionally compiled into GNUTAR }\n AB_TAR_LF_DIR = '5'; { FH, Directory, Zero size File }\n AB_TAR_LF_FIFO = '6'; { FH, FIFO special file }{ Used for fifo files(pipe like), Conditionally complied into GNUTAR }\n AB_TAR_LF_CONTIG = '7'; { FH, Contiguous file } { Normal File, but All blocks should be contiguos on the disk }\n AB_TAR_LF_XHDR = 'x'; { MDH, POSIX, Next File has Extended Header }\n AB_TAR_LF_XGL = 'g'; { MDH, POSIX, Global Extended Header }\n AB_TAR_LF_DUMPDIR = 'D'; { FH, Extra GNU, Dump Directory} { Generated Dump of Files in a directory, has a size }\n AB_TAR_LF_LONGLINK = 'K'; { MDH, Extra GNU, Next File has Long LinkName}\n AB_TAR_LF_LONGNAME = 'L'; { MDH, Extra GNU, Next File has Long Name}\n AB_TAR_LF_MULTIVOL = 'M'; { FH, Extra GNU, MultiVolume File Cont.}{ End of a file that spans multiple TARs }\n AB_TAR_LF_SPARSE = 'S'; { FH, Extra GNU, Sparse File Cont.}\n AB_TAR_LF_VOLHDR = 'V'; { FH, Extra GNU, File is Volume Header }\n AB_TAR_LF_EXHDR = 'X'; { MDH, Extra GNU, Solaris Extended Header }\n { The only questionable MetaData type is 'V', file or meta-data? will treat as file header }\n AB_SUPPORTED_F_HEADERS = [AB_TAR_LF_OLDNORMAL, AB_TAR_LF_NORMAL, AB_TAR_LF_LINK,\n AB_TAR_LF_SYMLINK, AB_TAR_LF_DIR];\n AB_UNSUPPORTED_F_HEADERS = [AB_TAR_LF_CHR, AB_TAR_LF_BLK, AB_TAR_LF_FIFO,\n AB_TAR_LF_CONTIG, AB_TAR_LF_DUMPDIR, AB_TAR_LF_MULTIVOL,\n AB_TAR_LF_SPARSE, AB_TAR_LF_VOLHDR];\n AB_SUPPORTED_MD_HEADERS = [AB_TAR_LF_LONGNAME, AB_TAR_LF_LONGLINK];\n AB_UNSUPPORTED_MD_HEADERS= [AB_TAR_LF_XHDR, AB_TAR_LF_XGL, AB_TAR_LF_EXHDR];\n AB_GNU_MD_HEADERS = [AB_TAR_LF_LONGLINK, AB_TAR_LF_LONGNAME]; { If present then OLD_/GNU_FORMAT }\n AB_PAX_MD_HEADERS = [AB_TAR_LF_XHDR, AB_TAR_LF_XGL]; { If present then POSIX_FORMAT }\n AB_IGNORE_SIZE_HEADERS = [AB_TAR_LF_LINK, AB_TAR_LF_SYMLINK, AB_TAR_LF_CHR,\n AB_TAR_LF_BLK, AB_TAR_LF_DIR, AB_TAR_LF_FIFO];\n{ The rest of the Chars are unsupported and unknown types Treat those headers as File types }\n{ Further link types may be defined later. }\n\n{ Bits used in the mode field - values in octal }\n AB_TAR_TSUID = $0800; { Set UID on execution }\n AB_TAR_TSGID = $0400; { Set GID on execution }\n AB_TAR_TSVTX = $0200; { Save text (sticky bit) }\n\n\ntype\n Arr8 = array [0..7] of AnsiChar;\n Arr12 = array [0..11] of AnsiChar;\n Arr12B = array[0..11] of Byte;\n ArrName = array [0..AB_TAR_NAMESIZE-1] of AnsiChar;\n TAbTarHeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT,\n USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT);\n TAbTarItemType = (SUPPORTED_ITEM, UNSUPPORTED_ITEM, UNKNOWN_ITEM);\n TAbTarHeaderType = (FILE_HEADER, META_DATA_HEADER, MD_DATA_HEADER, UNKNOWN_HEADER);\n TAbTarMagicType = (GNU_OLD, NORMAL);\n TAbTarMagicRec = packed record\n case TAbTarMagicType of\n GNU_OLD: (gnuOld : array[0..7] of AnsiChar); { Old GNU magic: (Magic.gnuOld) }\n NORMAL : (value : array[0..5] of AnsiChar; { Magic value: (Magic.value)}\n version: array[0..1] of AnsiChar); { Version: (Magic.version) }\n end;\n\n{ Notes from GNU Tar & POSIX Spec.: }\n{All the first 345 bytes are the same. }\n{ \"USTAR_header\": Prefix(155): 345-499,\n empty(12): 500-511 }\n{ \"old_gnu_header\": atime(12): 345-356,\n ctime(12): 357-368,\n offset(12): 369-380,\n longnames(4): 381-384,\n empty(1): 385,\n sparse structs(4x(12+12)=96): 386-481,\n isextended(1): 482,\n realsize(12): 483-494,\n empty(16): 495-511 }\n{ \"star_header\": Prefix(131): 345-475,\n atime(12): 476-487,\n ctime(12): 488-499,\n empty(12): 500-511 }\n{ \"star_in_header\": prefix(1): 345,\n empty(9): 346-354,\n isextended(1): 355,\n sparse structs(4x(12+12)=96): 356-451,\n realsize(12): 452-463,\n offset(12): 464-475,\n atime(12): 476-487,\n ctime(12): 488-499,\n empty(8): 500-507,\n xmagic(4): 508-511 }\n{ \"sparse_header\": These two structs are the same, and they are Meta data about file. }\n{\"star_ext_header\": sparse structs(21x(12+12)=504): 0-503,\n isextended(1): 504 }\n{POSIX(PAX) extended header: is a buffer packed with content of this form:\n This if from the POSIX spec. References the C printf command string.\n \"%d %s=%s\\n\". Then they are simply concatenated. }\n { PAX Extended Header Keywords: }\n { 'atime', 'charset', 'comment', 'ctime', 'gid', 'gname', 'linkpath', 'mtime', 'path',\n 'realtime.', 'security.', 'size', 'uid', 'uname' }\n { GNU Added PAX Extended Header Keywords: }\n { 'GNU.sparse.name', 'GNU.sparse.major', 'GNU.sparse.minor',\n 'GNU.sparse.realsize', 'GNU.sparse.numblocks', 'GNU.sparse.size',\n 'GNU.sparse.offset', 'GNU.sparse.numbytes', 'GNU.sparse.map', 'GNU.dumpdir',\n 'GNU.volume.label', 'GNU.volume.filename', 'GNU.volume.size',\n 'GNU.volume.offset' }\n\n { V7 uses AB_TAR_LF_OLDNORMAL linkflag, has no magic field & no Usr/Grp Names }\n { V7 Format ends Empty(padded with zeros), as does the POSIX record. }\n TAbTarEnd_Empty_Rec = packed record\n Empty: array[0..AB_TAR_V7_EMPTY_SIZE-1] of Byte; { 345-511, $159-1FF, Empty Space }\n end;\n { UStar End Format }\n TAbTarEnd_UStar_Rec = packed record\n Prefix: array[0..AB_TAR_USTAR_PREFIX_SIZE-1] of AnsiChar;\n { 345-499, $159-1F3, Prefix of file & path name, null terminated ASCII string }\n Empty : Arr12B;{ 500-512, $1F4-1FF, Empty Space }\n end;\n { Old GNU End Format }\n TAbTarEnd_GNU_old_Rec = packed record\n Atime : Arr12; { 345-356, $159-164, time of last access (UNIX Date in ASCII coded Octal)}\n Ctime : Arr12; { 357-368, $165-170, time of last status change (UNIX Date in ASCII coded Octal)}\n Offset: Arr12; { 369-380, $171-17C, Multirecord specific value }\n Empty1: array[0..AB_TAR_OLD_GNU_EMPTY1_SIZE-1] of Byte;\n { 381-385, $17D-181, Empty Space, Once contained longname ref. }\n Sparse: array[0..AB_TAR_OLD_GNU_SPARSE_SIZE-1] of Byte;\n { 386-481, $182-1E1, Sparse File specific values }\n IsExtended: byte;{ 482, $ 1E2, Flag to signify Sparse file headers follow }\n RealSize: Arr12;{ 483-494, $1E3-1EE, Real size of a Sparse File. }\n Empty2: array[0..AB_TAR_OLD_GNU_EMPTY2_SIZE-1] of Byte;\n { 495-511, $1EF-1FF, Empty Space }\n end;\n { Star End Format }\n TAbTarEnd_Star_Rec = packed record\n Prefix: array[0..AB_TAR_STAR_PREFIX_SIZE-1] of AnsiChar;\n { 345-499, $159-1F3, prefix of file & path name, null terminated ASCII string }\n Atime : Arr12; { 476-487, $1DC-1E7, time of last access (UNIX Date in ASCII coded Octal)}\n Ctime : Arr12; { 488-499, $1E8-1F3, time of last status change (UNIX Date in ASCII coded Octal)}\n Empty : Arr12B;{ 500-512, $1F4-1FF, Empty Space }\n end;\n { When support for sparse files is added, Add another record for sparse in header }\n\n\n{ Note: SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE by design }\n PAbTarHeaderRec = ^TAbTarHeaderRec; { Declare pointer type for use in the list }\n TAbTarHeaderRec = packed record\n Name : ArrName; { 0- 99, $ 0- 63, filename, null terminated ASCII string, unless length is 100 }\n Mode : Arr8; { 100-107, $ 64- 6B, file mode (UNIX style, ASCII coded Octal) }\n uid : Arr8; { 108-115, $ 6C- 73, usrid # (UNIX style, ASCII coded Octal) }\n gid : Arr8; { 116-123, $ 74- 7B, grpid # (UNIX style, ASCII coded Octal) }\n Size : Arr12; { 124-135, $ 7C- 87, size of TARred file (ASCII coded Octal) }\n ModTime : Arr12; { 136-147, $ 88- 93, time of last modification.(UNIX Date in ASCII coded Octal)\n UTC time }\n ChkSum : Arr8; { 148-155, $ 94- 9B, checksum of header (6 bytes ASCII coded Octal, #00, #20) }\n LinkFlag: AnsiChar; { 156, $ 9C, type of item, one of the Link Flag constants from above }\n LinkName: ArrName; { 157-256, $ 9D-100, name of link, null terminated ASCII string }\n Magic : TAbTarMagicRec;\n { 257-264, $101-108, identifier, usually 'ustar'#00'00' }\n UsrName : array [0..AB_TAR_TUSRNAMELEN-1] of AnsiChar;\n { 265-296, $109-128, username, null terminated ASCII string }\n GrpName : array [0..AB_TAR_TGRPNAMELEN-1] of AnsiChar;\n { 297-328, $129-148, groupname, null terminated ASCII string }\n DevMajor: Arr8; { 329-336, $149-150, major device ID (UNIX style, ASCII coded Octal) }\n DevMinor: Arr8; { 337-344, $151-158, minor device ID (UNIX style, ASCII coded Octal) }\n case TAbTarHeaderFormat of{ 345-511, $159-1FF See byte Definitions above.}\n V7_FORMAT : ( v7 : TAbTarEnd_Empty_Rec );\n OLDGNU_FORMAT: ( gnuOld: TAbTarEnd_GNU_old_Rec );\n GNU_FORMAT : ( gnu : TAbTarEnd_GNU_old_Rec );\n USTAR_FORMAT : ( ustar : TAbTarEnd_UStar_Rec );\n STAR_FORMAT : ( star : TAbTarEnd_Star_Rec );\n POSIX_FORMAT : ( pax : TAbTarEnd_Empty_Rec );\n end;{ end TAbTarHeaderRec }\n { There are three main types of headers we will see in a Tar file }\n { TAbTarHeaderType = (STANDARD_HDR, SPARSE_HDR, POSIX_EXTENDED_HDR); }\n { The 1st is defined above, The later two are simply organized data types. }\n\n TAbTarItemRec = record\n { Note: that the actual The name needs to be coherient with the name Inherited\n from parent type TAbArchiveItem }\n Name : string; { Path & File name. }\n Mode : LongWord; { File Permissions }\n uid : Integer; { User ID }\n gid : Integer; { Group ID }\n Size : Int64; { Tared File size }\n ModTime : Int64; { Last time of Modification, in UnixTime }\n ChkSumPass : Boolean; { Header Check sum found to be good }\n LinkFlag : AnsiChar; { Link Flag, Echos the actual File Type of this Item. }\n ItemType : TAbTarItemType; { Item Type Assigned from LinkFlag Header Types. }\n LinkName : string; { Link Name }\n Magic : AnsiString; { Magic value }\n Version : Integer; { Version Number }\n UsrName : string; { User Name, for User ID }\n GrpName : string; { Group Name, for Group ID }\n DevMajor : Integer; { Major Device ID }\n DevMinor : Integer; { Minor Device ID }\n { Additional Types used for holding info. }\n AccessTime : Int64; { Time of Last Access, in UnixTime }\n ChangeTime : Int64; { Time of Last Status Change, in UnixTime }\n ArchiveFormat: TAbTarHeaderFormat; { Type of Archive of this record }\n StreamPosition: Int64; { Pointer to the top of the item in the file. }\n Dirty : Boolean; { Indication if this record needs to have its headers CheckSum recalculated }\n ItemReadOnly: Boolean; { Indication if this record is READ ONLY }\n FileHeaderCount:Integer;{ Number of Headers in the Orginal TarHeaders in the File Stream }\n end;\n\ntype\n PTAbTarItem = ^TAbTarItem;\n TAbTarItem = class(TAbArchiveItem)\n private\n { The following private members are used for Stuffing FTarItem struct }\n procedure ParseTarHeaders; { Error in header if }\n procedure DetectHeaderFormat; { Helper to stuff HeaderFormat }\n procedure GetFileNameFromHeaders; { Helper to pull name from Headers }\n procedure GetLinkNameFromHeaders; { Helper to pull name from Headers }\n function TestCheckSum: Boolean; { Helper to Calculate Checksum of a header. }\n procedure DoGNUExistingLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);\n procedure DoGNUNewLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);\n protected {private}\n PTarHeader: PAbTarHeaderRec;{ Points to FTarHeaderList.Items[FTarHeaderList.Count-1] }\n FTarHeaderList: TList; { List of The Headers }\n FTarHeaderTypeList: TList; { List of the Header Types }\n FTarItem: TAbTarItemRec; { Data about current TAR Item }\n protected\n function GetDevMajor: Integer;\n function GetDevMinor: Integer;\n function GetGroupID: Integer;\n function GetGroupName: string;\n function GetLinkName: string;\n function GetUserID: Integer;\n function GetUserName: string;\n function GetModTime: Int64;\n function GetNumHeaders: Integer;\n function GetMagic: string;\n\n { All Sets shall update the headers Or add headers as needed. }\n procedure SetDevMajor(const Value: Integer);\n procedure SetDevMinor(const Value: Integer);\n procedure SetGroupID(const Value: Integer); { Extended Headers }\n procedure SetGroupName(const Value: string); { Extended Headers }\n procedure SetLinkFlag(Value: AnsiChar);\n procedure SetLinkName(const Value: string); { Extended Headers }\n procedure SetUserID(const Value: Integer); { Extended Headers }\n procedure SetUserName(const Value: string); { Extended Headers }\n procedure SetModTime(const Value: Int64);\n Procedure SetMagic(const Value: string);\n { TODO: add support for Atime and Ctime here }\n\n { Overrides for Inherited Properties from type TAbArchiveItem }\n function GetCompressedSize : Int64; override;\n function GetExternalFileAttributes : LongWord; override;\n function GetFileName : string; override;\n function GetIsDirectory: Boolean; override;\n function GetIsEncrypted : Boolean; override;\n function GetLastModFileDate : Word; override;\n function GetLastModFileTime : Word; override;\n function GetLastModTimeAsDateTime: TDateTime; override;\n function GetNativeFileAttributes : LongInt; override;\n function GetUncompressedSize : Int64; override;\n\n procedure SetCompressedSize(const Value : Int64); override; { Extended Headers }\n procedure SetExternalFileAttributes( Value : LongWord ); override;\n procedure SetFileName(const Value : string); override; { Extended Headers }\n procedure SetIsEncrypted(Value : Boolean); override;\n procedure SetLastModFileDate(const Value : Word); override; { Extended Headers }\n procedure SetLastModFileTime(const Value : Word); override; { Extended Headers }\n procedure SetLastModTimeAsDateTime(const Value: TDateTime); override;\n procedure SetUncompressedSize(const Value : Int64); override; { Extended Headers }\n\n procedure SaveTarHeaderToStream(AStream : TStream);\n procedure LoadTarHeaderFromStream(AStream : TStream);\n\n property Magic : string { Magic value }\n read GetMagic write SetMagic;\n public\n { property Name : STRING; Path & File name. Inherited from parent type TAbArchiveItem }\n { read GetFileName write SetFileName; overridden above}\n property Mode : LongWord { File Permissions }\n read GetExternalFileAttributes write SetExternalFileAttributes;\n property UserID : Integer { User ID }\n read GetUserID write SetUserID;\n property GroupID : Integer { Group ID }\n read GetGroupID write SetGroupID;\n property ModTime : Int64\n read GetModTime write SetModTime;\n { property UncompressedSize/CompressedSize(Size): Int64; File size (comp/uncomp) Inherited from parent type TAbArchiveItem }\n { read GetUncompressedSize, GetCompressedSize; overridden above }\n { write SetUncompressedSize, SetCompressedSize; overridden above }\n { property LastModFileTime/LastModFileDate(ModeTime): TDateTime; Last time of Modification Inherited from parent type TAbArchiveItem }\n { read GetLastModFileTime, GetLastModFileDate; overridden above }\n { write SetLastModFileTime, SetLastModFileDate; overridden above }\n\n property CheckSumGood: Boolean\n read FTarItem.ChkSumPass; { Header Check sum found to be good }\n property LinkFlag : AnsiChar { Link Flag of File Header }\n read FTarItem.LinkFlag write SetLinkFlag;\n property LinkName : string { Link Name }\n read GetLinkName write SetLinkName;\n property UserName : string { User Name, for User ID }\n read GetUserName write SetUserName;\n property GroupName : string { Group Name, for Group ID }\n read GetGroupName write SetGroupName;\n property DevMajor : Integer { Major Device ID }\n read GetDevMajor write SetDevMajor;\n property DevMinor : Integer { Minor Device ID }\n read GetDevMinor write SetDevMinor;\n { TODO: Add support ATime and CTime }\n {AccessTime : TDateTime;} { Time of Last Access }\n {ChangeTime : TDateTime;} { Time of Last Status Change }\n { Additional Types used for holding info. }\n property ExternalFileAttributes;\n property ArchiveFormat: TAbTarHeaderFormat\n read FTarItem.ArchiveFormat write FTarItem.ArchiveFormat;\n property ItemType: TAbTarItemType\n read FTarItem.ItemType write FTarItem.ItemType;\n property ItemReadOnly: Boolean\n read FTarItem.ItemReadOnly write FTarItem.ItemReadOnly;\n property FileHeaderCount: Integer\n read FTarItem.FileHeaderCount;\n property HeaderCount: Integer\n read GetNumHeaders;\n property StreamPosition: Int64\n read FTarItem.StreamPosition write FTarItem.StreamPosition;\n constructor Create;\n destructor Destroy; override;\n end; { end TAbArchiveItem }\n\n\n TAbTarStreamHelper = class(TAbArchiveStreamHelper)\n private\n function FindItem: Boolean; { Tool for FindFirst/NextItem functions }\n protected\n FTarHeader : TAbTarHeaderRec; { Speed-up Buffer only }\n FCurrItemSize : Int64; { Current Item size }\n FCurrItemPreHdrs: Integer; { Number of Meta-data Headers before the Item }\n public\n destructor Destroy; override;\n procedure ExtractItemData(AStream : TStream); override;\n function FindFirstItem : Boolean; override;\n function FindNextItem : Boolean; override;\n procedure ReadHeader; override;\n procedure ReadTail; override;\n function SeekItem(Index : Integer): Boolean; override;\n procedure WriteArchiveHeader; override;\n procedure WriteArchiveItem(AStream : TStream); override;\n procedure WriteArchiveItemSize(AStream : TStream; Size: Int64);\n procedure WriteArchiveTail; override;\n function GetItemCount : Integer; override;\n end;\n\n\n TAbTarArchive = class(TAbArchive)\n private\n FArchReadOnly : Boolean;\n FArchFormat: TAbTarHeaderFormat;\n protected\n function CreateItem(const FileSpec : string): TAbArchiveItem;\n override;\n procedure ExtractItemAt(Index : Integer; const UseName : string);\n override;\n procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);\n override;\n procedure LoadArchive;\n override;\n procedure SaveArchive;\n override;\n procedure TestItemAt(Index : Integer);\n override;\n function FixName(const Value: string): string;\n override;\n function GetSupportsEmptyFolders: Boolean;\n override;\n\n function GetItem(Index: Integer): TAbTarItem;\n procedure PutItem(Index: Integer; const Value: TAbTarItem);\n\n public {methods}\n constructor CreateFromStream(aStream : TStream; const aArchiveName : string);\n override;\n property UnsupportedTypesDetected : Boolean\n read FArchReadOnly;\n property Items[Index : Integer] : TAbTarItem\n read GetItem\n write PutItem; default;\n end;\n\nfunction VerifyTar(Strm : TStream) : TAbArchiveType;\n\n\nimplementation\n\nuses\n {$IFDEF MSWINDOWS}\n Windows, // Fix inline warnings\n {$ENDIF MSWINDOWS}\n Math, RTLConsts, SysUtils,\n {$IFDEF HasAnsiStrings}AnsiStrings, {$ENDIF}\n AbCharset, AbVMStrm, AbExcept;\n\n{ ****************** Helper functions Not from Classes Above ***************** }\nfunction OctalToInt(const Oct : PAnsiChar; aLen : integer): Int64;\nvar\n i : integer;\nbegin\n Result := 0;\n\n i := 0;\n while (i < aLen) and (Oct[i] = ' ') do\n inc(i);\n\n if (i = aLen) then\n Exit;\n\n while (i < aLen) and (Oct[i] in ['0'..'7']) do begin\n Result := (Result * 8) + (Ord(Oct[i]) - Ord('0'));\n inc(i);\n end;\nend;\n\nfunction IntToOctal(Value : Int64): AnsiString;\nconst\n OctDigits : array[0..7] of AnsiChar = '01234567';\nbegin\n if Value = 0 then\n Result := '0'\n else begin\n Result := '';\n while Value > 0 do begin\n Result := OctDigits[Value and 7] + Result;\n Value := Value shr 3;\n end;\n end;\nend;\n\n\nfunction CalcTarHeaderChkSum(const TarH : TAbTarHeaderRec): LongInt;\nvar\n HdrBuffer : PAnsiChar;\n HdrChkSum : LongInt;\n j : Integer;\nbegin\n { prepare for the checksum calculation }\n HdrBuffer := PAnsiChar(@TarH);\n HdrChkSum := 0;\n\n {calculate the checksum, a simple sum of the bytes in the header}\n for j := 0 to Pred(SizeOf(TAbTarHeaderRec)) do\n HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]);\n\n Result := HdrChkSum;\nend;\n\nfunction VerifyTar(Strm : TStream) : TAbArchiveType;\n{ assumes Tar positioned correctly for test of item }\nvar\n TarItem : TAbTarItem;\n StartPos : Int64;\nbegin\n StartPos := Strm.Position;\n try\n { Verifies that the header checksum is valid, and Item type is understood.\n This does not mean that extraction is supported. }\n TarItem := TAbTarItem.Create;\n try\n { get current Tar Header }\n TarItem.LoadTarHeaderFromStream(Strm);\n if TarItem.CheckSumGood then\n Result := atTar\n else\n Result := atUnknown;\n finally\n TarItem.Free;\n end;\n except\n on EReadError do\n Result := atUnknown;\n end;\n Strm.Position := StartPos;\nend;\n\nfunction PadString(const S : AnsiString; Places : Integer) : AnsiString;\n{\nPads a string (S) with one right space and as many left spaces as\nneeded to fill Places\n\nIf length S greater than Places, just returns S\n\nSome TAR utilities evidently expect Octal numeric fields to be in\nthis format\n}\nbegin\n if Length(S) >= LongInt(Places) then\n Result := S\n else begin\n Result := S + ' ';\n Result := StringOfChar(AnsiChar(' '), Places - Length(Result)) + Result;\n end;\nend;\n\n{ Round UP to the nearest Tar Block Boundary. }\nfunction RoundToTarBlock(Size: Int64) : Int64;\nbegin\n Result := (Size + (AB_TAR_RECORDSIZE - 1)) and\n not (AB_TAR_RECORDSIZE - 1);\nend;\n\n\n{ ****************************** TAbTarItem ********************************** }\nconstructor TAbTarItem.Create;\nbegin\n inherited Create;\n FTarHeaderList := TList.Create;\n FTarHeaderTypeList := TList.Create;\n GetMem(PTarHeader, AB_TAR_RECORDSIZE); { PTarHeader is our new Header }\n FillChar(PTarHeader^, AB_TAR_RECORDSIZE, #0);\n FTarHeaderList.Add(PTarHeader);\n FTarHeaderTypeList.Add(Pointer(FILE_HEADER));\n FTarItem.FileHeaderCount := 1;\n { set defaults }\n FTarItem.ArchiveFormat := UNKNOWN_FORMAT;\n\n FileName := '';\n Mode := AB_FPERMISSION_GENERIC;\n UserID := 0;\n GroupID := 0;\n UncompressedSize := 0;\n { ModTime }\n LinkFlag := AB_TAR_LF_OLDNORMAL;\n { Link Name }\n PTarHeader.Magic.gnuOld := AB_TAR_MAGIC_V7_NONE; { Default to GNU type }\n UserName := '';\n GroupName := '';\n DevMajor := 0;\n DevMinor := 0;\n { TODO: atime, ctime }\n FTarItem.ItemType := SUPPORTED_ITEM;\n FTarItem.Dirty := True; { Checksum needs to be generated }\n FTarItem.ItemReadOnly := False;\nend;\n\ndestructor TAbTarItem.Destroy;\nvar\n i : Integer;\nbegin\n if Assigned(FTarHeaderList) then\n begin\n for i := 0 to FTarHeaderList.Count - 1 do\n FreeMem(FTarHeaderList.Items[i]); { This list holds PAbTarHeaderRec's }\n FTarHeaderList.Free;\n end;\n FTarHeaderTypeList.Free;\n inherited Destroy;\nend;\n\nfunction TAbTarItem.GetCompressedSize: Int64;\n{ TAR includes no internal compression, returns same value as GetUncompressedSize }\nbegin\n Result := FTarItem.Size;\nend;\n\nfunction TAbTarItem.GetDevMajor: Integer;\nbegin\n Result := FTarItem.DevMajor;\nend;\n\nfunction TAbTarItem.GetDevMinor: Integer;\nbegin\n Result := FTarItem.DevMinor;\nend;\n\nfunction TAbTarItem.GetExternalFileAttributes: LongWord;\nbegin\n Result := FTarItem.Mode;\nend;\n\nfunction TAbTarItem.GetFileName: string;\nbegin\n Result := FTarItem.Name; { Inherited String from Parent Class }\nend;\n\nfunction TAbTarItem.GetGroupID: Integer;\nbegin\n Result := FTarItem.gid;\nend;\n\nfunction TAbTarItem.GetGroupName: string;\nbegin\n Result := FTarItem.GrpName;\nend;\n\nfunction TAbTarItem.GetIsDirectory: Boolean;\nbegin\n Result := (LinkFlag = AB_TAR_LF_DIR);\nend;\n\nfunction TAbTarItem.GetIsEncrypted: Boolean;\nbegin\n { TAR has no native encryption }\n Result := False;\nend;\n\nfunction TAbTarItem.GetLastModFileDate: Word;\nbegin\n { convert to local DOS file Date }\n Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Hi;\nend;\n\nfunction TAbTarItem.GetLastModFileTime: Word;\nbegin\n { convert to local DOS file Time }\n Result := LongRec(AbDateTimeToDosFileDate(LastModTimeAsDateTime)).Lo;\nend;\n\nfunction TAbTarItem.GetLastModTimeAsDateTime: TDateTime;\nbegin\n Result := AbUnixTimeToLocalDateTime(FTarItem.ModTime);\nend;\n\nfunction TAbTarItem.GetLinkName: string;\nbegin\n Result := FTarItem.LinkName;\nend;\n\nfunction TAbTarItem.GetMagic: string;\nbegin\n Result := string(FTarItem.Magic);\nend;\n\nfunction TAbTarItem.GetNativeFileAttributes : LongInt;\nbegin\n Result := GetExternalFileAttributes;\n{$IFDEF MSWINDOWS}\n Result := AbUnix2DosFileAttributes(Result);\n{$ENDIF}\nend;\n\nfunction TAbTarItem.GetUncompressedSize: Int64;\n{ TAR includes no internal compression, returns same value as GetCompressedSize }\nbegin\n Result := FTarItem.Size;\nend;\n\nfunction TAbTarItem.GetUserID: Integer;\nbegin\n Result := FTarItem.uid;\nend;\n\nfunction TAbTarItem.GetUserName: string;\nbegin\n Result := FTarItem.UsrName;\nend;\n\nfunction TAbTarItem.GetModTime: Int64;\nbegin\n Result := FTarItem.ModTime;\nend;\n\n{ Get Number of tar headers currently for this item }\nfunction TAbTarItem.GetNumHeaders: Integer;\nbegin\n Result := FTarHeaderList.Count;\nend;\n\n{ Takes data from Supported Header types stored in TAbTarItem.FTarHeaderList }\n{ and updates values in the TAbTarItem.FTarItem.X }\n\nprocedure TAbTarItem.DetectHeaderFormat;\nbegin\n if FTarItem.ArchiveFormat <> UNKNOWN_FORMAT then\n Exit;{ We have already set the format. }\n { In the previous header parsing if pax headers are detected the format is changed }\n { GNU_FORMAT is detected by the presence of GNU extended headers. }\n\n { These detections are similar to GNU tar's. }\n if (PTarHeader.Magic.value = AB_TAR_MAGIC_VAL) then\n begin { We have one of three types, STAR_FORMAT, USTAR_FORMAT, POSIX_FORMAT }\n { Detect STAR format. Leave disabled until explicit STAR support is added. }\n {if (PTarHeader.star.Prefix[130] = #00) and\n (PTarHeader.star.Atime[0] in ['0'..'7']) and\n (PTarHeader.star.Atime[11] = #20) and\n (PTarHeader.star.Ctime[0]in ['0'..'7']) and\n (PTarHeader.star.Ctime[11] = #20) then\n begin\n FTarItme.ArchiveType := STAR_FORMAT;\n end }\n { else if } { POSIX uses the existance of x headers }\n\n { This can define false positives, Pax headers/ STAR format could be detected as this }\n FTarItem.ArchiveFormat := USTAR_FORMAT;\n end\n else if (PTarHeader.Magic.gnuOld = AB_TAR_MAGIC_GNUOLD) then\n begin\n FTarItem.ArchiveFormat := OLDGNU_FORMAT;\n end\n else { V7 uses AB_TAR_LF_OLDNORMAL linkflag, has no magic field & no Usr/Grp Names }\n begin\n FTarItem.ArchiveFormat := V7_FORMAT; { Lowest Common Denominator }\n end;\nend;\n\n{ Extract the file name from the headers }\nprocedure TAbTarItem.GetFileNameFromHeaders;\nvar\n I, J : Integer;\n PHeader: PAbTarHeaderRec;\n FoundName: Boolean;\n NameLength : Int64;\n NumMHeaders: integer;\n ExtraName: integer;\n RawFileName, TempStr: AnsiString;\nbegin\n { UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT }\n FoundName := False;\n I := 0;\n while (not FoundName) and (I <= (FTarHeaderList.Count - 1)) do\n begin\n PHeader := FTarHeaderList.Items[I];\n if PHeader.LinkFlag = AB_TAR_LF_LONGNAME then\n begin\n FoundName := True;\n RawFileName := '';\n NameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));\n NumMHeaders := NameLength div AB_TAR_RECORDSIZE;\n ExtraName := NameLength mod AB_TAR_RECORDSIZE; { Chars in the last Header }\n { NumMHeaders should never be zero }\n { It appears that it is not null terminated in the blocks }\n for J := 1 to NumMHeaders do\n begin\n { Copy entire content of Header to String }\n PHeader := FTarHeaderList.Items[I+J];\n SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE);\n RawFileName := RawFileName + TempStr;\n end;\n if ExtraName <> 0 then\n begin\n PHeader := FTarHeaderList.Items[I+NumMHeaders+1];\n SetString(TempStr, PAnsiChar(PHeader), ExtraName-1);\n RawFileName := RawFileName + TempStr;\n end\n else { We already copied the entire name, but the string is still null terminated. }\n begin\n { Removed the last zero }\n SetLength(RawFileName, (Length(RawFileName)-1));\n end;\n end { end long filename link flag }\n else\n I := I + 1;\n end; { End While }\n\n if not FoundName then\n begin\n if (FTarItem.ArchiveFormat = USTAR_FORMAT) and\n (PTarHeader.ustar.Prefix[0] <> #0) then\n RawFileName := PTarHeader.ustar.Prefix+'/'+PTarHeader.Name\n else\n { V7_FORMAT, OLDGNU_FORMAT }\n RawFileName := PTarHeader.Name;\n end; { End not FoundName }\n\n FTarItem.Name := AbRawBytesToString(RawFileName);\nend;\n\n{ Extract the file name from the headers }\nprocedure TAbTarItem.GetLinkNameFromHeaders;\nvar\n I, J : Integer;\n PHeader: PAbTarHeaderRec;\n FoundName: Boolean;\n NameLength : Int64;\n NumMHeaders: integer;\n ExtraName: integer;\n RawLinkName, TempStr: AnsiString;\nbegin\n { UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT }\n PHeader := nil;\n FoundName := False;\n I := 0;\n { Note that: FTarHeaderList.Count <= 1, always }\n while (not FoundName) and (I <= (FTarHeaderList.Count - 1)) do\n begin\n PHeader := FTarHeaderList.Items[I];\n if PHeader.LinkFlag = AB_TAR_LF_LONGLINK then\n begin\n FoundName := True;\n RawLinkName := '';\n NameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));\n NumMHeaders := NameLength div AB_TAR_RECORDSIZE;\n ExtraName := NameLength mod AB_TAR_RECORDSIZE; { Chars in the last Header }\n { NumMHeaders should never be zero }\n { It appears that it is not null terminated in the blocks }\n for J := 1 to NumMHeaders do\n begin\n { Copy entire content of Header to String }\n PHeader := FTarHeaderList.Items[I+J];\n SetString(TempStr, PAnsiChar(PHeader), AB_TAR_RECORDSIZE);\n RawLinkName := RawLinkName + TempStr;\n end;\n if ExtraName <> 0 then\n begin\n PHeader := FTarHeaderList.Items[I+NumMHeaders+1];\n SetString(TempStr, PAnsiChar(PHeader), ExtraName-1);\n RawLinkName := RawLinkName + TempStr;\n end\n else { We already copied the entire name, but the string is still null terminated. }\n begin\n { Removed the last zero }\n SetLength(RawLinkName, (Length(RawLinkName)-1));\n end;\n end { end long filename link flag }\n else\n I := I + 1;\n end; { End While }\n\n if not FoundName then\n RawLinkName := PHeader.LinkName;\n\n FTarItem.LinkName := AbRawBytesToString(RawLinkName);\nend;\n\n{ Return True if CheckSum passes out. }\nfunction TAbTarItem.TestCheckSum : Boolean;\nvar\n TarChkSum : LongInt;\n TarChkSumArr : Arr8; { ChkSum field is Arr8 }\n PHeader: PAbTarHeaderRec;\n I: Integer;\nbegin\n Result := True;\n { Check sums are in valid headers but NOT in the data headers. }\n for I := 0 to FTarHeaderList.Count - 1 do\n begin\n if TAbTarHeaderType(FTarHeaderTypeList.Items[I]) in [FILE_HEADER, META_DATA_HEADER] then\n begin\n PHeader := FTarHeaderList.Items[i];\n { Save off old Check sum }\n Move(PHeader.ChkSum, TarChkSumArr, SizeOf(PHeader.ChkSum));\n TarChkSum := OctalToInt(TarChkSumArr, SizeOf(TarChkSumArr));\n { Set to Generator Value }\n PHeader.ChkSum := AB_TAR_CHKBLANKS;\n if CalcTarHeaderChkSum(PHeader^) <> TarChkSum then\n Result := False; { Pass unless one miss-compares }\n { Save back old checksum }\n Move(TarChkSumArr, PHeader.ChkSum, SizeOf(TarChkSumArr));\n end;\n end;\nend;\n\nprocedure TAbTarItem.ParseTarHeaders;\nbegin\n { The final index is the Item index }\n DetectHeaderFormat;\n { Long term this parsing is not correct, as the values in extended headers\n override the later values in this header }\n FTarItem.Mode := OctalToInt(PTarHeader.Mode, SizeOf(PTarHeader.Mode));\n FTarItem.uid := OctalToInt(PTarHeader.uid, SizeOf(PTarHeader.uid)); { Extended in PAX Headers }\n FTarItem.gid := OctalToInt(PTarHeader.gid, SizeOf(PTarHeader.gid)); { Extended in PAX Headers }\n FTarItem.Size := OctalToInt(PTarHeader.Size, SizeOf(PTarHeader.Size)); { Extended in PAX Headers }\n { ModTime should be an Int64 but no tool support, No issues until Feb 6th, 2106 :) }\n { ModTime is Extended in PAX Headers }\n FTarItem.ModTime := OctalToInt(PTarHeader.ModTime, SizeOf(PTarHeader.ModTime));\n FTarItem.ChkSumPass := TestCheckSum();\n FTarItem.LinkFlag := PTarHeader.LinkFlag;\n GetLinkNameFromHeaders; { Extended in PAX Headers }\n FTarItem.Magic := PTarHeader.Magic.value;\n FTarItem.Version := OctalToInt(PTarHeader.Magic.version, SizeOf(PTarHeader.Magic.version));\n FTarItem.UsrName := string(PTarHeader.UsrName); { Extended in PAX Headers }\n FTarItem.GrpName := string(PTarHeader.GrpName); { Extended in PAX Headers }\n FTarItem.DevMajor := OctalToInt(PTarHeader.DevMajor, SizeOf(PTarHeader.DevMajor));\n FTarItem.DevMinor := OctalToInt(PTarHeader.DevMinor, SizeOf(PTarHeader.DevMinor));\n GetFileNameFromHeaders;\n { FTarItem.ArchiveFormat; Already stuffed }\n { FTarItem.StreamPosition: Already Stuffed }\n { FTarItem.Dirty; Stuffed upon creaction }\nend;\n\nprocedure TAbTarItem.LoadTarHeaderFromStream(AStream: TStream);\nvar\n NumMHeaders : Integer;\n I : Integer;\n FoundItem : Boolean;\nbegin\n { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }\n { We should expect FindNext/FirstItem, and next check for bounds. }\n if FTarHeaderList.Count > 0 then\n begin { We're Going to stomp over the headers that are already present }\n { We need to destory the memory we've used }\n PTarHeader := nil;\n for i := 0 to FTarHeaderList.Count - 1 do\n FreeMem(FTarHeaderList.Items[i]); { This list holds PAbTarHeaderRec's }\n FTarHeaderList.Clear;\n FTarHeaderTypeList.Clear;\n FTarItem.FileHeaderCount := 0;\n { All pointers should now be removed from those headers }\n end;\n { Now lets start filling up that list. }\n FTarItem.ItemType := UNKNOWN_ITEM; { We don't know what we have yet }\n FoundItem := False;\n while not FoundItem do\n begin\n { Create a Header to be Stored in the Items List }\n GetMem(PTarHeader, AB_TAR_RECORDSIZE);\n AStream.ReadBuffer(PTarHeader^, AB_TAR_RECORDSIZE);\n FTarHeaderList.Add(PTarHeader); { Store the Header to the list }\n { Parse header based on LinkFlag }\n if PTarHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then\n begin { This Header type is in the Set of un/supported Meta data type headers }\n if PTarHeader.LinkFlag in AB_UNSUPPORTED_MD_HEADERS then\n FTarItem.ItemReadOnly := True; { We don't fully support this meta-data type }\n if (PTarHeader.LinkFlag in AB_PAX_MD_HEADERS) and (PTarHeader.Magic.value = AB_TAR_MAGIC_VAL) then\n FTarItem.ArchiveFormat := POSIX_FORMAT; { We have a POSIX_FORMAT, has x headers, and Magic matches }\n if PTarHeader.LinkFlag in AB_GNU_MD_HEADERS then\n FTarItem.ArchiveFormat := OLDGNU_FORMAT; { We have a OLDGNU_FORMAT, has L/K headers }\n { There can be a unknown number of Headers of data }\n { We are for sure going to read at least one more header, but are we going to read more than that? }\n FTarHeaderTypeList.Add(Pointer(META_DATA_HEADER));\n NumMHeaders := Ceil(OctalToInt(PTarHeader.Size, SizeOf(PTarHeader.Size)) / AB_TAR_RECORDSIZE);\n { NumMHeasder should never be zero }\n for I := 1 to NumMHeaders do\n begin\n GetMem(PTarHeader, AB_TAR_RECORDSIZE); { Create a new Header }\n AStream.ReadBuffer(PTarHeader^, AB_TAR_RECORDSIZE); { Get the Meta Data }\n FTarHeaderList.Add(PTarHeader); { Store the Header to the list }\n FTarHeaderTypeList.Add(Pointer(MD_DATA_HEADER));\n end;\n { Loop and reparse }\n end\n else if PTarHeader.LinkFlag in AB_SUPPORTED_F_HEADERS then\n begin { This Header type is in the Set of supported File type Headers }\n FoundItem := True; { Exit Criterion }\n FTarItem.ItemType := SUPPORTED_ITEM;\n if FTarItem.ItemReadOnly then { Since some of the Headers are read only. }\n FTarItem.ItemType := UNSUPPORTED_ITEM; { This Item is unsupported }\n FTarHeaderTypeList.Add(Pointer(FILE_HEADER));\n end\n else if PTarHeader.LinkFlag in AB_UNSUPPORTED_F_HEADERS then\n begin { This Header type is in the Set of unsupported File type Headers }\n FoundItem := True; { Exit Criterion }\n FTarItem.ItemType := UNSUPPORTED_ITEM;\n FTarHeaderTypeList.Add(Pointer(FILE_HEADER));\n end\n else { These are unknown header types }\n begin { Note: Some of these unknown types could have known Meta-data headers }\n FoundItem := True;\n FTarItem.ItemType := UNKNOWN_ITEM;\n FTarHeaderTypeList.Add(Pointer(UNKNOWN_HEADER));\n end;{ end LinkFlag parsing }\n end; { end Found Item While }\n { PTarHeader points to FTarHeaderList.Items[FTarHeaderList.Count-1]; }\n\n { Re-wind the Stream back to the begining of this Item inc. all headers }\n AStream.Seek(-(FTarHeaderList.Count*AB_TAR_RECORDSIZE), soCurrent);\n { AStream.Position := FTarItem.StreamPosition; } { This should be equivalent as above }\n FTarItem.FileHeaderCount := FTarHeaderList.Count;\n if FTarItem.ItemType <> UNKNOWN_ITEM then\n begin\n ParseTarHeaders; { Update FTarItem values }\n FFileName := FTarItem.Name; {FTarHeader.Name;}\n FDiskFileName := FileName;\n AbUnfixName(FDiskFileName);\n end;\n Action := aaNone;\n Tagged := False;\nend;\n\n\n{ ****************** BEGIN SET ********************** }\n\nprocedure TAbTarItem.SaveTarHeaderToStream(AStream: TStream);\nvar\n i : Integer;\n j : Integer;\n PHeader : PAbTarHeaderRec;\n HdrChkSum : Integer;\n HdrChkStr : AnsiString;\n HdrBuffer : PAnsiChar;\n SkipNextChkSum: Integer;\n SkipChkSum: Boolean;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }\n if FTarItem.Dirty then\n SkipNextChkSum := 0\n else\n SkipNextChkSum := FTarHeaderList.Count; { Don't recalc any chkSums }\n\n { The first header in the Item list must have a checksum calculation }\n for i := 0 to (FTarHeaderList.Count-1) do\n begin\n SkipChkSum := False;\n PHeader := FTarHeaderList.Items[i];\n if (SkipNextChkSum = 0) then\n begin { We need to parse this header }\n if PHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then\n begin { We have a Meta-Data Header, Calculate how many headers to skip. }\n { These meta-data headers have non-Header buffers after this Header }\n SkipNextChkSum := Ceil(OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE);\n { Ceil will mandate one run through, and will handle 512 correctly }\n end\n else if PHeader.LinkFlag in AB_SUPPORTED_F_HEADERS then\n begin\n SkipNextChkSum := 0;\n end\n else\n begin { Un-Supported Header type, Copy but do nothing to the data }\n SkipNextChkSum := 0;\n SkipChkSum := True;\n end;{ end LinkFlag parsing }\n end\n else\n begin { Do not calcuate the check sum on this meta Data header buffer }\n SkipNextChkSum := SkipNextChkSum - 1;\n SkipChkSum := True;\n end;{ end SkipNextChkSum }\n\n if not SkipChkSum then\n begin { We are Calculating the Checksum for this Header }\n {Tar ChkSum is \"odd\" The check sum field is filled with #20 chars as empty }\n { ChkSum field itself is #20'd and has an effect on the sum }\n PHeader.ChkSum := AB_TAR_CHKBLANKS;\n { Set up the buffers }\n HdrBuffer := PAnsiChar(PHeader);\n HdrChkSum := 0;\n { Calculate the checksum, a simple sum of the bytes in the header }\n for j := 0 to (AB_TAR_RECORDSIZE-1) do\n HdrChkSum := HdrChkSum + Ord(HdrBuffer[j]);\n { set the checksum in the header }\n HdrChkStr := PadString(IntToOctal(HdrChkSum), SizeOf(PHeader.ChkSum));\n Move(HdrChkStr[1], PHeader.ChkSum, Length(HdrChkStr));\n end; { end Skip Check Sum }\n { write header to the file }\n AStream.Write(PHeader^, AB_TAR_RECORDSIZE);\n end; { End for the number of headers in the list }\n { Updated here as the stream is now updated to the latest number of headers }\n FTarItem.FileHeaderCount := FTarHeaderList.Count;\nend;\n\nprocedure TAbTarItem.SetCompressedSize(const Value: Int64);\nvar\n S : AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Size is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }\n FTarItem.Size := Value; { Store our Vitrual Copy }\n S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header }\n Move(S[1], PTarHeader.Size, Length(S));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetDevMajor(const Value: Integer);\nvar\n S : AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Dev Major and Minor are Only used for AB_TAR_LF_CHR, AB_TAR_LF_BLK }\n { Otherwise they are stuffed with #00 }\n FTarItem.DevMajor := Value; { Store to the struct }\n S := PadString(IntToOctal(Value), SizeOf(Arr8));\n Move(S[1], PTarHeader.DevMajor, Length(S));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetDevMinor(const Value: Integer);\nvar\n S : AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Dev Major and Minor are Only used for AB_TAR_LF_CHR, AB_TAR_LF_BLK }\n { Otherwise they are stuffed with #00 }\n FTarItem.DevMinor := Value;\n S := PadString(IntToOctal(Value), SizeOf(Arr8));\n Move(S[1], PTarHeader.DevMinor, Length(S));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetExternalFileAttributes(Value: LongWord);\nvar\n S : AnsiString;\n I: Integer;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n FTarItem.Mode := Value;\n S := PadString(IntToOctal(Value), SizeOf(Arr8));\n for I := 0 to FTarHeaderList.Count - 1 do\n if TAbTarHeaderType(FTarHeaderTypeList.Items[I]) in [FILE_HEADER, META_DATA_HEADER] then\n Move(S[1], PAbTarHeaderRec(FTarHeaderList.Items[I]).Mode, Length(S));\n FTarItem.Dirty := True;\nend;\n\n{ Add/Remove Headers as needed To/From Existing GNU Long (Link/Name) TarItems }\nprocedure TAbTarItem.DoGNUExistingLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);\nvar\n PHeader: PAbTarHeaderRec;\n J: Integer;\n OldNameLength: Integer;\n TotalOldNumHeaders: Integer;\n TotalNewNumHeaders: Integer;\n NumHeaders: Integer;\n ExtraName: Integer;\n tempStr: AnsiString;\nbegin\n PHeader := FTarHeaderList.Items[I];\n\n { Need this data from the old header }\n OldNameLength := OctalToInt(PHeader.Size, SizeOf(PHeader.Size));{ inlcudes Null termination }\n { Length(FTarItem.Name)+1 = OldNameLength; }{ This should be true, always }\n\n { Save off the new Length, so we don't have to change the pointers later. }\n tempStr := PadString(IntToOctal(Length(Value)+1), SizeOf(PHeader.Size));\n Move(tempStr[1], PHeader.Size, Length(tempStr));\n\n TotalOldNumHeaders := Ceil(OldNameLength / AB_TAR_RECORDSIZE);\n TotalNewNumHeaders := Ceil((Length(Value)+1) / AB_TAR_RECORDSIZE);{ Null terminated }\n {Length(Value)+1: 1-512 = 1, 513-1024 = 2 ... }\n J := TotalOldNumHeaders - TotalNewNumHeaders;\n while J <> 0 do\n begin\n if J > 0 then\n begin { Old > New, Have to many Headers, Remove }\n FreeMem(FTarHeaderList.Items[I+J]); { Free the Memory for the extra Header }\n FTarHeaderList.Delete(I+J); { Delete the List index }\n FTarHeaderTypeList.Delete(I+J);\n J := J - 1;\n end\n else { if J < 0 then }\n begin { Old < New, Need more Headers, Insert }\n GetMem(PHeader, AB_TAR_RECORDSIZE);\n FTarHeaderList.Insert(I+1,PHeader);{ Insert: Inserts at index }\n FTarHeaderTypeList.Insert(I+1,Pointer(MD_DATA_HEADER));{ We are only adding MD Data headers here }\n J := J + 1;\n end;\n end;{ end numHeaders while }\n { Yes, GNU Tar adds a Nil filled MD data header if Length(Value) mod AB_TAR_RECORDSIZE = 0 }\n NumHeaders := (Length(Value)+1) div AB_TAR_RECORDSIZE; { Include Null terminator }\n ExtraName := (Length(Value)+1) mod AB_TAR_RECORDSIZE; { Chars in the last Header }\n { Now we have the number of headers set up, stuff the name in the Headers }\n TempStr := AnsiString(Value);\n for J := 1 to NumHeaders do\n begin\n { Copy entire next AB_TAR_RECORDSIZE bytes of tempString to content of Header }\n { There may only be AB_TAR_RECORDSIZE-1 bytes if this is the last rounded header }\n PHeader := FTarHeaderList.Items[I+J];\n Move(TempStr[1], PHeader^, AB_TAR_RECORDSIZE);\n if Length(TempStr) >= AB_TAR_RECORDSIZE then\n Delete(TempStr, 1, AB_TAR_RECORDSIZE);{ Crop string }\n end;\n if ExtraName <> 0 then\n begin\n { Copy whatever is left in tempStr into the rest of the buffer }\n PHeader := FTarHeaderList.Items[I+NumHeaders+1];\n FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block }\n Move(TempStr[1], PHeader^, ExtraName-1); { The string is null terminated }\n end\n else { We already copied the entire name, but it must be null terminated }\n begin\n FillChar(Pointer(PtrInt(PHeader)+AB_TAR_RECORDSIZE-1)^, 1, #0); { Zero rest of the block }\n end;\n\n { Finally we need to stuff the file type Header. }\n { Note: Value.length > AB_TAR_NAMESIZE(100) }\n if LinkFlag = AB_TAR_LF_LONGNAME then\n Move(Value[1], PTarHeader.Name, AB_TAR_NAMESIZE)\n else\n Move(Value[1], PTarHeader.LinkName, AB_TAR_NAMESIZE);\nend;\n\n\n{ Always inserts the L/K Headers at index 0+ }\nprocedure TAbTarItem.DoGNUNewLongNameLink(LinkFlag: AnsiChar; I: Integer; const Value: AnsiString);\nvar\n PHeader: PAbTarHeaderRec;\n J: Integer;\n NumHeaders: Integer;\n ExtraName: Integer;\n tempStr: AnsiString;\nbegin\n { We have a GNU_FORMAT, and no L/K Headers.}\n { Add a new MD Header and MD Data Headers }\n { Make an L/K header }\n GetMem(PHeader, AB_TAR_RECORDSIZE);\n FTarHeaderList.Insert(I, PHeader);{ Insert: Inserts at base index }\n FTarHeaderTypeList.Insert(I, Pointer( META_DATA_HEADER));{ This is the L/K Header }\n FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block }\n AbStrPCopy(PHeader.Name, AB_TAR_L_HDR_NAME); { Stuff L/K String Name }\n AbStrPCopy(PHeader.Mode, AB_TAR_L_HDR_ARR8_0); { Stuff zeros }\n AbStrPCopy(PHeader.uid, AB_TAR_L_HDR_ARR8_0); { Stuff zeros }\n AbStrPCopy(PHeader.gid, AB_TAR_L_HDR_ARR8_0); { Stuff zeros }\n tempStr := PadString(IntToOctal(Length(Value)+1), SizeOf(PHeader.Size)); { Stuff Size }\n Move(tempStr[1], PHeader.Size, Length(tempStr));\n AbStrPCopy(PHeader.ModTime, AB_TAR_L_HDR_ARR12_0); { Stuff zeros }\n { Check sum will be calculated as the Dirty flag is in caller. }\n PHeader.LinkFlag := LinkFlag; { Stuff Link FlagSize }\n AbStrPCopy(PHeader.Magic.gnuOld, AB_TAR_MAGIC_GNUOLD); { Stuff the magic }\n AbStrPCopy(PHeader.UsrName, AB_TAR_L_HDR_USR_NAME);\n AbStrPCopy(PHeader.GrpName, AB_TAR_L_HDR_GRP_NAME);\n { All else stays as Zeros. }\n { Completed with L/K Header }\n\n { OK, now we need to add the proper number of MD Data Headers, and intialize to new name }\n { Yes, GNU Tar adds an extra Nil filled MD data header if Length(Value) mod AB_TAR_RECORDSIZE = 0 }\n NumHeaders := Ceil((Length(Value)+1) / AB_TAR_RECORDSIZE); { Include Null terminator }\n ExtraName := (Length(Value)+1) mod AB_TAR_RECORDSIZE; { Chars in the last Header }\n { Now we have the number of headers set up, stuff the name in the Headers }\n TempStr := AnsiString(Value);\n for J := 1 to NumHeaders-1 do\n begin\n { Make a buffer, and copy entire next AB_TAR_RECORDSIZE bytes of tempStr to content of Header }\n { There may only be AB_TAR_RECORDSIZE-1 bytes if this is the last rounded header }\n GetMem(PHeader, AB_TAR_RECORDSIZE);\n FTarHeaderList.Insert(J+I, PHeader);\n FTarHeaderTypeList.Insert(J+I, Pointer(MD_DATA_HEADER));{ We are adding MD Data headers here }\n Move(TempStr[1], PHeader^, AB_TAR_RECORDSIZE);\n if Length(TempStr) >= AB_TAR_RECORDSIZE then\n Delete(TempStr, 1, AB_TAR_RECORDSIZE);{ Crop string }\n end;\n if ExtraName <> 0 then\n begin\n { Copy what ever is left in tempStr into the rest of the buffer }\n { Create the last MD Data Header }\n GetMem(PHeader, AB_TAR_RECORDSIZE);\n FTarHeaderList.Insert(I+NumHeaders, PHeader);{ Insert: Inserts at base index }\n FTarHeaderTypeList.Insert(I+NumHeaders, Pointer(MD_DATA_HEADER));{ We are only adding MD Data headers here }\n FillChar(PHeader^, AB_TAR_RECORDSIZE, #0); { Zero the whole block }\n Move(TempStr[1], PHeader^, ExtraName-1); { The string is null terminated in the header }\n end\n else { We already copied the entire name, but it must be null terminated }\n begin\n FillChar(Pointer(PtrInt(PHeader)+AB_TAR_RECORDSIZE-1)^, 1, #0); { Zero rest of the block }\n end;\n\n { Finally we need to stuff the file type Header. }\n { Note: Value.length > AB_TAR_NAMESIZE(100) }\n if LinkFlag = AB_TAR_LF_LONGNAME then\n Move(Value[1], PHeader.Name, AB_TAR_NAMESIZE)\n else\n Move(Value[1], PHeader.LinkName, AB_TAR_NAMESIZE);\nend;\n\nprocedure TAbTarItem.SetFileName(const Value: string);\nvar\n FoundMetaDataHeader: Boolean;\n PHeader: PAbTarHeaderRec;\n I, J: Integer;\n TotalOldNumHeaders: Integer;\n RawFileName: AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Assume ItemReadOnly is set for all Unsupported Type. }\n\n { Cases:\n New File Name is short, Length <= 100,\n All formats: Zero Name field and move new name to field.\n V7: Work complete, 1 header\n USTAR: zero prefix field, 1 Header\n OLD_GNU & GNU: Remove old name headers, 1 header.\n STAR & PAX: And should not yet get here.\n New File Name is Long, Length >=101\n Note: The Header Parsing sets any V7 to GNU if 'L'/'K\" Headers are present\n V7: Raise an exception, as this can NOT be done, no change to header.\n USTAR: if new length <= 254 zero fill header, update name fields, 1 updated Header\n if new Length >= 255 raise an exception, as this can NOT be done, no change to header\n if old was Short, Add files to match format,\n OLD_GNU & GNU: Create new Name header, Add N Headers for name, Update name in file header, update name fields, min 3 headers\n STAR & PAX: And should not yet get here.\n if old was Long,\n OLD_GNU & GNU: Add N Headers for name, Update name in MD header, update name field in File Headers, min 3 headers\n\n Add headers to length of new Name Length, update name in file header, update name fields }\n RawFileName := AbStringToUnixBytes(Value);\n { In all cases zero out the name fields in the File Header. }\n if Length(RawFileName) > AB_TAR_NAMESIZE then begin { Must be null terminated except at 100 char length }\n { Look for long name meta-data headers already in the archive. }\n FoundMetaDataHeader := False;\n I := 0;\n { FTarHeaderList.Count <= 1 always }\n while (not FoundMetaDataHeader) and (I <= (FTarHeaderList.Count - 1)) do begin\n PHeader := FTarHeaderList.Items[I];\n if PHeader.LinkFlag = AB_TAR_LF_LONGNAME then begin\n { We are growing or Shriking the Name MD Data fields. }\n FoundMetaDataHeader := True;\n DoGNUExistingLongNameLink(AB_TAR_LF_LONGNAME, I, RawFileName);\n { Need to copy the Name to the header. }\n FTarItem.Name := Value;\n end\n else\n I := I + 1;\n end; { End While }\n { MD Headers & MD Data Headers have been stuffed if FoundMetaDataHeader }\n { Still need to stuff the File type header contents. }\n if not FoundMetaDataHeader then\n begin\n case FTarItem.ArchiveFormat of\n V7_FORMAT: raise EAbTarBadFileName.Create; { File Name to Long }\n USTAR_FORMAT:\n begin\n { Longest file name is AB_TAR_NAMESIZE(100) chars }\n { Longest Prefix is AB_TAR_USTAR_PREFIX_SIZE(155) chars }\n { These two fields are delimted by a '/' char }\n {0123456789012345, Length = 15, NameLength = 5, PrefixLength = 9}\n { AAAA/BBBB/C.txt, Stored as Name := 'C.txt', Prefix := 'AAAA/BBBB' }\n { That means Theoretical maximum is 256 for Length(RawFileName) }\n if Length(RawFileName) > (AB_TAR_NAMESIZE+AB_TAR_USTAR_PREFIX_SIZE+1) then { Check the obvious one. }\n raise EAbTarBadFileName.Create; { File Name to Long }\n for I := Length(RawFileName) downto Length(RawFileName)-AB_TAR_NAMESIZE-1 do begin\n if RawFileName[I] = '/' then begin\n if (I <= AB_TAR_USTAR_PREFIX_SIZE+1) and (Length(RawFileName)-I <= AB_TAR_NAMESIZE) then begin\n { We have a successfull parse. }\n FillChar(PTarHeader.Name, SizeOf(PTarHeader.Name), #0);\n FillChar(PTarHeader.ustar.Prefix, SizeOf(PTarHeader.ustar.Prefix), #0);\n Move(RawFileName[I+1], PTarHeader.Name, Length(RawFileName)-I);\n Move(RawFileName[1], PTarHeader.ustar.Prefix, I);\n break;\n end\n else if (Length(RawFileName)-I > AB_TAR_NAMESIZE) then\n raise EAbTarBadFileName.Create { File Name not splittable }\n { else continue; }\n end;\n end;{ End for I... }\n end; { End USTAR Format }\n OLDGNU_FORMAT: DoGNUNewLongNameLink(AB_TAR_LF_LONGNAME, 0, RawFileName); {GNU_FORMAT}\n else begin\n { UNKNOWN_FORMAT, STAR_FORMAT, POSIX_FORMAT }\n raise EAbTarBadOp.Create; { Unknown Archive Format }\n end;{ End of Else for case statement }\n end;{ End of case statement }\n FTarItem.Name := Value;\n end; { if no Meta data header found }\n end { End \"name length larger than 100\" }\n else\n begin { Short new name, Simple Case Just put it in the Name Field & remove any headers }\n { PTarHeader Points to the File type Header }\n { Zero the Name field }\n FillChar(PTarHeader.Name, SizeOf(PTarHeader.Name), #0);\n if FTarItem.ArchiveFormat in [USTAR_FORMAT] then { Zero the prefix field }\n FillChar(PTarHeader.ustar.Prefix, SizeOf(PTarHeader.ustar.Prefix), #0);\n if FTarItem.ArchiveFormat in [GNU_FORMAT, OLDGNU_FORMAT] then\n begin { We may have AB_TAR_LF_LONGNAME Headers to be removed }\n { Remove long file names Headers if they exist}\n FoundMetaDataHeader := False;\n I := 0;\n while not FoundMetaDataHeader and (I <= (FTarHeaderList.Count - 1)) do\n begin\n PHeader := FTarHeaderList.Items[I];\n if PHeader.LinkFlag in [AB_TAR_LF_LONGNAME] then\n begin { Delete this Header, and the data Headers. }\n FoundMetaDataHeader := True;\n TotalOldNumHeaders := Ceil( OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE);\n for J := TotalOldNumHeaders downto 0 do\n begin { Note 0 will delete the Long Link MD Header }\n FreeMem(FTarHeaderList.Items[I+J]); { This list holds PAbTarHeaderRec's }\n FTarHeaderList.Delete(I+J);\n FTarHeaderTypeList.Delete(I+J);\n end;\n end\n else\n I := I + 1; { Got to next header }\n end;{ End While not found... }\n end; { End if GNU... }\n { Save off the new name and store to the Header }\n FTarItem.Name := Value;\n { Must add Null Termination before we store to Header }\n AbStrPLCopy(PTarHeader.Name, RawFileName, AB_TAR_NAMESIZE);\n end;{ End else Short new name,... }\n\n { Update the inherited file names. }\n FFileName := FTarItem.Name;\n DiskFileName := FFileName;\n AbUnfixName(FDiskFileName);\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetGroupID(const Value: Integer);\nvar\n S : AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { gid is extendable in PAX Headers, Rember PAX extended Header Over Rule File Headers }\n FTarItem.gid := Value;\n S := PadString(IntToOctal(Value), SizeOf(Arr8));\n Move(S[1], PTarHeader.gid, Length(S));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetGroupName(const Value: string);\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { GrpName is extendable in PAX Headers, Rember PAX extended Header Over Rule File Headers }\n FTarItem.GrpName := Value;\n AbStrPLCopy(PTarHeader.GrpName, AnsiString(Value), SizeOf(PTarHeader.GrpName));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetIsEncrypted(Value: Boolean);\nbegin\n { do nothing, TAR has no native encryption }\nend;\n\nprocedure TAbTarItem.SetLastModFileDate(const Value: Word);\nbegin\n { replace date, keep existing time }\n LastModTimeAsDateTime :=\n EncodeDate(\n Value shr 9 + 1980,\n Value shr 5 and 15,\n Value and 31) +\n Frac(LastModTimeAsDateTime);\nend;\n\nprocedure TAbTarItem.SetLastModFileTime(const Value: Word);\nbegin\n { keep current date, replace time }\n LastModTimeAsDateTime :=\n Trunc(LastModTimeAsDateTime) +\n EncodeTime(\n Value shr 11,\n Value shr 5 and 63,\n Value and 31 shl 1, 0);\nend;\n\nprocedure TAbTarItem.SetLastModTimeAsDateTime(const Value: TDateTime);\nbegin\n // TAR stores always Unix time.\n SetModTime(AbLocalDateTimeToUnixTime(Value)); // also updates headers\nend;\n\nprocedure TAbTarItem.SetLinkFlag(Value: AnsiChar);\nbegin\n if FTarItem.ItemReadOnly then\n Exit;\n FTarItem.LinkFlag := Value;\n PTarHeader.LinkFlag := Value;\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetLinkName(const Value: string);\nvar\n FoundMetaDataHeader: Boolean;\n PHeader: PAbTarHeaderRec;\n I, J: Integer;\n TotalOldNumHeaders: Integer;\n RawLinkName: AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Cases:\n New Link Name is short, Length <= 100,\n All formats: Zero Name field and move new name to field.\n V7: Work complete, 1 header\n USTAR: Work complete, 1 Header\n OLD_GNU & GNU: Remove old link headers, 1 header.\n STAR & PAX: And should not yet get here.\n New File Name is Long, Length >=101\n Note: The Header Parsing sets any V7 to GNU if 'L'/'K' Headers are present\n V7: Raise an exception, as this can NOT be done, no change to header.\n USTAR: Raise an exception, as this can NOT be done, no change to header.\n if old was Short, Add files to match format,\n OLD_GNU & GNU: Create new Link header, Add N Headers for name, Update name in file header, update name fields, min 3 headers\n if old was Long,\n OLD_GNU & GNU: Add N Headers for name, Update name in MD header, update name field in File Headers, min 3 headers\n STAR & PAX: And should not yet get here.}\n RawLinkName := AbStringToUnixBytes(Value);\n if Length(RawLinkName) > AB_TAR_NAMESIZE then { Must be null terminated except at 100 char length }\n begin\n { Look for long name meta-data headers already in the archive. }\n FoundMetaDataHeader := False;\n I := 0;\n { FTarHeaderList.Count <= 1 always }\n while (not FoundMetaDataHeader) and (I <= (FTarHeaderList.Count - 1)) do begin\n PHeader := FTarHeaderList.Items[I];\n if PHeader.LinkFlag = AB_TAR_LF_LONGLINK then\n begin { We are growing or Shriking the Name MD Data fields. }\n FoundMetaDataHeader := True;\n DoGNUExistingLongNameLink(AB_TAR_LF_LONGLINK, I, RawLinkName);\n { Need to copy the Name to the header. }\n FTarItem.LinkName := Value;\n end\n else\n I := I + 1;\n end; { End While }\n { MD Headers & MD Data Headers have been stuffed if FoundMetaDataHeader }\n { Still need to stuff the File type header contents. }\n if not FoundMetaDataHeader then\n begin\n case FTarItem.ArchiveFormat of\n V7_FORMAT: raise EAbTarBadLinkName.Create; { Link Name to Long }\n USTAR_FORMAT: raise EAbTarBadLinkName.Create; { Link Name to Long }\n OLDGNU_FORMAT: DoGNUNewLongNameLink(AB_TAR_LF_LONGLINK, 0, RawLinkName); {GNU_FORMAT}\n else\n begin\n { UNKNOWN_FORMAT, STAR_FORMAT, POSIX_FORMAT }\n raise EAbTarBadOp.Create; { Unknown Archive Format }\n end;{ End of Else for case statement }\n end;{ End of case statement }\n FTarItem.LinkName := Value;\n end; { if no Meta data header found }\n end { End \"name length larger than 100\" }\n else\n begin { Short new name, Simple Case Just put it in the Link Field & remove any headers }\n { PTarHeader Points to the File type Header }\n { Zero the Link field }\n FillChar(PTarHeader.LinkName, SizeOf(PTarHeader.LinkName), #0);\n if FTarItem.ArchiveFormat in [GNU_FORMAT, OLDGNU_FORMAT] then\n begin { We may have AB_TAR_LF_LONGNAME Headers to be removed }\n { Remove long file names Headers if they exist}\n FoundMetaDataHeader := False;\n I := 0;\n while not FoundMetaDataHeader and (I <= (FTarHeaderList.Count - 1)) do\n begin\n PHeader := FTarHeaderList.Items[I];\n if PHeader.LinkFlag in [AB_TAR_LF_LONGLINK] then\n begin { Delete this Header, and the data Headers. }\n FoundMetaDataHeader := True;\n TotalOldNumHeaders := Ceil( OctalToInt(PHeader.Size, SizeOf(PHeader.Size)) / AB_TAR_RECORDSIZE);\n for J := TotalOldNumHeaders downto 0 do\n begin { Note 0 will delete the Long Link MD Header }\n FreeMem(FTarHeaderList.Items[I+J]); { This list holds PAbTarHeaderRec's }\n FTarHeaderList.Delete(I+J);\n FTarHeaderTypeList.Delete(I+J);\n end;\n end\n else\n I := I + 1; { Got to next header }\n end;{ End While not found... }\n end; { End if GNU... }\n { Save off the new name and store to the Header }\n FTarItem.LinkName := Value;\n AbStrPLCopy(PTarHeader.LinkName, RawLinkName, AB_TAR_NAMESIZE);\n end;{ End else Short new name,... }\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetMagic(const Value: String);\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n FTarItem.Magic := AnsiString(Value);\n Move(Value[1], PTarHeader.Magic, SizeOf(TAbTarMagicRec));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetUncompressedSize(const Value: Int64);\nvar\n S : AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { Size is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }\n FTarItem.Size := Value; { Store our Vitrual Copy }\n S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header }\n Move(S[1], PTarHeader.Size, Length(S));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetUserID(const Value: Integer);\nvar\n S : AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { uid is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }\n FTarItem.uid := Value;\n S := PadString(IntToOctal(Value), SizeOf(Arr8));\n Move(S[1], PTarHeader.uid, Length(S));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetUserName(const Value: string);\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { UsrName is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }\n FTarItem.UsrName := Value;\n AbStrPLCopy(PTarHeader.UsrName, AnsiString(Value), SizeOf(PTarHeader.UsrName));\n FTarItem.Dirty := True;\nend;\n\nprocedure TAbTarItem.SetModTime(const Value: Int64);\nvar\n S: AnsiString;\nbegin\n if FTarItem.ItemReadOnly then { Read Only - Do Not Save }\n Exit;\n { ModTime is extendable in PAX Headers, Remember PAX extended Header Over Rule File Headers }\n FTarItem.ModTime := Value; { Store our Virtual Copy }\n S := PadString(IntToOctal(Value), SizeOf(Arr12));{ Stuff to header }\n Move(S[1], PTarHeader.ModTime, Length(S));\n FTarItem.Dirty := True;\nend;\n\n\n{ ************************** TAbTarStreamHelper ****************************** }\ndestructor TAbTarStreamHelper.Destroy;\nbegin\n inherited Destroy;\nend;\n\n{ This is slow, use the archive class instead }\nprocedure TAbTarStreamHelper.ExtractItemData(AStream: TStream);\nbegin\n { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }\n if FCurrItemSize <> 0 then\n begin\n { copy stored data to output }\n AStream.CopyFrom(FStream, FCurrItemSize);\n {reset the stream to the start of the item}\n FStream.Seek(-(FCurrItemPreHdrs*AB_TAR_RECORDSIZE+FCurrItemSize), soCurrent);\n end;\n { else do nothing }\nend;\n\n{ This function Should only be used from LoadArchive, as it is slow. }\nfunction TAbTarStreamHelper.FindItem: Boolean;\nvar\n DataRead : LongInt;\n FoundItem: Boolean;\n SkipHdrs : Integer;\nbegin\n { Note: The SizeOf(TAbTarHeaderRec) = AB_TAR_RECORDSIZE }\n { Note: Standard LBA size of hard disks is 512 bytes = AB_TAR_RECORDSIZE }\n FoundItem := False;\n { Getting an new Item reset these numbers }\n FCurrItemSize := 0;\n FCurrItemPreHdrs := 0;\n DataRead := FStream.Read(FTarHeader, AB_TAR_RECORDSIZE); { Read in a header }\n { DataRead <> AB_TAR_RECORDSIZE means end of stream, and the End Of Archive\n record is all #0's, which the StrLen(FTarHeader.Name) check will catch }\n while (DataRead = AB_TAR_RECORDSIZE) and (AbStrLen(FTarHeader.Name) > 0) and not FoundItem do\n begin { Either exit when we find a supported file or end of file or an invalid header name. }\n if FTarHeader.LinkFlag in (AB_SUPPORTED_MD_HEADERS+AB_UNSUPPORTED_MD_HEADERS) then\n begin { We have a un/supported Meta-Data Header }\n { FoundItem := False } { Value remains False. }\n SkipHdrs := Ceil(OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size))/AB_TAR_RECORDSIZE);\n FStream.Seek(SkipHdrs*AB_TAR_RECORDSIZE, soCurrent);\n { Tally new Headers: Consumed + Current }\n FCurrItemPreHdrs := FCurrItemPreHdrs + SkipHdrs + 1;\n { Read our next header, Loop, and re-parse }\n DataRead := FStream.Read(FTarHeader, AB_TAR_RECORDSIZE);\n end\n else if FTarHeader.LinkFlag in (AB_SUPPORTED_F_HEADERS+AB_UNSUPPORTED_F_HEADERS) then\n begin { We have a un/supported File Header. }\n FoundItem := True;\n if not (FTarHeader.LinkFlag in AB_IGNORE_SIZE_HEADERS) then\n FCurrItemSize := OctalToInt(FTarHeader.Size, SizeOf(FTarHeader.Size))\n else FCurrItemSize := 0; { Per The spec these Headers do not have file content }\n FCurrItemPreHdrs := FCurrItemPreHdrs + 1; { Tally current header }\n end\n else\n begin{ We Have an Unknown header }\n FoundItem := True;\n FCurrItemSize := 0;\n { We could have many un/supported headers before this unknown type }\n FCurrItemPreHdrs := FCurrItemPreHdrs + 1; { Tally current header }\n { These Headers should throw exceptions when TAbTarItem.LoadTarHeaderFromStream is called }\n end; { End of Link Flag parsing }\n end;\n { Rewind to the \"The Beginning\" of this Item }\n { Really that means to the first supported Header Type before a supported Item Type }\n if FoundItem then\n FStream.Seek(-(FCurrItemPreHdrs*AB_TAR_RECORDSIZE), soCurrent);\n Result := FoundItem;\nend;\n\n{ Should only be used from LoadArchive, as it is slow. }\nfunction TAbTarStreamHelper.FindFirstItem: Boolean;\nbegin\n FStream.Seek(0, soBeginning);\n Result := FindItem;\nend;\n\n{ Should only be used from LoadArchive, as it is slow. }\nfunction TAbTarStreamHelper.FindNextItem: Boolean;\nbegin\n { Fast Forward Past the current Item }\n FStream.Seek((FCurrItemPreHdrs*AB_TAR_RECORDSIZE + RoundToTarBlock(FCurrItemSize)), soCurrent);\n Result := FindItem;\nend;\n\n{ This is slow, use the archive class instead }\nfunction TAbTarStreamHelper.GetItemCount : Integer;\nvar\n Found : Boolean;\nbegin\n Result := 0;\n Found := FindFirstItem;\n while Found do begin\n Inc(Result);\n Found := FindNextItem;\n end;\nend;\n\nprocedure TAbTarStreamHelper.ReadHeader;\nbegin\n { do nothing }\n { Tar archives have no overall header data }\nend;\n\nprocedure TAbTarStreamHelper.ReadTail;\nbegin\n { do nothing }\n { Tar archives have no overall tail data }\nend;\n\n{ This is slow, use the archive class instead }\nfunction TAbTarStreamHelper.SeekItem(Index: Integer): Boolean;\nvar\n i : Integer;\nbegin\n Result := FindFirstItem; { see if can get to first item }\n i := 1;\n while Result and (i < Index) do begin\n Result := FindNextItem;\n Inc(i);\n end;\nend;\n\nprocedure TAbTarStreamHelper.WriteArchiveHeader;\nbegin\n { do nothing }\n { Tar archives have no overall header data }\nend;\n\nprocedure TAbTarStreamHelper.WriteArchiveItem(AStream: TStream);\nbegin\n WriteArchiveItemSize(AStream, AStream.Size);\nend;\n\nprocedure TAbTarStreamHelper.WriteArchiveItemSize(AStream: TStream; Size: Int64);\nvar\n PadBuff : PAnsiChar;\n PadSize : Integer;\nbegin\n if Size = 0 then\n Exit;\n { transfer actual item data }\n FStream.CopyFrom(AStream, Size);\n\n { Pad to Next block }\n PadSize := RoundToTarBlock(Size) - Size;\n GetMem(PadBuff, PadSize);\n FillChar(PadBuff^, PadSize, #0);\n FStream.Write(PadBuff^, PadSize);\n FreeMem(PadBuff, PadSize);\nend;\n\n\nprocedure TAbTarStreamHelper.WriteArchiveTail;\nvar\n PadBuff : PAnsiChar;\n PadSize : Integer;\nbegin\n { append 2 terminating null blocks }\n PadSize := AB_TAR_RECORDSIZE;\n GetMem(PadBuff, PadSize);\n try\n FillChar(PadBuff^, PadSize, #0);\n FStream.Write(PadBuff^, PadSize);\n FStream.Write(PadBuff^, PadSize);\n finally\n FreeMem(PadBuff, PadSize);\n end;\nend;\n\n\n\n{ ***************************** TAbTarArchive ******************************** }\nconstructor TAbTarArchive.CreateFromStream(aStream : TStream; const aArchiveName : string);\nbegin\n inherited;\n FArchFormat := V7_FORMAT; // Default for new archives\nend;\n\nfunction TAbTarArchive.CreateItem(const FileSpec: string): TAbArchiveItem;\nvar\n Item : TAbTarItem;\n S : String;\n I: Integer;\nbegin\n if FArchReadOnly then\n raise EAbTarBadOp.Create; { Create Item Unsupported in this Archive }\n\n S := FixName(FileSpec);\n Item := TAbTarItem.Create;\n try\n // HeaderFormat = (UNKNOWN_FORMAT, V7_FORMAT, OLDGNU_FORMAT, GNU_FORMAT, USTAR_FORMAT, STAR_FORMAT, POSIX_FORMAT);\n if FArchFormat in [OLDGNU_FORMAT, GNU_FORMAT] then\n begin\n Item.ArchiveFormat := FArchFormat;\n Item.LinkFlag := AB_TAR_LF_NORMAL;\n Item.Magic := AB_TAR_MAGIC_GNUOLD;\n end\n else if FArchFormat in [USTAR_FORMAT] then\n begin\n Item.ArchiveFormat := USTAR_FORMAT;\n Item.LinkFlag := AB_TAR_LF_NORMAL;\n Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER;\n end\n else if (FArchFormat = V7_FORMAT) and (Length(S) > 100) then\n begin { Switch the rep over to GNU so it can have long file names. }\n FArchFormat := OLDGNU_FORMAT;\n Item.ArchiveFormat := OLDGNU_FORMAT;\n { Leave the Defaults for LinkFlag, and Magic }\n { Update all the rest so that it can transistion to GNU_FORMAT }\n for I := 0 to FItemList.Count - 1 do\n TAbTarItem(FItemList.Items[i]).ArchiveFormat := OLDGNU_FORMAT;\n end;{ This should not execute... }{\n else if FArchFormat in [STAR_FORMAT, POSIX_FORMAT] then\n begin\n Item.ArchiveFormat := FArchFormat;\n Item.LinkFlag := AB_TAR_LF_NORMAL;\n Item.Magic := AB_TAR_MAGIC_VAL+AB_TAR_MAGIC_VER;\n end;\n }{ else FArchFormat in [ UNKNOWN_FORMAT, V7_FORMAT and Length(S) <= 100 ] } { This is the default. }\n\n { Most others are initialized in the .Create }\n Item.CRC32 := 0;\n { Note this can raise exceptions for file name lengths. }\n Item.FileName := FixName(FileSpec);\n Item.DiskFileName := ExpandFileName(FileSpec);\n Item.Action := aaNone;\n finally\n Result := Item;\n end;\nend;\n\n\nprocedure TAbTarArchive.ExtractItemAt(Index: Integer; const UseName: string);\nvar\n OutStream : TFileStream;\n CurItem : TAbTarItem;\nbegin\n { Check the index is not out of range. }\n if(Index >= ItemList.Count) then\n raise EListError.CreateFmt(SListIndexError, [Index]);\n\n CurItem := TAbTarItem(ItemList[Index]);\n\n if CurItem.ItemType in [UNKNOWN_ITEM] then\n raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }\n if (CurItem.ItemType = UNSUPPORTED_ITEM) and\n ((Length(CurItem.FileName) >= AB_TAR_NAMESIZE) or\n (Length(CurItem.LinkName) >= AB_TAR_NAMESIZE)) then\n raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }\n { We will allow extractions if the file name/Link name are strickly less than 100 chars }\n\n if CurItem.IsDirectory then\n AbCreateDirectory(UseName)\n else begin\n OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyNone);\n try\n try {OutStream}\n ExtractItemToStreamAt(Index, OutStream);\n finally {OutStream}\n OutStream.Free;\n end; {OutStream}\n except\n if ExceptObject is EAbUserAbort then\n FStatus := asInvalid;\n DeleteFile(UseName);\n raise;\n end;\n end;\n AbSetFileTime(UseName, CurItem.LastModTimeAsDateTime);\n AbSetFileAttr(UseName, CurItem.NativeFileAttributes);\nend;\n\nprocedure TAbTarArchive.ExtractItemToStreamAt(Index: Integer;\n aStream: TStream);\nvar\n CurItem : TAbTarItem;\nbegin\n if(Index >= ItemList.Count) then\n raise EListError.CreateFmt(SListIndexError, [Index]);\n\n CurItem := TAbTarItem(ItemList[Index]);\n\n if CurItem.ItemType in [UNKNOWN_ITEM] then\n raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }\n if (CurItem.ItemType = UNSUPPORTED_ITEM) and\n ((Length(CurItem.FileName) >= AB_TAR_NAMESIZE) or\n (Length(CurItem.LinkName) >= AB_TAR_NAMESIZE)) then\n raise EAbTarBadOp.Create; { Unsupported Type, Cannot Extract }\n { We will allow extractions if the file name is strictly less than 100 chars }\n\n FStream.Position := CurItem.StreamPosition+CurItem.FileHeaderCount*AB_TAR_RECORDSIZE;\n if CurItem.UncompressedSize <> 0 then\n aStream.CopyFrom(FStream, CurItem.UncompressedSize);\n { Else there is nothing to copy. }\nend;\n\nprocedure TAbTarArchive.LoadArchive;\nvar\n TarHelp : TAbTarStreamHelper;\n Item : TAbTarItem;\n ItemFound : Boolean;\n Abort : Boolean;\n Confirm : Boolean;\n i : Integer;\n Progress : Byte;\n\nbegin\n { create helper }\n TarHelp := TAbTarStreamHelper.Create(FStream);\n try {TarHelp}\n {build Items list from tar header records}\n\n { reset Tar }\n ItemFound := (FStream.Size > 0) and TarHelp.FindFirstItem;\n if ItemFound then FArchFormat := UNKNOWN_FORMAT\n else FArchFormat := V7_FORMAT;\n\n { while more data in Tar }\n while (FStream.Position < FStream.Size) and ItemFound do begin\n {create new Item}\n Item := TAbTarItem.Create;\n Item.FTarItem.StreamPosition := FStream.Position;\n try {Item}\n Item.LoadTarHeaderFromStream(FStream);\n if Item.ItemReadOnly then\n FArchReadOnly := True; { Set Archive as Read Only }\n if Item.ItemType in [SUPPORTED_ITEM, UNSUPPORTED_ITEM] then begin\n { List of supported Item/File Types. }\n { Add the New Supported Item to the List }\n if FArchFormat < Item.ArchiveFormat then\n FArchFormat := Item.ArchiveFormat; { Take the max format }\n Item.Action := aaNone;\n FItemList.Add(Item);\n end { end if }\n else begin\n { unhandled Tar file system entity, notify user, but otherwise ignore }\n if Assigned(FOnConfirmProcessItem) then\n FOnConfirmProcessItem(self, Item, ptFoundUnhandled, Confirm);\n end;\n\n { show progress and allow for aborting }\n Progress := (FStream.Position*100) div FStream.Size;\n DoArchiveProgress(Progress, Abort);\n if Abort then begin\n FStatus := asInvalid;\n raise EAbUserAbort.Create;\n end;\n\n { get the next item }\n ItemFound := TarHelp.FindNextItem;\n except {Item}\n raise EAbTarBadOp.Create; { Invalid Item }\n end; {Item}\n end; {end while }\n\n { All the items need to reflect this information. }\n for i := 0 to FItemList.Count - 1 do\n begin\n TAbTarItem(FItemList.Items[i]).ArchiveFormat := FArchFormat;\n TAbTarItem(FItemList.Items[i]).ItemReadOnly := FArchReadOnly;\n end;\n\n DoArchiveProgress(100, Abort);\n FIsDirty := False;\n\n finally {TarHelp}\n { Clean Up }\n TarHelp.Free;\n end; {TarHelp}\nend;\n\n\nfunction TAbTarArchive.FixName(const Value: string): string;\n{ fixup filename for storage }\nvar\n lValue : string;\nbegin\n lValue := Value;\n {$IFDEF MSWINDOWS}\n if DOSMode then begin\n {Add the base directory to the filename before converting }\n {the file spec to the short filespec format. }\n if BaseDirectory <> '' then begin\n {Does the filename contain a drive or a leading backslash? }\n if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then\n {If not, add the BaseDirectory to the filename.}\n lValue := BaseDirectory + AbPathDelim + lValue;\n end;\n lValue := AbGetShortFileSpec( lValue );\n end;\n {$ENDIF MSWINDOWS}\n\n { Should always trip drive info if on a Win/Dos system }\n StoreOptions := StoreOptions + [soStripDrive];\n\n { strip drive stuff }\n if soStripDrive in StoreOptions then\n AbStripDrive( lValue );\n\n { check for a leading slash }\n if lValue[1] = AbPathDelim then\n System.Delete( lValue, 1, 1 );\n\n if soStripPath in StoreOptions then\n lValue := ExtractFileName(lValue);\n\n if soRemoveDots in StoreOptions then\n AbStripDots(lValue);\n\n AbFixName(lValue);\n\n Result := lValue;\nend;\n\nfunction TAbTarArchive.GetItem(Index: Integer): TAbTarItem;\nbegin\n Result := TAbTarItem(FItemList.Items[Index]);\nend;\n\nfunction TAbTarArchive.GetSupportsEmptyFolders: Boolean;\nbegin\n Result := True;\nend;\n\nprocedure TAbTarArchive.PutItem(Index: Integer; const Value: TAbTarItem);\nbegin\n //TODO: Remove this from all archives\n FItemList.Items[Index] := Value;\nend;\n\nprocedure TAbTarArchive.SaveArchive;\nvar\n OutTarHelp : TAbTarStreamHelper;\n Abort : Boolean;\n i : Integer;\n NewStream : TAbVirtualMemoryStream;\n TempStream : TStream;\n SaveDir : string;\n CurItem : TAbTarItem;\n AttrEx : TAbAttrExRec;\nbegin\n if FArchReadOnly then\n raise EAbTarBadOp.Create; { Archive is read only }\n\n {init new archive stream}\n NewStream := TAbVirtualMemoryStream.Create;\n OutTarHelp := TAbTarStreamHelper.Create(NewStream);\n\n try {NewStream/OutTarHelp}\n { create helper }\n NewStream.SwapFileDirectory := FTempDir;\n\n {build new archive from existing archive}\n for i := 0 to pred(Count) do begin\n FCurrentItem := ItemList[i];\n CurItem := TAbTarItem(ItemList[i]);\n\n case CurItem.Action of\n aaNone, aaMove : begin {just copy the file to new stream}\n { \"Seek\" to the Item Data } { SaveTarHeaders, Updates FileHeaderCount }\n FStream.Position := CurItem.StreamPosition+CurItem.FileHeaderCount*AB_TAR_RECORDSIZE;\n CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. }\n { Flush The Headers to the new stream }\n CurItem.SaveTarHeaderToStream(NewStream);\n { Copy to new Stream, Round to the AB_TAR_RECORDSIZE boundry, and Pad zeros}\n outTarhelp.WriteArchiveItemSize(FStream, CurItem.UncompressedSize);\n end;\n\n aaDelete: {doing nothing omits file from new stream} ;\n\n aaStreamAdd : begin\n try\n { adding from a stream }\n CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. }\n CurItem.UncompressedSize := InStream.Size;\n CurItem.SaveTarHeaderToStream(NewStream);\n OutTarHelp.WriteArchiveItemSize(InStream, InStream.Size);\n except\n ItemList[i].Action := aaDelete;\n DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);\n end;\n end;\n\n aaAdd, aaFreshen, aaReplace: begin\n try\n { it's coming from a file }\n GetDir(0, SaveDir);\n try {SaveDir}\n if (BaseDirectory <> '') then\n ChDir(BaseDirectory);\n { update metadata }\n if not AbFileGetAttrEx(CurItem.DiskFileName, AttrEx) then\n raise EAbFileNotFound.Create;\n CurItem.ExternalFileAttributes := AttrEx.Mode;\n CurItem.LastModTimeAsDateTime := AttrEx.Time;\n { TODO: uid, gid, uname, gname should be added here }\n { TODO: Add support for different types of files here }\n if (AttrEx.Mode and AB_FMODE_DIR) <> 0 then begin\n CurItem.LinkFlag := AB_TAR_LF_DIR;\n CurItem.UncompressedSize := 0;\n CurItem.SaveTarHeaderToStream(NewStream);\n end\n else begin\n TempStream := TFileStream.Create(CurItem.DiskFileName,\n fmOpenRead or fmShareDenyWrite );\n try { TempStream }\n CurItem.UncompressedSize := TempStream.Size;\n CurItem.StreamPosition := NewStream.Position;{ Reset the Stream Pointer. }\n CurItem.SaveTarHeaderToStream(NewStream);\n OutTarHelp.WriteArchiveItemSize(TempStream, TempStream.Size);\n finally { TempStream }\n TempStream.Free;\n end; { TempStream }\n end;\n finally {SaveDir}\n ChDir( SaveDir );\n end; {SaveDir}\n except\n ItemList[i].Action := aaDelete;\n DoProcessItemFailure(ItemList[i], ptAdd, ecFileOpenError, 0);\n end;\n end; { aaAdd ... }\n end; { case }\n end; { for i ... }\n\n if NewStream.Size <> 0 then\n OutTarHelp.WriteArchiveTail; { Terminate the TAR }\n { Size of NewStream is still 0, and max of the stream will also be 0 }\n\n {copy new stream to FStream}\n NewStream.Position := 0;\n if (FStream is TMemoryStream) then\n TMemoryStream(FStream).LoadFromStream(NewStream)\n else if (FStream is TAbVirtualMemoryStream) or not FOwnsStream then begin\n FStream.Size := 0;\n FStream.Position := 0;\n FStream.CopyFrom(NewStream, NewStream.Size);\n end\n else begin\n { write to a new stream }\n FreeAndNil(FStream);\n FStream := TFileStream.Create(FArchiveName, fmCreate or fmShareDenyWrite);\n FStream.CopyFrom(NewStream, NewStream.Size);\n end;\n\n {update Items list}\n for i := pred( Count ) downto 0 do begin\n if ItemList[i].Action = aaDelete then\n FItemList.Delete( i )\n else if ItemList[i].Action <> aaFailed then\n ItemList[i].Action := aaNone;\n end;\n\n DoArchiveSaveProgress( 100, Abort );\n DoArchiveProgress( 100, Abort );\n finally {NewStream/OutTarHelp}\n OutTarHelp.Free;\n NewStream.Free;\n end;\nend;\n\n{ This assumes that LoadArchive has been called. }\nprocedure TAbTarArchive.TestItemAt(Index: Integer);\nbegin\n FStream.Position := TAbTarItem(FItemList[Index]).StreamPosition;\n if VerifyTar(FStream) <> atTar then\n raise EAbTarInvalid.Create; { Invalid Tar }\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbUnzOutStm.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is Craig Peterson\n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbUnzOutStm.pas *}\n{*********************************************************}\n{* ABBREVIA: UnZip output stream; progress and CRC32 *}\n{*********************************************************}\n\nunit AbUnzOutStm;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils, Classes, AbArcTyp;\n\ntype\n // Fixed-length read-only stream, limits reads to the range between\n // the input stream's starting position and a specified size. Seek/Position\n // are adjusted to be 0 based.\n TAbUnzipSubsetStream = class( TStream )\n private\n FStream : TStream;\n FStartPos: Int64;\n FCurPos: Int64;\n FEndPos: Int64;\n\n public\n constructor Create(aStream: TStream; aStreamSize: Int64);\n\n function Read(var Buffer; Count: Longint): Longint; override;\n function Write(const Buffer; Count: Longint): Longint; override;\n function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;\n end;\n\n\n // Write-only output stream, computes CRC32 and calls progress event\n TAbUnzipOutputStream = class( TStream )\n private\n FBytesWritten : Int64;\n FCRC32 : LongInt;\n FCurrentProgress : Byte;\n FStream : TStream;\n FUncompressedSize : Int64;\n FOnProgress : TAbProgressEvent;\n\n function GetCRC32 : LongInt;\n\n public\n constructor Create(aStream : TStream);\n\n function Read(var Buffer; Count: Longint): Longint; override;\n function Write(const Buffer; Count: Longint): Longint; override;\n function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;\n\n property CRC32 : LongInt\n read GetCRC32;\n property Stream : TStream\n read FStream\n write FStream;\n property UncompressedSize : Int64\n read FUncompressedSize\n write FUncompressedSize;\n property OnProgress : TAbProgressEvent\n read FOnProgress\n write FOnProgress;\n end;\n\n\nimplementation\n\nuses\n Math, AbExcept, AbUtils;\n\n{ TAbUnzipSubsetStream implementation ====================================== }\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbUnzipSubsetStream.Create(aStream: TStream; aStreamSize: Int64);\nbegin\n inherited Create;\n FStream := aStream;\n FStartPos := FStream.Position;\n FCurPos := FStartPos;\n FEndPos := FStartPos + aStreamSize;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipSubsetStream.Read(var Buffer; Count: Longint): Longint;\nbegin\n if Count > FEndPos - FCurPos then\n Count := FEndPos - FCurPos;\n if Count > 0 then begin\n Result := FStream.Read(Buffer, Count);\n Inc(FCurPos, Result);\n end\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipSubsetStream.Write(const Buffer; Count: Longint): Longint;\nbegin\n raise EAbException.Create('TAbUnzipSubsetStream.Write not supported');\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipSubsetStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\nvar\n OldPos: Int64;\nbegin\n OldPos := FCurPos;\n case Origin of\n soBeginning: FCurPos := FStartPos + Offset;\n soCurrent: FCurPos := FCurPos + Offset;\n soEnd: FCurPos := FEndPos + Offset;\n end;\n if FCurPos < FStartPos then\n FCurPos := FStartPos;\n if FCurPos > FEndPos then\n FCurPos := FEndPos;\n if OldPos <> FCurPos then\n FStream.Position := FCurPos;\n Result := FCurPos - FStartPos;\nend;\n{ -------------------------------------------------------------------------- }\n\n\n{ TAbUnzipOutputStream implementation ====================================== }\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbUnzipOutputStream.Create(aStream: TStream);\nbegin\n inherited Create;\n FStream := aStream;\n FCRC32 := -1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipOutputStream.Read(var Buffer; Count: Integer): Longint;\nbegin\n raise EAbException.Create('TAbUnzipOutputStream.Read not supported');\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipOutputStream.Write(const Buffer; Count: Longint): Longint;\nvar\n Abort : Boolean;\n NewProgress : Byte;\nbegin\n AbUpdateCRC( FCRC32, Buffer, Count );\n\n Result := FStream.Write(Buffer, Count);\n\n Inc( FBytesWritten, Result );\n if Assigned( FOnProgress ) then begin\n Abort := False;\n NewProgress := AbPercentage(FBytesWritten, FUncompressedSize);\n if (NewProgress <> FCurrentProgress) then begin\n FOnProgress( NewProgress, Abort );\n FCurrentProgress := NewProgress;\n end;\n if Abort then\n raise EAbUserAbort.Create;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipOutputStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;\nbegin\n Result := FStream.Seek(Offset, Origin);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipOutputStream.GetCRC32: LongInt;\nbegin\n Result := not FCRC32;\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbUnzPrc.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbUnzPrc.pas *}\n{*********************************************************}\n{* ABBREVIA: UnZip procedures *}\n{*********************************************************}\n\nunit AbUnzPrc;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbArcTyp,\n AbZipTyp;\n\ntype\n TAbUnzipHelper = class( TObject )\n protected {private}\n {internal variables}\n FOutWriter : TStream;\n FOutStream : TStream;\n FUnCompressedSize : LongInt;\n FCompressionMethod : TAbZipCompressionMethod;\n FDictionarySize : TAbZipDictionarySize;\n FShannonFanoTreeCount : Byte;\n\n FOutBuf : PAbByteArray; {output buffer}\n FOutSent : LongInt; {number of bytes sent to output buffer}\n FOutPos : Cardinal; {current position in output buffer}\n FBitSValid : Byte; {Number of valid bits}\n\n FInBuf : TAbByteArray4K;\n FInPos : Integer; {current position in input buffer}\n FInCnt : Integer; {number of bytes in input buffer}\n FInEof : Boolean; {set when stream read returns 0}\n FCurByte : Byte; {current input byte}\n FBitsLeft : Byte; {bits left to process in FCurByte}\n\n FZStream : TStream;\n protected\n procedure uzFlushOutBuf;\n {-Flushes the output buffer}\n\n function uzReadBits(Bits : Byte) : Integer;\n {-Read the specified number of bits}\n procedure uzReadNextPrim;\n {-does less likely part of uzReadNext}\n\n {$IFDEF UnzipImplodeSupport}\n procedure uzUnImplode;\n {-Extract an imploded file}\n {$ENDIF}\n\n {$IFDEF UnzipReduceSupport}\n procedure uzUnReduce;\n {-Extract a reduced file}\n {$ENDIF}\n\n {$IFDEF UnzipShrinkSupport}\n procedure uzUnShrink;\n {-Extract a shrunk file}\n {$ENDIF}\n procedure uzWriteByte(B : Byte);\n {write to output}\n public\n constructor Create( InputStream, OutputStream : TStream );\n destructor Destroy;\n override;\n\n procedure Execute;\n\n property UnCompressedSize : LongInt\n read FUncompressedSize\n write FUncompressedSize;\n property CompressionMethod : TAbZipCompressionMethod\n read FCompressionMethod\n write FCompressionMethod;\n property DictionarySize : TAbZipDictionarySize\n read FDictionarySize\n write FDictionarySize;\n property ShannonFanoTreeCount : Byte\n read FShannonFanoTreeCount\n write FShannonFanoTreeCount;\n end;\n\n\n\n procedure AbUnzipToStream( Sender : TObject; Item : TAbZipItem;\n OutStream : TStream);\n\n procedure AbUnzip(Sender : TObject; Item : TAbZipItem; const UseName : string);\n\n procedure AbTestZipItem(Sender : TObject; Item : TAbZipItem);\n\n procedure InflateStream(CompressedStream, UnCompressedStream : TStream);\n {-Inflates everything in CompressedStream to UncompressedStream\n no encryption is tried, no check on CRC is done, uses the whole\n compressedstream - no Progress events - no Frills!}\n\nimplementation\n\nuses\n {$IFDEF MSWINDOWS}\n Windows,\n {$ENDIF}\n SysUtils,\n {$IFDEF UnzipBzip2Support}\n AbBzip2,\n {$ENDIF}\n {$IFDEF UnzipLzmaSupport}\n AbLzma,\n {$ENDIF}\n {$IFDEF UnzipPPMdSupport}\n AbPPMd,\n {$ENDIF}\n {$IFDEF UnzipWavPackSupport}\n AbWavPack,\n {$ENDIF}\n AbBitBkt,\n AbConst,\n AbDfBase,\n AbDfCryS,\n AbDfDec,\n AbExcept,\n AbSpanSt,\n AbSWStm,\n AbUnzOutStm,\n AbUtils;\n\n{ -------------------------------------------------------------------------- }\nprocedure AbReverseBits(var W : Word);\n {-Reverse the order of the bits in W}\nregister;\nconst\n RevTable : array[0..255] of Byte = ($00, $80, $40, $C0, $20, $A0, $60,\n $E0, $10, $90, $50, $D0, $30, $B0, $70, $F0, $08, $88, $48, $C8, $28,\n $A8, $68, $E8, $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84, $44,\n $C4, $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4, $0C,\n $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC, $3C, $BC, $7C,\n $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2, $12, $92, $52, $D2, $32,\n $B2, $72, $F2, $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, $1A, $9A, $5A,\n $DA, $3A, $BA, $7A, $FA, $06, $86, $46, $C6, $26, $A6, $66, $E6, $16,\n $96, $56, $D6, $36, $B6, $76, $F6, $0E, $8E, $4E, $CE, $2E, $AE, $6E,\n $EE, $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1, $21,\n $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1, $09, $89, $49,\n $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9, $39, $B9, $79, $F9, $05,\n $85, $45, $C5, $25, $A5, $65, $E5, $15, $95, $55, $D5, $35, $B5, $75,\n $F5, $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D,\n $BD, $7D, $FD, $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53,\n $D3, $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, $1B,\n $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7, $27, $A7, $67,\n $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7, $0F, $8F, $4F, $CF, $2F,\n $AF, $6F, $EF, $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF);\nbegin\n W := RevTable[Byte(W shr 8)] or Word(RevTable[Byte(W)] shl 8);\nend;\n\n\n{ TAbUnzipHelper implementation ============================================ }\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbUnzipHelper.Create( InputStream, OutputStream : TStream );\nbegin\n inherited Create;\n FOutBuf := AllocMem( AbBufferSize );\n FOutPos := 0; \n FZStream := InputStream;\n FOutStream := OutputStream;\n FUncompressedSize := 0;\n FDictionarySize := dsInvalid;\n FShannonFanoTreeCount := 0;\n FCompressionMethod := cmDeflated;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbUnzipHelper.Destroy;\nbegin\n FreeMem( FOutBuf, AbBufferSize ); \n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbUnzipHelper.Execute;\nbegin\n {parent class handles exceptions via OnExtractFailure}\n FBitsLeft := 0;\n FCurByte := 0;\n FInCnt := 0;\n FOutSent := 0;\n FOutPos := 0;\n FInEof := False;\n\n {set the output stream; for Imploded/Reduced files this has to be\n buffered, for all other types of compression, the code buffers the\n output data nicely and so the given output stream can be used.}\n {$IFDEF UnzipImplodeSupport}\n if (FCompressionMethod = cmImploded) then\n FOutWriter := TabSlidingWindowStream.Create(FOutStream)\n else\n {$ENDIF}\n {$IFDEF UnzipReduceSupport}\n if (FCompressionMethod >= cmReduced1) and\n (FCompressionMethod <= cmReduced4) then\n FOutWriter := TabSlidingWindowStream.Create(FOutStream)\n else\n {$ENDIF}\n FOutWriter := FOutStream;\n FInPos := 1+SizeOf(FInBuf);\n\n{ GetMem( FInBuf, SizeOf(FInBuf^) );}\n try\n {uncompress it with the appropriate method}\n case FCompressionMethod of\n {$IFDEF UnzipShrinkSupport}\n cmShrunk : uzUnshrink;\n {$ENDIF}\n {$IFDEF UnzipReduceSupport}\n cmReduced1..cmReduced4 : uzUnReduce;\n {$ENDIF}\n {$IFDEF UnzipImplodeSupport}\n cmImploded : uzUnImplode;\n {$ENDIF}\n {cmTokenized}\n {cmEnhancedDeflated}\n {cmDCLImploded}\n else\n raise EAbZipInvalidMethod.Create;\n end;\n\n finally\n uzFlushOutBuf;\n {free any memory}\n if (FOutWriter <> FOutStream) then\n FOutWriter.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbUnzipHelper.uzReadNextPrim;\nbegin\n FInCnt := FZStream.Read( FInBuf, sizeof( FInBuf ) );\n FInEof := FInCnt = 0;\n {load first byte in buffer and set position counter}\n FCurByte := FInBuf[1];\n FInPos := 2;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbUnzipHelper.uzFlushOutBuf;\n {-flushes the output buffer}\nbegin\n if (FOutPos <> 0) then begin\n FOutWriter.Write( FOutBuf^, FOutPos );\n Inc( FOutSent, FOutPos );\n FOutPos := 0;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbUnzipHelper.uzWriteByte(B : Byte);\n {-Write one byte to the output buffer}\nbegin\n FOutBuf^[FOutPos] := B;\n inc(FOutPos);\n if (FOutPos = AbBufferSize) or\n (LongInt(FOutPos) + FOutSent = FUncompressedSize) then\n uzFlushOutBuf;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbUnzipHelper.uzReadBits(Bits : Byte) : Integer;\n {-Read the specified number of bits}\nvar\n SaveCurByte, Delta, SaveBitsLeft : Byte;\nbegin\n {read next byte if we're out of bits}\n if FBitsLeft = 0 then begin\n {do we still have a byte buffered?}\n if FInPos <= FInCnt then begin\n {get next byte out of buffer and advance position counter}\n FCurByte := FInBuf[FInPos];\n Inc(FInPos);\n end\n {are there any left to read?}\n else\n uzReadNextPrim;\n\n FBitsLeft := 8;\n end;\n if ( Bits < FBitsLeft ) then begin\n Dec( FBitsLeft, Bits );\n Result := ((1 shl Bits) - 1) and FCurByte;\n FCurByte := FCurByte shr Bits;\n end\n else if ( Bits = FBitsLeft ) then begin\n Result := FCurByte;\n FCurByte := 0;\n FBitsLeft := 0;\n end\n else begin\n SaveCurByte := FCurByte;\n SaveBitsLeft := FBitsLeft;\n {number of additional bits that we need}\n Delta := Bits - FBitsLeft;\n {do we still have a byte buffered?}\n if FInPos <= FInCnt then begin\n {get next byte out of buffer and advance position counter}\n FCurByte := FInBuf[FInPos];\n Inc(FInPos);\n end\n {are there any left to read?}\n else\n uzReadNextPrim;\n\n FBitsLeft := 8;\n Result := ( uzReadBits( Delta ) shl SaveBitsLeft ) or SaveCurByte;\n end;\nend;\n{$IFDEF UnzipImplodeSupport}\n{ -------------------------------------------------------------------------- }\nprocedure TAbUnzipHelper.uzUnImplode;\n {-Extract an imploded file}\nconst\n szLengthTree = SizeOf(TAbSfTree)-(192*SizeOf(TAbSfEntry));\n szDistanceTree = SizeOf(TAbSfTree)-(192*SizeOf(TAbSfEntry));\n szLitTree = SizeOf(TAbSfTree);\nvar\n Length : Integer;\n DIndex : LongInt;\n Distance : Integer;\n SPos : LongInt;\n MyByte : Byte;\n DictBits : Integer; {number of bits used in sliding dictionary}\n MinMatchLength : Integer; {minimum match length}\n LitTree : PAbSfTree; {Literal tree}\n LengthTree : PAbSfTree; {Length tree}\n DistanceTree : PAbSfTree; {Distance tree}\n\n procedure uzLoadTree(var T; TreeSize : Integer);\n {-Load one Shannon-Fano tree}\n var\n I : Word;\n Tree : TAbSfTree absolute T;\n\n procedure GenerateTree;\n {-Generate a Shannon-Fano tree}\n var\n C : Word;\n CodeIncrement : Integer;\n LastBitLength : Integer;\n I : Integer;\n begin\n C := 0;\n CodeIncrement := 0;\n LastBitLength := 0;\n\n for I := Tree.Entries-1 downto 0 do\n with Tree.Entry[I] do begin\n Inc(C, CodeIncrement);\n if BitLength <> LastBitLength then begin\n LastBitLength := BitLength;\n CodeIncrement := 1 shl (16-LastBitLength);\n end;\n Code := C;\n end;\n end;\n\n procedure SortLengths;\n {-Sort the bit lengths in ascending order, while retaining the order\n of the original lengths stored in the file}\n var\n XL : Integer;\n XGL : Integer;\n TXP : PAbSfEntry;\n TXGP : PAbSfEntry;\n X, Gap : Integer;\n Done : Boolean;\n LT : LongInt;\n begin\n Gap := Tree.Entries shr 1;\n repeat\n repeat\n Done := True;\n for X := 0 to (Tree.Entries-1)-Gap do begin\n TXP := @Tree.Entry[X];\n TXGP := @Tree.Entry[X+Gap];\n XL := TXP^.BitLength;\n XGL := TXGP^.BitLength;\n if (XL > XGL) or\n ((XL = XGL) and (TXP^.Value > TXGP^.Value)) then begin\n LT := TXP^.L;\n TXP^.L := TXGP^.L;\n TXGP^.L := LT;\n Done := False;\n end;\n end;\n until Done;\n\n Gap := Gap shr 1;\n until (Gap = 0);\n end;\n\n procedure uzReadLengths;\n {-Read bit lengths for a tree}\n var\n TreeBytes : Integer;\n I, J, K : Integer;\n Num, Len : Integer;\n B : Byte;\n begin\n {get number of bytes in compressed tree}\n TreeBytes := uzReadBits(8)+1;\n\n I := 0;\n Tree.MaxLength := 0;\n\n {High nibble: Number of values at this bit length + 1.\n Low nibble: Bits needed to represent value + 1}\n for J := 1 to TreeBytes do begin\n B := uzReadBits(8);\n Len := (B and $0F)+1;\n Num := (B shr 4)+1;\n\n for K := I to I+Num-1 do\n with Tree, Entry[K] do begin\n if Len > MaxLength then\n MaxLength := Len;\n BitLength := Len;\n Value := K;\n end;\n Inc(I, Num);\n end;\n end;\n\n begin\n Tree.Entries := TreeSize;\n uzReadLengths;\n SortLengths;\n GenerateTree;\n for I := 0 to TreeSize-1 do\n AbReverseBits(Tree.Entry[I].Code);\n end;\n\n function uzReadTree(var T) : Byte;\n {-Read next byte using a Shannon-Fano tree}\n var\n Bits : Integer;\n CV : Word;\n E : Integer;\n Cur : Integer;\n var\n Tree : TAbSfTree absolute T;\n begin\n Result := 0;\n Bits := 0;\n CV := 0;\n Cur := 0;\n E := Tree.Entries;\n repeat\n CV := CV or (uzReadBits(1) shl Bits);\n Inc(Bits);\n while Tree.Entry[Cur].BitLength < Bits do begin\n Inc(Cur);\n if Cur >= E then\n Exit;\n end;\n while Tree.Entry[Cur].BitLength = Bits do begin\n if Tree.Entry[Cur].Code = CV then begin\n Result := Tree.Entry[Cur].Value;\n Exit;\n end;\n Inc(Cur);\n if Cur >= E then\n Exit;\n end;\n until False;\n end;\n\nbegin\n {do we have an 8K dictionary?}\n if FDictionarySize = ds8K then\n DictBits := 7\n else\n DictBits := 6;\n\n {allocate trees}\n LengthTree := AllocMem(szLengthTree);\n DistanceTree := AllocMem(szDistanceTree);\n LitTree := nil;\n try\n {do we have a Literal tree?}\n MinMatchLength := FShannonFanoTreeCount;\n if MinMatchLength = 3 then begin\n LitTree := AllocMem(szLitTree);\n uzLoadTree(LitTree^, 256);\n end;\n\n {load the other two trees}\n uzLoadTree(LengthTree^, 64);\n uzLoadTree(DistanceTree^, 64);\n\n while (not FInEof) and (FOutSent + LongInt(FOutPos) < FUncompressedSize) do\n {is data literal?}\n if Boolean(uzReadBits(1)) then begin\n {if MinMatchLength = 3 then we have a Literal tree}\n if (MinMatchLength = 3) then\n uzWriteByte( uzReadTree(LitTree^) )\n else\n uzWriteByte( uzReadBits(8) );\n end\n else begin\n {data is a sliding dictionary}\n Distance := uzReadBits(DictBits);\n\n {using the Distance Shannon-Fano tree, read and decode the\n upper 6 bits of the Distance value}\n Distance := Distance or (uzReadTree(DistanceTree^) shl DictBits);\n\n {using the Length Shannon-Fano tree, read and decode the Length value}\n Length := uzReadTree(LengthTree^);\n if Length = 63 then\n Inc(Length, uzReadBits(8));\n Inc(Length, MinMatchLength);\n\n {move backwards Distance+1 bytes in the output stream, and copy\n Length characters from this position to the output stream.\n (if this position is before the start of the output stream,\n then assume that all the data before the start of the output\n stream is filled with zeros)}\n DIndex := (FOutSent + LongInt(FOutPos))-(Distance+1);\n while Length > 0 do begin\n if DIndex < 0 then\n uzWriteByte(0)\n else begin\n uzFlushOutBuf;\n SPos := FOutWriter.Position;\n FOutWriter.Position := DIndex;\n FOutWriter.Read( MyByte, 1 );\n FOutWriter.Position := SPos;\n uzWriteByte(MyByte);\n end;\n Inc(DIndex);\n Dec(Length);\n end;\n end;\n finally\n if (LitTree <> nil) then\n FreeMem(LitTree, szLitTree);\n FreeMem(LengthTree, szLengthTree);\n FreeMem(DistanceTree, szDistanceTree);\n end;\nend;\n{$ENDIF UnzipImplodeSupport}\n{ -------------------------------------------------------------------------- }\n{$IFDEF UnzipReduceSupport}\nprocedure TAbUnzipHelper.uzUnReduce;\nconst\n FactorMasks : array[1..4] of Byte = ($7F, $3F, $1F, $0F);\n DLE = 144;\nvar\n C, Last : Byte;\n OpI : LongInt;\n I, J, Sz : Integer;\n D : Word;\n SPos : LongInt;\n MyByte : Byte;\n Factor : Byte; {reduction Factor}\n FactorMask : Byte; {bit mask to use based on Factor}\n Followers : PAbFollowerSets; {array of follower sets}\n State : Integer; {used while processing reduced files}\n V : Integer; {\"}\n Len : Integer; {\"}\n\n function BitsNeeded( i : Byte ) : Word;\n begin\n dec( i );\n Result := 0;\n repeat\n inc( Result );\n i := i shr 1;\n until i = 0;\n end;\n\nbegin\n GetMem(Followers, SizeOf(TAbFollowerSets));\n try\n Factor := Ord( FCompressionMethod ) - 1;\n FactorMask := FactorMasks[Factor];\n State := 0;\n C := 0;\n V := 0;\n Len := 0;\n D := 0;\n\n {load follower sets}\n for I := 255 downto 0 do begin\n Sz := uzReadBits(6);\n Followers^[I].Size := Sz;\n Dec(Sz);\n for J := 0 to Sz do\n Followers^[I].FSet[J] := uzReadBits(8);\n end;\n\n while (not FInEof) and ((FOutSent + LongInt(FOutPos)) < FUncompressedSize) do begin\n Last := C;\n with Followers^[Last] do\n if Size = 0 then\n C := uzReadBits(8)\n else begin\n C := uzReadBits(1);\n if C <> 0 then\n C := uzReadBits(8)\n else\n C := FSet[uzReadBits(BitsNeeded(Size))];\n end;\n\n if FInEof then\n Exit;\n\n case State of\n 0 :\n if C <> DLE then\n uzWriteByte(C)\n else\n State := 1;\n 1 :\n if C <> 0 then begin\n V := C;\n Len := V and FactorMask;\n if Len = FactorMask then\n State := 2\n else\n State := 3;\n end\n else begin\n uzWriteByte(DLE);\n State := 0;\n end;\n\n 2 :\n begin\n Inc(Len, C);\n State := 3;\n end;\n\n 3 :\n begin\n case Factor of\n 1 : D := (V shr 7) and $01;\n 2 : D := (V shr 6) and $03;\n 3 : D := (V shr 5) and $07;\n 4 : D := (V shr 4) and $0f;\n else\n raise EAbZipInvalidFactor.Create;\n end;\n {Delphi raises compiler Hints here, saying D might\n be undefined... If Factor is not in [1..4], the\n exception gets raised, and we never execute the following\n line}\n OpI := (FOutSent + LongInt(FOutPos))-(Swap(D)+C+1);\n\n for I := 0 to Len+2 do begin\n if OpI < 0 then\n uzWriteByte(0)\n else if OpI >= FOutSent then\n uzWriteByte(FOutBuf[OpI - FOutSent])\n else begin\n SPos := FOutWriter.Position;\n FOutWriter.Position := OpI;\n FOutWriter.Read( MyByte, 1 );\n FOutWriter.Position := SPos;\n uzWriteByte(MyByte);\n end;\n Inc(OpI);\n end;\n\n State := 0;\n end;\n end;\n end;\n finally\n FreeMem(Followers, SizeOf(Followers^));\n end;\nend;\n{$ENDIF UnzipReduceSupport}\n{ -------------------------------------------------------------------------- }\n{$IFDEF UnzipShrinkSupport}\nprocedure TAbUnzipHelper.uzUnShrink;\n {-Extract a file that was shrunk}\nconst\n MaxBits = 13;\n InitBits = 9;\n FirstFree = 257;\n Clear = 256;\n MaxCodeMax = 8192; {= 1 shl MaxBits}\n Unused = -1;\nvar\n CodeSize : SmallInt;\n NextFree : SmallInt;\n BaseChar : SmallInt;\n NewCode : SmallInt;\n OldCode : SmallInt;\n SaveCode : SmallInt;\n N, R : SmallInt;\n I : Integer;\n PrefixTable : PAbIntArray8K; {used while processing shrunk files}\n SuffixTable : PAbByteArray8K; {\"}\n Stack : PAbByteArray8K; {\"}\n StackIndex : Integer; {\"}\nbegin\n CodeSize := InitBits;\n{ MaxCode := (1 shl InitBits)-1;}\n NextFree := FirstFree;\n\n PrefixTable := nil;\n SuffixTable := nil;\n Stack := nil;\n\n try\n GetMem(PrefixTable, SizeOf(PrefixTable^));\n SuffixTable := AllocMem(SizeOf(SuffixTable^));\n GetMem(Stack, SizeOf(Stack^));\n\n FillChar(PrefixTable^, SizeOf(PrefixTable^), $FF);\n for NewCode := 255 downto 0 do begin\n PrefixTable^[NewCode] := 0;\n SuffixTable^[NewCode] := NewCode;\n end;\n\n OldCode := uzReadBits(CodeSize);\n if FInEof then\n Exit;\n BaseChar := OldCode;\n\n uzWriteByte(BaseChar);\n\n StackIndex := 0;\n while (not FInEof) do begin\n NewCode := uzReadBits(CodeSize);\n while (NewCode = Clear) and (not FInEof) do begin\n case uzReadBits(CodeSize) of\n 1 : begin\n Inc(CodeSize);\n end;\n 2 : begin\n {mark all nodes as potentially unused}\n for I := FirstFree to pred( NextFree ) do\n PrefixTable^[I] := PrefixTable^[I] or LongInt($8000);\n\n {unmark those used by other nodes}\n for N := FirstFree to NextFree-1 do begin\n {reference to another node?}\n R := PrefixTable^[N] and $7FFF;\n {flag node as referenced}\n if R >= FirstFree then\n PrefixTable^[R] := PrefixTable^[R] and $7FFF;\n end;\n\n {clear the ones that are still marked}\n for I := FirstFree to pred( NextFree ) do\n if PrefixTable^[I] < 0 then\n PrefixTable^[I] := -1;\n\n {recalculate NextFree}\n NextFree := FirstFree;\n while (NextFree < MaxCodeMax) and\n (PrefixTable^[NextFree] <> -1) do\n Inc(NextFree);\n end;\n end;\n\n NewCode := uzReadBits(CodeSize);\n end;\n\n if FInEof then\n Exit;\n\n {save current code}\n SaveCode := NewCode;\n\n {special case}\n if PrefixTable^[NewCode] = Unused then begin\n Stack^[StackIndex] := BaseChar;\n Inc(StackIndex);\n NewCode := OldCode;\n end;\n\n {generate output characters in reverse order}\n while (NewCode >= FirstFree) do begin\n if PrefixTable^[NewCode] = Unused then begin\n Stack^[StackIndex] := BaseChar;\n Inc(StackIndex);\n NewCode := OldCode;\n end else begin\n Stack^[StackIndex] := SuffixTable^[NewCode];\n Inc(StackIndex);\n NewCode := PrefixTable^[NewCode];\n end;\n end;\n\n BaseChar := SuffixTable^[NewCode];\n uzWriteByte(BaseChar);\n\n {put them out in forward order}\n while (StackIndex > 0) do begin\n Dec(StackIndex);\n uzWriteByte(Stack^[StackIndex]);\n end;\n\n {add new entry to tables}\n NewCode := NextFree;\n if NewCode < MaxCodeMax then begin\n PrefixTable^[NewCode] := OldCode;\n SuffixTable^[NewCode] := BaseChar;\n while (NextFree < MaxCodeMax) and\n (PrefixTable^[NextFree] <> Unused) do\n Inc(NextFree);\n end;\n\n {remember previous code}\n OldCode := SaveCode;\n end;\n finally\n FreeMem(PrefixTable, SizeOf(PrefixTable^));\n FreeMem(SuffixTable, SizeOf(SuffixTable^));\n FreeMem(Stack, SizeOf(Stack^));\n end;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure RequestPassword(Archive : TAbZipArchive; var Abort : Boolean);\nvar\n APassPhrase : AnsiString;\nbegin\n APassPhrase := Archive.Password;\n Abort := False;\n if Assigned(Archive.OnNeedPassword) then begin\n Archive.OnNeedPassword(Archive, APassPhrase);\n if APassPhrase = '' then\n Abort := True\n else\n Archive.Password := APassPhrase;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure CheckPassword(Archive : TAbZipArchive; var Tries : Integer; var Abort : Boolean);\nbegin\n { if current password empty }\n if Archive.Password = '' then begin\n { request password }\n RequestPassword(Archive, Abort);\n { increment tries }\n Inc(Tries);\n end;\n\n { if current password still empty }\n if Archive.Password = '' then begin\n { abort }\n raise EAbZipInvalidPassword.Create;\n end;\nend;\n\n\n{ -------------------------------------------------------------------------- }\nprocedure DoInflate(Archive : TAbZipArchive; Item : TAbZipItem; InStream, OutStream : TStream);\nvar\n Hlpr : TAbDeflateHelper;\nbegin\n Hlpr := TAbDeflateHelper.Create;\n try\n if Item.CompressionMethod = cmEnhancedDeflated then\n Hlpr.Options := Hlpr.Options or dfc_UseDeflate64;\n\n Hlpr.StreamSize := Item.CompressedSize;\n\n Inflate(InStream, OutStream, Hlpr);\n finally\n Hlpr.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure DoLegacyUnzip(Archive : TAbZipArchive; Item : TAbZipItem; InStream, OutStream : TStream);\nvar\n Helper : TAbUnzipHelper;\nbegin\n Helper := TAbUnzipHelper.Create(InStream, OutStream);\n try {Helper}\n Helper.DictionarySize := Item.DictionarySize;\n Helper.UnCompressedSize := Item.UncompressedSize;\n Helper.CompressionMethod := Item.CompressionMethod;\n Helper.ShannonFanoTreeCount := Item.ShannonFanoTreeCount;\n Helper.Execute;\n finally\n Helper.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF UnzipBzip2Support}\nprocedure DoExtractBzip2(Archive : TAbZipArchive; Item : TAbZipItem; InStream, OutStream : TStream);\nvar\n Bzip2Stream: TStream;\nbegin\n Bzip2Stream := TBZDecompressionStream.Create(InStream);\n try\n OutStream.CopyFrom(Bzip2Stream, Item.UncompressedSize);\n finally\n Bzip2Stream.Free;\n end;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\n{$IFDEF UnzipLzmaSupport}\nprocedure DoExtractLzma(Archive : TAbZipArchive; Item : TAbZipItem;\n InStream, OutStream : TStream);\nvar\n Header: packed record\n MajorVer, MinorVer: Byte;\n PropSize: Word;\n end;\n Properties: array of Byte;\nbegin\n InStream.ReadBuffer(Header, SizeOf(Header));\n SetLength(Properties, Header.PropSize);\n InStream.ReadBuffer(Properties[0], Header.PropSize);\n LzmaDecodeStream(PByte(Properties), Header.PropSize, InStream, OutStream,\n Item.UncompressedSize);\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nfunction ExtractPrep(ZipArchive: TAbZipArchive; Item: TAbZipItem): TStream;\nvar\n LFH : TAbZipLocalFileHeader;\n Abort : Boolean;\n Tries : Integer;\n CheckValue : LongInt;\n DecryptStream: TAbDfDecryptStream;\nbegin\n { validate }\n if (Lo(Item.VersionNeededToExtract) > Ab_ZipVersion) then\n raise EAbZipVersion.Create;\n\n { seek to compressed file }\n if ZipArchive.FStream is TAbSpanReadStream then\n TAbSpanReadStream(ZipArchive.FStream).SeekImage(Item.DiskNumberStart,\n Item.RelativeOffset)\n else\n ZipArchive.FStream.Position := Item.RelativeOffset;\n\n { get local header info for Item}\n LFH := TAbZipLocalFileHeader.Create;\n try\n { select appropriate CRC value based on General Purpose Bit Flag }\n { also get whether the file is stored, while we've got the local file header }\n LFH.LoadFromStream(ZipArchive.FStream);\n if (LFH.GeneralPurposeBitFlag and AbHasDataDescriptorFlag = AbHasDataDescriptorFlag) then\n { if bit 3 is set, then the data descriptor record is appended\n to the compressed data }\n CheckValue := LFH.LastModFileTime shl $10\n else\n CheckValue := Item.CRC32;\n finally\n LFH.Free;\n end;\n\n Result := TAbUnzipSubsetStream.Create(ZipArchive.FStream,\n Item.CompressedSize);\n\n { get decrypting stream }\n if Item.IsEncrypted then begin\n try\n { need to decrypt }\n Tries := 0;\n Abort := False;\n CheckPassword(ZipArchive, Tries, Abort);\n while True do begin\n if Abort then\n raise EAbUserAbort.Create;\n { check for valid password }\n DecryptStream := TAbDfDecryptStream.Create(Result,\n CheckValue, ZipArchive.Password);\n if DecryptStream.IsValid then begin\n DecryptStream.OwnsStream := True;\n Result := DecryptStream;\n Break;\n end;\n FreeAndNil(DecryptStream);\n { prompt again }\n Inc(Tries);\n if (Tries > ZipArchive.PasswordRetries) then\n raise EAbZipInvalidPassword.Create;\n RequestPassword(ZipArchive, Abort);\n end;\n except\n Result.Free;\n raise;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure DoExtract(aZipArchive: TAbZipArchive; aItem: TAbZipItem;\n aInStream, aOutStream: TStream);\nvar\n OutStream : TAbUnzipOutputStream;\nbegin\n if aItem.UncompressedSize = 0 then\n Exit;\n\n OutStream := TAbUnzipOutputStream.Create(aOutStream);\n try\n OutStream.UncompressedSize := aItem.UncompressedSize;\n OutStream.OnProgress := aZipArchive.OnProgress;\n\n { determine storage type }\n case aItem.CompressionMethod of\n cmStored: begin\n { unstore aItem }\n OutStream.CopyFrom(aInStream, aItem.UncompressedSize);\n end;\n cmDeflated, cmEnhancedDeflated: begin\n { inflate aItem }\n DoInflate(aZipArchive, aItem, aInStream, OutStream);\n end;\n {$IFDEF UnzipBzip2Support}\n cmBzip2: begin\n DoExtractBzip2(aZipArchive, aItem, aInStream, OutStream);\n end;\n {$ENDIF}\n {$IFDEF UnzipLzmaSupport}\n cmLZMA: begin\n DoExtractLzma(aZipArchive, aItem, aInStream, OutStream);\n end;\n {$ENDIF}\n {$IFDEF UnzipPPMdSupport}\n cmPPMd: begin\n DecompressPPMd(aInStream, OutStream);\n end;\n {$ENDIF}\n {$IFDEF UnzipWavPackSupport}\n cmWavPack: begin\n DecompressWavPack(aInStream, OutStream);\n end;\n {$ENDIF}\n cmShrunk..cmImploded: begin\n DoLegacyUnzip(aZipArchive, aItem, aInStream, OutStream);\n end;\n else\n raise EAbZipInvalidMethod.Create;\n end;\n\n { check CRC }\n if OutStream.CRC32 <> aItem.CRC32 then\n if Assigned(aZipArchive.OnProcessItemFailure) then\n aZipArchive.OnProcessItemFailure(aZipArchive, aItem, ptExtract,\n ecAbbrevia, AbZipBadCRC)\n else\n raise EAbZipBadCRC.Create;\n finally\n OutStream.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbUnzipToStream( Sender : TObject; Item : TAbZipItem; OutStream : TStream);\nvar\n ZipArchive : TAbZipArchive;\n InStream : TStream;\nbegin\n ZipArchive := Sender as TAbZipArchive;\n if not Assigned(OutStream) then\n raise EAbBadStream.Create;\n\n InStream := ExtractPrep(ZipArchive, Item);\n try\n DoExtract(ZipArchive, Item, InStream, OutStream);\n finally\n InStream.Free\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbUnzip(Sender : TObject; Item : TAbZipItem; const UseName : string);\n {create the output filestream and pass it to DoExtract}\nvar\n InStream, OutStream : TStream;\n ZipArchive : TAbZipArchive;\nbegin\n ZipArchive := TAbZipArchive(Sender);\n\n if Item.IsDirectory then\n AbCreateDirectory(UseName)\n else begin\n InStream := ExtractPrep(ZipArchive, Item);\n try\n OutStream := TFileStream.Create(UseName, fmCreate or fmShareDenyWrite);\n try\n try {OutStream}\n DoExtract(ZipArchive, Item, InStream, OutStream);\n finally {OutStream}\n OutStream.Free;\n end; {OutStream}\n except\n if ExceptObject is EAbUserAbort then\n ZipArchive.FStatus := asInvalid;\n DeleteFile(UseName);\n raise;\n end;\n finally\n InStream.Free\n end;\n end;\n\n AbSetFileTime(UseName, Item.LastModTimeAsDateTime);\n AbSetFileAttr(UseName, Item.NativeFileAttributes);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbTestZipItem(Sender : TObject; Item : TAbZipItem);\n {extract item to bit bucket and verify its local file header}\nvar\n BitBucket : TAbBitBucketStream;\n FieldSize : Word;\n LFH : TAbZipLocalFileHeader;\n Zip64Field : PZip64LocalHeaderRec;\n ZipArchive : TAbZipArchive;\nbegin\n ZipArchive := TAbZipArchive(Sender);\n\n if (Lo(Item.VersionNeededToExtract) > Ab_ZipVersion) then\n raise EAbZipVersion.Create;\n\n { seek to compressed file }\n if ZipArchive.FStream is TAbSpanReadStream then\n TAbSpanReadStream(ZipArchive.FStream).SeekImage(Item.DiskNumberStart,\n Item.RelativeOffset)\n else\n ZipArchive.FStream.Position := Item.RelativeOffset;\n\n BitBucket := nil;\n LFH := nil;\n try\n BitBucket := TAbBitBucketStream.Create(0);\n LFH := TAbZipLocalFileHeader.Create;\n {get the item's local file header}\n ZipArchive.FStream.Seek(Item.RelativeOffset, soBeginning);\n LFH.LoadFromStream(ZipArchive.FStream);\n ZipArchive.FStream.Seek(Item.RelativeOffset, soBeginning);\n\n {currently a single exception is raised for any LFH error}\n if (LFH.VersionNeededToExtract <> Item.VersionNeededToExtract) then\n raise EAbZipInvalidLFH.Create;\n if (LFH.GeneralPurposeBitFlag <> Item.GeneralPurposeBitFlag) then\n raise EAbZipInvalidLFH.Create;\n if (LFH.LastModFileTime <> Item.LastModFileTime) then\n raise EAbZipInvalidLFH.Create;\n if (LFH.LastModFileDate <> Item.LastModFileDate) then\n raise EAbZipInvalidLFH.Create;\n if (LFH.CRC32 <> Item.CRC32) then\n raise EAbZipInvalidLFH.Create;\n if LFH.ExtraField.Get(Ab_Zip64SubfieldID, Pointer(Zip64Field), FieldSize) then begin\n if (Zip64Field.CompressedSize <> Item.CompressedSize) then\n raise EAbZipInvalidLFH.Create;\n if (Zip64Field.UncompressedSize <> Item.UncompressedSize) then\n raise EAbZipInvalidLFH.Create;\n end\n else begin\n if (LFH.CompressedSize <> Item.CompressedSize) then\n raise EAbZipInvalidLFH.Create;\n if (LFH.UncompressedSize <> Item.UncompressedSize) then\n raise EAbZipInvalidLFH.Create;\n end;\n if (LFH.FileName <> Item.RawFileName) then\n raise EAbZipInvalidLFH.Create;\n\n {any CRC errors will raise exception during extraction}\n AbUnZipToStream(Sender, Item, BitBucket);\n finally\n BitBucket.Free;\n LFH.Free;\n end;\n\nend;\n{ -------------------------------------------------------------------------- }\nprocedure InflateStream( CompressedStream, UnCompressedStream : TStream );\n {-Inflates everything in CompressedStream to UncompressedStream\n no encryption is tried, no check on CRC is done, uses the whole\n compressedstream - no Progress events - no Frills!}\nbegin\n Inflate(CompressedStream, UncompressedStream, nil);\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbUnzper.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: ABUnzper.pas *}\n{*********************************************************}\n{* ABBREVIA: Non-visual Component with UnZip support *}\n{*********************************************************}\n\nunit AbUnzper;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbZBrows, AbArcTyp, AbZipTyp;\n\ntype\n TAbCustomUnZipper = class(TAbCustomZipBrowser)\n protected {private}\n FExtractOptions : TAbExtractOptions;\n FOnConfirmOverwrite : TAbConfirmOverwriteEvent;\n FOnNeedPassword : TAbNeedPasswordEvent;\n FPasswordRetries : Byte;\n\n protected {methods}\n procedure DoConfirmOverwrite(var Name : string;\n var Confirm : Boolean);\n virtual;\n procedure DoNeedPassword(Sender : TObject;\n var NewPassword : AnsiString);\n virtual;\n procedure InitArchive; override;\n procedure SetExtractOptions(Value : TAbExtractOptions);\n procedure SetPasswordRetries(Value : Byte);\n procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem;\n const NewName : string );\n procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\n procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem);\n\n procedure SetFileName(const aFileName : string);\n override;\n\n protected {properties}\n property ExtractOptions : TAbExtractOptions\n read FExtractOptions\n write SetExtractOptions\n default AbDefExtractOptions;\n property OnConfirmOverwrite : TAbConfirmOverwriteEvent\n read FOnConfirmOverwrite\n write FOnConfirmOverwrite;\n property OnNeedPassword : TAbNeedPasswordEvent\n read FOnNeedPassword\n write FOnNeedPassword;\n property PasswordRetries : Byte\n read FPasswordRetries\n write SetPasswordRetries\n default AbDefPasswordRetries;\n\n public {methods}\n constructor Create( AOwner : TComponent );\n override;\n destructor Destroy;\n override;\n procedure ExtractAt(Index : Integer; const NewName : string);\n procedure ExtractFiles(const FileMask : string);\n procedure ExtractFilesEx(const FileMask, ExclusionMask : string);\n procedure ExtractToStream(const aFileName : string; ToStream : TStream);\n procedure ExtractTaggedItems;\n procedure TestTaggedItems;\n end;\n\n TAbUnZipper = class(TAbCustomUnZipper)\n published\n property ArchiveProgressMeter;\n property ItemProgressMeter;\n property BaseDirectory;\n property ExtractOptions;\n property LogFile;\n property Logging;\n property OnArchiveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmOverwrite;\n property OnConfirmProcessItem;\n property OnLoad;\n property OnNeedPassword;\n property OnRequestImage;\n property OnProcessItemFailure;\n property OnRequestLastDisk;\n property OnRequestNthDisk;\n property Password;\n property PasswordRetries;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad} \n end;\n\n\nimplementation\n\nuses\n SysUtils,\n AbUtils,\n AbExcept,\n AbUnzPrc;\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbCustomUnZipper.Create( AOwner : TComponent );\nbegin\n inherited Create(AOwner);\n ExtractOptions := AbDefExtractOptions;\n PasswordRetries := AbDefPasswordRetries;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomUnZipper.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.DoConfirmOverwrite(var Name : string;\n var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmOverwrite) then\n FOnConfirmOverwrite( Name, Confirm );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.DoNeedPassword(Sender : TObject;\n var NewPassword : AnsiString);\nbegin\n if Assigned(FOnNeedPassword) then begin\n FOnNeedPassword(Self, NewPassword);\n Password := NewPassword;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.ExtractAt(Index : Integer; const NewName : string);\n {extract a file from the archive that match the index}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractAt(Index, NewName)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.ExtractFiles(const FileMask : string);\n {extract all files from the archive that match the mask}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractFiles( FileMask )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.ExtractFilesEx(const FileMask, ExclusionMask : string);\n {extract files matching FileMask except those matching ExclusionMask}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractFilesEx(FileMask, ExclusionMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.ExtractToStream(const aFileName : string;\n ToStream : TStream);\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractToStream(aFileName, ToStream)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.ExtractTaggedItems;\n {extract all tagged items from the archive}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.InitArchive;\nbegin\n inherited InitArchive;\n if FArchive <> nil then begin\n\tFArchive.ExtractOptions := FExtractOptions;\n\tFArchive.OnConfirmOverwrite := DoConfirmOverwrite;\n end;\n if FArchive is TAbZipArchive then begin\n\tTAbZipArchive(FArchive).PasswordRetries := FPasswordRetries;\n\tTAbZipArchive(FArchive).OnNeedPassword := DoNeedPassword;\n\tTAbZipArchive(FArchive).TestHelper := TestItemProc;\n\tTAbZipArchive(FArchive).ExtractHelper := UnzipProc;\n\tTAbZipArchive(FArchive).ExtractToStreamHelper := UnzipToStreamProc;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.SetExtractOptions(Value : TAbExtractOptions);\nbegin\n FExtractOptions := Value;\n if (FArchive <> nil) then\n\tFArchive.ExtractOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.SetPasswordRetries(Value : Byte);\nbegin\n FPasswordRetries := Value;\n if FArchive is TAbZipArchive then\n\tTAbZipArchive(FArchive).PasswordRetries := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.TestTaggedItems;\n {Test specified items}\nbegin\n if (FArchive <> nil) then\n\tFArchive.TestTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.UnzipProc(Sender : TObject;\n Item : TAbArchiveItem;\n const NewName : string);\nbegin\n AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.UnzipToStreamProc(Sender : TObject;\n Item : TAbArchiveItem;\n OutStream : TStream);\nbegin\n AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomUnZipper.TestItemProc(Sender : TObject;\n Item : TAbArchiveItem);\nbegin\n AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item));\nend;\n{ -------------------------------------------------------------------------- }\n\nprocedure TAbCustomUnZipper.SetFileName(const aFileName: string);\nbegin\n if aFileName <> '' then\n begin\n if not FileExists(aFileName) then\n raise EAbFileNotFound.Create;\n if AbFileGetSize(aFileName) <= 0 then\n raise EAbBadStream.Create;\n end;\n\n inherited SetFileName(aFileName);\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbUtils.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbUtils.pas *}\n{*********************************************************}\n{* ABBREVIA: Utility classes and routines *}\n{*********************************************************}\n\nunit AbUtils;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n{$IFDEF FPCUnixAPI}\n baseunix,\n {$IFDEF Linux}\n initc,\n {$ENDIF}\n unix,\n{$ENDIF}\n{$IFDEF PosixAPI}\n Posix.SysStatvfs,\n Posix.SysStat,\n Posix.Utime,\n Posix.Base,\n Posix.Unistd,\n Posix.Fcntl,\n Posix.SysTypes,\n{$ENDIF}\n{$IFDEF UNIX}\n DateUtils,\n{$ENDIF}\n{$IFDEF HasAnsiStrings}\n System.AnsiStrings,\n{$ENDIF}\n SysUtils,\n Classes,\n AbCharset;\n\n\ntype\n {describe the pending action for an archive item}\n TAbArchiveAction =\n (aaFailed, aaNone, aaAdd, aaDelete, aaFreshen, aaMove, aaReplace,\n aaStreamAdd);\n TAbProcessType =\n (ptAdd, ptDelete, ptExtract, ptFreshen, ptMove, ptReplace, ptFoundUnhandled);\n TAbLogType =\n (ltAdd, ltDelete, ltExtract, ltFreshen, ltMove, ltReplace, ltStart, ltFoundUnhandled);\n TAbErrorClass =\n (ecAbbrevia, ecInOutError, ecFilerError, ecFileCreateError,\n ecFileOpenError, ecCabError, ecOther);\n\nconst\n AbPathDelim = PathDelim; { Delphi/Linux constant }\n AbPathSep = PathSep; { Delphi/Linux constant }\n AbDosPathDelim = '\\';\n AbUnixPathDelim = '/';\n AbDosPathSep = ';';\n AbUnixPathSep = ':';\n AbDosAnyFile = '*.*';\n AbUnixAnyFile = '*';\n AbAnyFile = {$IFDEF UNIX} AbUnixAnyFile; {$ELSE} AbDosAnyFile; {$ENDIF}\n AbThisDir = '.';\n AbParentDir = '..';\n\ntype\n TAbArchiveType = (atUnknown, atZip, atSpannedZip, atSelfExtZip,\n atTar, atGzip, atGzippedTar, atCab, atBzip2, atBzippedTar);\n\n\n{$IF NOT DECLARED(DWORD)}\ntype\n DWORD = LongWord;\n{$IFEND}\n\n{$IF NOT DECLARED(PtrInt)}\ntype\n // Delphi 7-2007 declared NativeInt incorrectly\n {$IFDEF CPU386}\n PtrInt = LongInt;\n PtrUInt = LongWord;\n {$ELSE}\n PtrInt = NativeInt;\n PtrUInt = NativeUInt;\n {$ENDIF}\n{$IFEND}\n\n{ System-encoded SBCS string (formerly AnsiString) }\ntype\n AbSysString = {$IFDEF Posix}UTF8String{$ELSE}AnsiString{$ENDIF};\n\nconst\n AbCrc32Table : array[0..255] of DWord = (\n $00000000, $77073096, $ee0e612c, $990951ba,\n $076dc419, $706af48f, $e963a535, $9e6495a3,\n $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,\n $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,\n $1db71064, $6ab020f2, $f3b97148, $84be41de,\n $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,\n $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec,\n $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,\n $3b6e20c8, $4c69105e, $d56041e4, $a2677172,\n $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,\n $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940,\n $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,\n $26d930ac, $51de003a, $c8d75180, $bfd06116,\n $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,\n $2802b89e, $5f058808, $c60cd9b2, $b10be924,\n $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,\n $76dc4190, $01db7106, $98d220bc, $efd5102a,\n $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,\n $7807c9a2, $0f00f934, $9609a88e, $e10e9818,\n $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,\n $6b6b51f4, $1c6c6162, $856530d8, $f262004e,\n $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,\n $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c,\n $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,\n $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,\n $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,\n $4369e96a, $346ed9fc, $ad678846, $da60b8d0,\n $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,\n $5005713c, $270241aa, $be0b1010, $c90c2086,\n $5768b525, $206f85b3, $b966d409, $ce61e49f,\n $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4,\n $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,\n $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,\n $ead54739, $9dd277af, $04db2615, $73dc1683,\n $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,\n $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,\n $f00f9344, $8708a3d2, $1e01f268, $6906c2fe,\n $f762575d, $806567cb, $196c3671, $6e6b06e7,\n $fed41b76, $89d32be0, $10da7a5a, $67dd4acc,\n $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,\n $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252,\n $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,\n $d80d2bda, $af0a1b4c, $36034af6, $41047a60,\n $df60efc3, $a867df55, $316e8eef, $4669be79,\n $cb61b38c, $bc66831a, $256fd2a0, $5268e236,\n $cc0c7795, $bb0b4703, $220216b9, $5505262f,\n $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04,\n $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,\n $9b64c2b0, $ec63f226, $756aa39c, $026d930a,\n $9c0906a9, $eb0e363f, $72076785, $05005713,\n $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,\n $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,\n $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e,\n $81be16cd, $f6b9265b, $6fb077e1, $18b74777,\n $88085ae6, $ff0f6a70, $66063bca, $11010b5c,\n $8f659eff, $f862ae69, $616bffd3, $166ccf45,\n $a00ae278, $d70dd2ee, $4e048354, $3903b3c2,\n $a7672661, $d06016f7, $4969474d, $3e6e77db,\n $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0,\n $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,\n $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6,\n $bad03605, $cdd70693, $54de5729, $23d967bf,\n $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,\n $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d\n );\n\n\ntype\n TAbPathType = ( ptNone, ptRelative, ptAbsolute );\n\n {===Helper functions===}\n function AbCopyFile(const Source, Destination: string; FailIfExists: Boolean): Boolean;\n\n procedure AbCreateDirectory( const Path : string );\n {creates the requested directory tree. CreateDir is insufficient,\n because if you have a path x:\\dir, and request x:\\dir\\sub1\\sub2,\n (/dir and /dir/sub1/sub2 on Unix) it fails.}\n\n function AbCreateTempFile(const Dir : string) : string;\n\n function AbGetTempDirectory : string;\n {-Return the system temp directory}\n\n function AbGetTempFile(const Dir : string; CreateIt : Boolean) : string;\n\n function AbDrive(const ArchiveName : string) : Char;\n\n function AbDriveIsRemovable(const ArchiveName : string) : Boolean;\n\n function AbFileMatch(FileName : string; FileMask : string ) : Boolean;\n {see if FileName matches FileMask}\n\n procedure AbFindFiles(const FileMask : string; SearchAttr : Integer;\n FileList : TStrings; Recurse : Boolean );\n\n procedure AbFindFilesEx( const FileMask : string; SearchAttr : Integer;\n FileList : TStrings; Recurse : Boolean );\n\n function AbAddBackSlash(const DirName : string) : string;\n\n function AbFindNthSlash( const Path : string; n : Integer ) : Integer;\n {return the position of the character just before the nth backslash}\n\n function AbGetDriveFreeSpace(const ArchiveName : string) : Int64;\n {return the available space on the specified drive }\n\n function AbGetPathType( const Value : string ) : TAbPathType;\n {returns path type - none, relative or absolute}\n\n {$IFDEF MSWINDOWS}\n function AbGetShortFileSpec(const LongFileSpec : string ) : string;\n {$ENDIF}\n\n procedure AbIncFilename( var Filename : string; Value : Word );\n\n procedure AbParseFileName( FileSpec : string;\n out Drive : string;\n out Path : string;\n out FileName : string );\n\n procedure AbParsePath( Path : string; SubPaths : TStrings );\n {- break abart path into subpaths --- Path : abbrevia/examples ->\n SubPaths[0] = abbrevia\n SubPaths[1] = examples}\n\n function AbPatternMatch(const Source : string; iSrc : Integer;\n const Pattern : string; iPat : Integer ) : Boolean;\n { recursive routine to see if the source string matches\n the pattern. Both ? and * wildcard characters are allowed.}\n\n function AbPercentage(V1, V2 : Int64) : Byte;\n {-Returns the ratio of V1 to V2 * 100}\n\n procedure AbStripDots( var FName : string );\n {-strips relative path information}\n\n procedure AbStripDrive( var FName : string );\n {-strips the drive off a filename}\n\n procedure AbFixName( var FName : string );\n {-changes backslashes to forward slashes}\n\n procedure AbUnfixName( var FName : string );\n {-changes forward slashes to backslashes}\n\n procedure AbUpdateCRC( var CRC : LongInt; const Buffer; Len : Integer );\n\n function AbUpdateCRC32(CurByte : Byte; CurCrc : LongInt) : LongInt;\n {-Returns an updated crc32}\n\n function AbCRC32Of( const aValue : RawByteString ) : LongInt;\n\n\n function AbWriteVolumeLabel(const VolName : string;\n Drive : Char) : Cardinal;\nconst\n AB_SPAN_VOL_LABEL = 'PKBACK# %3.3d';\n\n function AbGetVolumeLabel(Drive : Char) : string;\n procedure AbSetSpanVolumeLabel(Drive: Char; VolNo : Integer);\n function AbTestSpanVolumeLabel(Drive: Char; VolNo : Integer): Boolean;\n\n procedure AbSetFileAttr(const aFileName : string; aAttr: Integer);\n {-Sets platform-native file attributes (DOS attr or Unix mode)}\n function AbFileGetSize(const aFileName : string) : Int64;\n\ntype\n TAbAttrExRec = record\n Time: TDateTime;\n Size: Int64;\n Attr: Integer;\n Mode: {$IFDEF UNIX}mode_t{$ELSE}Cardinal{$ENDIF};\n end;\n\n function AbFileGetAttrEx(const aFileName: string; out aAttr: TAbAttrExRec) : Boolean;\n\n function AbSwapLongEndianness(Value : LongInt): LongInt;\n\n\n{ date and time stuff }\nconst\n Date1900 {: LongInt} = $0001AC05; {Julian day count for 01/01/1900 -- TDateTime Start Date}\n Date1970 {: LongInt} = $00020FE4; {Julian day count for 01/01/1970 -- Unix Start Date}\n Unix0Date: TDateTime = 25569; {Date1970 - Date1900}\n\n SecondsInDay = 86400; {Number of seconds in a day}\n SecondsInHour = 3600; {Number of seconds in an hour}\n SecondsInMinute = 60; {Number of seconds in a minute}\n HoursInDay = 24; {Number of hours in a day}\n MinutesInHour = 60; {Number of minutes in an hour}\n MinutesInDay = 1440; {Number of minutes in a day}\n\n\n function AbUnixTimeToLocalDateTime(UnixTime : LongInt) : TDateTime;\n function AbLocalDateTimeToUnixTime(DateTime : TDateTime) : LongInt;\n\n function AbDosFileDateToDateTime(FileDate, FileTime : Word) : TDateTime;\n function AbDateTimeToDosFileDate(Value : TDateTime) : LongInt;\n\n function AbGetFileTime(const aFileName: string): TDateTime;\n function AbSetFileTime(const aFileName: string; aValue: TDateTime): Boolean;\n\n{ file attributes }\n function AbDOS2UnixFileAttributes(Attr: LongInt): LongInt;\n function AbUnix2DosFileAttributes(Attr: LongInt): LongInt;\n\n{ AnisStrings }\n function AbLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; {$IFDEF HasInline}inline;{$ENDIF}\n function AbStrLen(const Str: PAnsiChar): Cardinal; {$IFDEF HasInline}inline;{$ENDIF}\n function AbStrPCopy(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar; {$IFDEF HasInline}inline;{$ENDIF}\n function AbStrPLCopy(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; {$IFDEF HasInline}inline;{$ENDIF}\n\n{ UNIX File Types and Permissions }\nconst\n AB_FMODE_FILE = $0000;\n AB_FMODE_FIFO = $1000;\n AB_FMODE_CHARSPECFILE = $2000;\n AB_FMODE_DIR = $4000;\n AB_FMODE_BLOCKSPECFILE = $6000;\n AB_FMODE_FILE2 = $8000;\n AB_FMODE_FILELINK = $A000;\n AB_FMODE_SOCKET = $C000;\n\n\n AB_FPERMISSION_OWNERREAD = $0100; { read by owner }\n AB_FPERMISSION_OWNERWRITE = $0080; { write by owner }\n AB_FPERMISSION_OWNEREXECUTE = $0040; { execute/search by owner }\n AB_FPERMISSION_GROUPREAD = $0020; { read by group }\n AB_FPERMISSION_GROUPWRITE = $0010; { write by group }\n AB_FPERMISSION_GROUPEXECUTE = $0008; { execute/search by group }\n AB_FPERMISSION_OTHERREAD = $0004; { read by other }\n AB_FPERMISSION_OTHERWRITE = $0002; { write by other }\n AB_FPERMISSION_OTHEREXECUTE = $0001; { execute/search by other }\n\n AB_FPERMISSION_GENERIC =\n AB_FPERMISSION_OWNERREAD or\n AB_FPERMISSION_OWNERWRITE or\n AB_FPERMISSION_GROUPREAD or\n AB_FPERMISSION_OTHERREAD;\n\n{ Unicode backwards compatibility functions }\n{$IFNDEF UNICODE}\nfunction CharInSet(C: AnsiChar; CharSet: TSysCharSet): Boolean;\n{$ENDIF}\n\nimplementation\n\nuses\n StrUtils,\n AbConst,\n AbExcept;\n\n{$IF DEFINED(FPCUnixAPI)}\nfunction mktemp(template: PAnsiChar): PAnsiChar; cdecl;\n external clib name 'mktemp';\n{$ELSEIF DEFINED(PosixAPI)}\nfunction mktemp(template: PAnsiChar): PAnsiChar; cdecl;\n external libc name _PU + 'mktemp';\n{$IFEND}\n\n{$IF DEFINED(FPCUnixAPI) AND DEFINED(Linux)}\n// FreePascal libc definitions\ntype\n nl_item = cint;\n\nconst\n __LC_CTYPE = 0;\n _NL_CTYPE_CLASS = (__LC_CTYPE shl 16);\n _NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14;\n\nfunction nl_langinfo(__item: nl_item): PAnsiChar; cdecl;\n external clib name 'nl_langinfo';\n{$IFEND}\n\n{===platform independent routines for platform dependent stuff=======}\nfunction ExtractShortName(const SR : TSearchRec) : string;\nbegin\n {$IFDEF MSWINDOWS}\n {$WARN SYMBOL_PLATFORM OFF}\n if SR.FindData.cAlternateFileName[0] <> #0 then\n Result := SR.FindData.cAlternateFileName\n else\n Result := SR.FindData.cFileName;\n {$WARN SYMBOL_PLATFORM ON}\n {$ENDIF}\n {$IFDEF UNIX}\n Result := SR.Name;\n {$ENDIF}\nend;\n{====================================================================}\n\n\n{ ========================================================================== }\nfunction AbCopyFile(const Source, Destination: string; FailIfExists: Boolean): Boolean;\n{$IFDEF UNIX}\nvar\n DesStream, SrcStream: TFileStream;\n{$ENDIF}\nbegin\n{$IFDEF UNIX}\n Result := False;\n if not FailIfExists or not FileExists(Destination) then\n try\n SrcStream := TFileStream.Create(Source, fmOpenRead or fmShareDenyWrite);\n try\n DesStream := TFileStream.Create(Destination, fmCreate);\n try\n DesStream.CopyFrom(SrcStream, 0);\n Result := True;\n finally\n DesStream.Free;\n end;\n finally\n SrcStream.Free;\n end;\n except\n // Ignore errors and just return false\n end;\n{$ENDIF UNIX}\n{$IFDEF MSWINDOWS}\n Result := CopyFile(PChar(Source), PChar(Destination), FailIfExists);\n{$ENDIF MSWINDOWS}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbCreateDirectory( const Path : string );\n {creates the requested directory tree. CreateDir is insufficient,\n because if you have a path x:\\dir, and request x:\\dir\\sub1\\sub2,\n (/dir and /dir/sub1/sub2 on Unix) it fails.}\nvar\n iStartSlash : Integer;\n i : Integer;\n TempPath : string;\nbegin\n if DirectoryExists( Path ) then\n Exit;\n {see how much of the path currently exists}\n if Pos( '\\\\', Path ) > 0 then\n {UNC Path \\\\computername\\sharename\\path1..\\pathn}\n iStartSlash := 5\n else\n {standard Path drive:\\path1..\\pathn}\n iStartSlash := 2;\n\n repeat\n {find the Slash at iStartSlash}\n i := AbFindNthSlash( Path, iStartSlash );\n {get a temp path to try: drive:\\path1}\n TempPath := Copy( Path, 1, i );\n {if it doesn't exist, create it}\n if not DirectoryExists( TempPath ) then\n MkDir( TempPath );\n inc( iStartSlash );\n until ( Length( TempPath ) = Length( Path ) );\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbCreateTempFile(const Dir : string) : string;\nbegin\n Result := AbGetTempFile(Dir, True);\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbGetTempDirectory : string;\nbegin\n{$IFDEF MSWiNDOWS}\n SetLength(Result, MAX_PATH);\n SetLength(Result, GetTempPath(Length(Result), PChar(Result)));\n{$ENDIF}\n{$IFDEF UNIX}\n Result := '/tmp/';\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbGetTempFile(const Dir : string; CreateIt : Boolean) : string;\nvar\n TempPath : string;\n{$IFDEF MSWINDOWS}\n FileNameZ : array [0..259] of char;\n{$ENDIF}\n{$IFDEF UNIX}\n hFile: Integer;\n FileName: AbSysString;\n{$ENDIF}\nbegin\n if DirectoryExists(Dir) then\n TempPath := Dir\n else\n TempPath := AbGetTempDirectory;\n{$IFDEF MSWINDOWS}\n GetTempFileName(PChar(TempPath), 'VMS', Word(not CreateIt), FileNameZ);\n Result := string(FileNameZ);\n{$ENDIF}\n{$IFDEF UNIX}\n FileName := AbSysString(TempPath) + 'VMSXXXXXX';\n mktemp(PAnsiChar(AbSysString(FileName)));\n Result := string(FileName);\n if CreateIt then begin\n hFile := FileCreate(Result);\n if hFile <> -1 then\n FileClose(hFile);\n end;\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbDrive(const ArchiveName : string) : Char;\nvar\n iPos: Integer;\n Path : string;\nbegin\n Path := ExpandFileName(ArchiveName);\n iPos := Pos(':', Path);\n if (iPos <= 0) then\n Result := 'A'\n else\n Result := Path[1];\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbDriveIsRemovable(const ArchiveName : string) : Boolean;\n{$IFDEF MSWINDOWS}\nvar\n Path: string;\n{$ENDIF}\nbegin\n{$IFDEF MSWINDOWS}\n Path := ExpandFileName(ArchiveName);\n if AnsiStartsText('\\\\?\\UNC\\', Path) then\n Delete(Path, 1, 8)\n else if AnsiStartsText('\\\\?\\', Path) then\n Delete(Path, 1, 4);\n Path := IncludeTrailingPathDelimiter(ExtractFileDrive(Path));\n Result := GetDriveType(PChar(Path)) = DRIVE_REMOVABLE;\n{$ENDIF}\n{$IFDEF LINUX}\n {LINUX -- Following may not cover all the bases}\n Result := AnsiStartsText('/mnt/floppy', ExtractFilePath(ExpandFileName(ArchiveName)));\n{$ENDIF}\n{$IFDEF DARWIN}\n Result := False;\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbGetDriveFreeSpace(const ArchiveName : string) : Int64;\n{ attempt to find free space (in bytes) on drive/volume,\n returns -1 if fails for some reason }\n{$IFDEF MSWINDOWS}\nvar\n FreeAvailable, TotalSpace: Int64;\nbegin\n if GetDiskFreeSpaceEx(PChar(ExtractFilePath(ExpandFileName(ArchiveName))),\n FreeAvailable, TotalSpace, nil) then\n Result := FreeAvailable\n else\n Result := -1;\n{$ENDIF}\n{$IFDEF UNIX}\nvar\n FStats : {$IFDEF PosixAPI}_statvfs{$ELSE}TStatFs{$ENDIF};\nbegin\n {$IF DEFINED(LibcAPI)}\n if statfs(PAnsiChar(ExtractFilePath(ArchiveName)), FStats) = 0 then\n Result := Int64(FStats.f_bAvail) * Int64(FStats.f_bsize)\n {$ELSEIF DEFINED(FPCUnixAPI)}\n if fpStatFS(PAnsiChar(ExtractFilePath(ArchiveName)), @FStats) = 0 then\n Result := Int64(FStats.bAvail) * Int64(FStats.bsize)\n {$ELSEIF DEFINED(PosixAPI)}\n if statvfs(PAnsiChar(AbSysString(ExtractFilePath(ArchiveName))), FStats) = 0 then\n Result := Int64(FStats.f_bavail) * Int64(FStats.f_bsize)\n {$IFEND}\n else\n Result := -1;\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbFileMatch(FileName: string; FileMask: string ): Boolean;\n {see if FileName matches FileMask}\nvar\n DirMatch : Boolean;\n MaskDir : string;\nbegin\n FileName := UpperCase( FileName );\n FileMask := UpperCase( FileMask );\n MaskDir := ExtractFilePath( FileMask );\n if MaskDir = '' then\n DirMatch := True\n else\n DirMatch := AbPatternMatch( ExtractFilePath( FileName ), 1, MaskDir, 1 );\n\n Result := DirMatch and AbPatternMatch( ExtractFileName( FileName ), 1,\n ExtractFileName( FileMask ), 1 );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbFindFiles( const FileMask : string; SearchAttr : Integer;\n FileList : TStrings; Recurse : Boolean );\nvar\n NewFile : string;\n SR : TSearchRec;\n Found : Integer;\n NameMask: string;\nbegin\n Found := FindFirst( FileMask, SearchAttr, SR );\n if Found = 0 then begin\n try\n NameMask := UpperCase(ExtractFileName(FileMask));\n while Found = 0 do begin\n NewFile := ExtractFilePath( FileMask ) + SR.Name;\n if (SR.Name <> AbThisDir) and\n (SR.Name <> AbParentDir) and\n AbPatternMatch(UpperCase(SR.Name), 1, NameMask, 1) then\n if (SR.Attr and faDirectory) <> 0 then\n FileList.Add( NewFile + PathDelim )\n else\n FileList.Add( NewFile );\n Found := FindNext( SR );\n end;\n finally\n FindClose( SR );\n end;\n end;\n if not Recurse then\n Exit;\n NewFile := ExtractFilePath( FileMask );\n if ( NewFile <> '' ) and ( NewFile[Length(NewFile)] <> AbPathDelim) then\n NewFile := NewFile + AbPathDelim;\n NewFile := NewFile + AbAnyFile;\n\n Found := FindFirst( NewFile, faDirectory or SearchAttr, SR );\n if Found = 0 then begin\n try\n while ( Found = 0 ) do begin\n if ( SR.Name <> AbThisDir ) and\n ( SR.Name <> AbParentDir ) and\n ((SR.Attr and faDirectory) > 0 ) then\n AbFindFiles( ExtractFilePath( NewFile ) + SR.Name + AbPathDelim +\n ExtractFileName( FileMask ), SearchAttr,\n FileList, True );\n Found := FindNext( SR );\n end;\n finally\n FindClose( SR );\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbFindFilesEx( const FileMask : string; SearchAttr : Integer;\n FileList : TStrings; Recurse : Boolean );\nvar\n I, J: Integer;\n MaskPart: string;\nbegin\n I := 1;\n while I <= Length(FileMask) do begin\n J := I;\n while (I <= Length(FileMask)) and (FileMask[I] <> AbPathSep) do Inc(I);\n MaskPart := Trim(Copy(FileMask, J, I - J));\n if (I <= Length(FileMask)) and (FileMask[I] = AbPathSep) then Inc(I);\n\n AbFindFiles(MaskPart, SearchAttr, FileList, Recurse);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbAddBackSlash(const DirName : string) : string;\n{ Add a default slash to a directory name }\nconst\n AbDelimSet : set of AnsiChar = [AbPathDelim, ':', #0];\nbegin\n Result := DirName;\n if Length(DirName) = 0 then\n Exit;\n if not CharInSet(DirName[Length(DirName)], AbDelimSet) then\n Result := DirName + AbPathDelim;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbFindNthSlash( const Path : string; n : Integer ) : Integer;\n{ return the position of the character just before the nth slash }\nvar\n i : Integer;\n Len : Integer;\n iSlash : Integer;\nbegin\n Len := Length( Path );\n Result := Len;\n iSlash := 0;\n i := 0;\n while i <= Len do begin\n if Path[i] = AbPathDelim then begin\n inc( iSlash );\n if iSlash = n then begin\n Result := pred( i );\n break;\n end;\n end;\n inc( i );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbGetPathType( const Value : string ) : TAbPathType;\n{ returns path type - none, relative or absolute }\nbegin\n Result := ptNone;\n{$IFDEF MSWINDOWS}\n{check for drive/unc info}\n if ( Pos( '\\\\', Value ) > 0 ) or ( Pos( ':', Value ) > 0 ) then\n{$ENDIF MSWINDOWS}\n{$IFDEF UNIX}\n{ UNIX absolute paths start with a slash }\n if (Value[1] = AbPathDelim) then\n{$ENDIF UNIX}\n Result := ptAbsolute\n else if ( Pos( AbPathDelim, Value ) > 0 ) or ( Pos( AB_ZIPPATHDELIM, Value ) > 0 ) then\n Result := ptRelative;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF MSWINDOWS}\n{$WARN SYMBOL_PLATFORM OFF}\nfunction AbGetShortFileSpec(const LongFileSpec : string ) : string;\nvar\n SR : TSearchRec;\n Search : string;\n Drive : string;\n Path : string;\n FileName : string;\n Found : Integer;\n SubPaths : TStrings;\n i : Integer;\nbegin\n AbParseFileName( LongFileSpec, Drive, Path, FileName );\n SubPaths := TStringList.Create;\n try\n AbParsePath( Path, SubPaths );\n Search := Drive;\n Result := Search + AbPathDelim;\n if SubPaths.Count > 0 then\n for i := 0 to pred( SubPaths.Count ) do begin\n Search := Search + AbPathDelim + SubPaths[i];\n Found := FindFirst( Search, faHidden + faSysFile + faDirectory, SR );\n if Found <> 0 then\n raise EAbException.Create( 'Path not found' );\n try\n Result := Result + ExtractShortName(SR) + AbPathDelim;\n finally\n FindClose( SR );\n end;\n end;\n Search := Search + AbPathDelim + FileName;\n Found := FindFirst( Search,\n faReadOnly + faHidden + faSysFile + faArchive, SR );\n if Found <> 0 then\n raise EAbFileNotFound.Create;\n try\n Result := Result + ExtractShortName(SR);\n finally\n FindClose( SR );\n end;\n finally\n SubPaths.Free;\n end;\nend;\n{$WARN SYMBOL_PLATFORM ON}\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure AbIncFilename( var Filename : string; Value : Word );\n{ place value at the end of filename, e.g. Files.C04 }\nvar\n Ext : string;\n I : Word;\nbegin\n I := (Value + 1) mod 100;\n Ext := ExtractFileExt(Filename);\n if (Length(Ext) < 2) then\n Ext := '.' + Format('%.2d', [I])\n else\n Ext := Ext[1] + Ext[2] + Format('%.2d', [I]);\n Filename := ChangeFileExt(Filename, Ext);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbParseFileName( FileSpec : string;\n out Drive : string;\n out Path : string;\n out FileName : string );\nvar\n i : Integer;\n iColon : Integer;\n iStartSlash : Integer;\nbegin\n if Pos( AB_ZIPPATHDELIM, FileSpec ) > 0 then\n AbUnfixName( FileSpec );\n FileName := ExtractFileName( FileSpec );\n Path := ExtractFilePath( FileSpec );\n {see how much of the path currently exists}\n iColon := Pos( ':', Path );\n if Pos( '\\\\', Path ) > 0 then begin\n {UNC Path \\\\computername\\sharename\\path1..\\pathn}\n {everything up to the 4th slash is the drive}\n iStartSlash := 4;\n i := AbFindNthSlash( Path, iStartSlash );\n Drive := Copy( Path, 1, i );\n Delete( Path, 1, i + 1 );\n end\n else if iColon > 0 then begin\n Drive := Copy( Path, 1, iColon );\n Delete( Path, 1, iColon );\n if Path[1] = AbPathDelim then\n Delete( Path, 1, 1 );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbParsePath( Path : string; SubPaths : TStrings );\n{ break abart path into subpaths --- Path : abbrevia/examples >\n SubPaths[0] = abbrevia\n SubPaths[1] = examples}\nvar\n i : Integer;\n iStart : Integer;\n iStartSlash : Integer;\n SubPath : string;\nbegin\n if Path = '' then Exit;\n if Path[ Length( Path ) ] = AbPathDelim then\n Delete( Path, Length( Path ), 1 );\n iStart := 1;\n iStartSlash := 1;\n repeat\n {find the Slash at iStartSlash}\n i := AbFindNthSlash( Path, iStartSlash );\n {get the subpath}\n SubPath := Copy( Path, iStart, i - iStart + 1 );\n iStart := i + 2;\n inc( iStartSlash );\n SubPaths.Add( SubPath );\n until ( i = Length( Path ) );\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbPatternMatch(const Source : string; iSrc : Integer;\n const Pattern : string; iPat : Integer ) : Boolean;\n{ recursive routine to see if the source string matches\n the pattern. Both ? and * wildcard characters are allowed.\n Compares Source from iSrc to Length(Source) to\n Pattern from iPat to Length(Pattern)}\nvar\n Matched : Boolean;\n k : Integer;\nbegin\n if Length( Source ) = 0 then begin\n Result := Length( Pattern ) = 0;\n Exit;\n end;\n\n if iPat = 1 then begin\n if ( CompareStr( Pattern, AbDosAnyFile) = 0 ) or\n ( CompareStr( Pattern, AbUnixAnyFile ) = 0 ) then begin\n Result := True;\n Exit;\n end;\n end;\n\n if Length( Pattern ) = 0 then begin\n Result := (Length( Source ) - iSrc + 1 = 0);\n Exit;\n end;\n\n while True do begin\n if ( Length( Source ) < iSrc ) and\n ( Length( Pattern ) < iPat ) then begin\n Result := True;\n Exit;\n end;\n\n if Length( Pattern ) < iPat then begin\n Result := False;\n Exit;\n end;\n\n if Pattern[iPat] = '*' then begin\n k := iPat;\n if ( Length( Pattern ) < iPat + 1 ) then begin\n Result := True;\n Exit;\n end;\n\n while True do begin\n Matched := AbPatternMatch( Source, k, Pattern, iPat + 1 );\n if Matched or ( Length( Source ) < k ) then begin\n Result := Matched;\n Exit;\n end;\n inc( k );\n end;\n end\n else begin\n if ( (Pattern[iPat] = '?') and\n ( Length( Source ) <> iSrc - 1 ) ) or\n ( Pattern[iPat] = Source[iSrc] ) then begin\n inc( iPat );\n inc( iSrc );\n end\n else begin\n Result := False;\n Exit;\n end;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbPercentage(V1, V2 : Int64) : Byte;\n{ Returns the ratio of V1 to V2 * 100 }\nbegin\n if V2 <= 0 then\n Result := 0\n else if V1 >= V2 then\n Result := 100\n else\n Result := (V1 * 100) div V2;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbStripDots( var FName : string );\n{ strips relative path information, e.g. \"..\"}\nbegin\n while Pos( AbParentDir + AbPathDelim, FName ) = 1 do\n System.Delete( FName, 1, 3 );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbStripDrive( var FName : string );\n{ strips the drive off a filename }\nvar\n Drive, Path, Name : string;\nbegin\n AbParseFileName( FName, Drive, Path, Name );\n FName := Path + Name;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbFixName( var FName : string );\n{ changes backslashes to forward slashes }\nvar\n i : Integer;\nbegin\n for i := 1 to Length( FName ) do\n if FName[i] = AbPathDelim then\n FName[i] := AB_ZIPPATHDELIM;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbUnfixName( var FName : string );\n{ changes forward slashes to backslashes }\nvar\n i : Integer;\nbegin\n for i := 1 to Length( FName ) do\n if FName[i] = AB_ZIPPATHDELIM then\n FName[i] := AbPathDelim;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbUpdateCRC( var CRC : LongInt; const Buffer; Len : Integer );\nvar\n BufPtr : PByte;\n i : Integer;\n CRCTemp : DWORD;\nbegin\n BufPtr := @Buffer;\n CRCTemp := CRC;\n for i := 0 to pred( Len ) do\n begin\n CRCTemp := AbCrc32Table[ Byte(CrcTemp) xor (BufPtr^) ] xor\n ((CrcTemp shr 8) and $00FFFFFF);\n Inc(BufPtr);\n end;\n CRC := CRCTemp;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbUpdateCRC32(CurByte : Byte; CurCrc : LongInt) : LongInt;\n{ Return the updated 32bit CRC }\n{ Normally a good candidate for basm, but Delphi32's code\n generation couldn't be beat on this one!}\nbegin\n Result := DWORD(AbCrc32Table[ Byte(CurCrc xor LongInt( CurByte ) ) ] xor\n ((CurCrc shr 8) and DWORD($00FFFFFF)));\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbCRC32Of( const aValue : RawByteString ) : LongInt;\nbegin\n Result := -1;\n AbUpdateCRC(Result, aValue[1], Length(aValue));\n Result := not Result;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbWriteVolumeLabel(const VolName : string;\n Drive : Char) : Cardinal;\nvar\n Temp : string;\n Vol : array[0..11] of Char;\n Root : array[0..3] of Char;\nbegin\n Temp := VolName;\n StrCopy(Root, '%:' + AbPathDelim);\n Root[0] := Drive;\n if Length(Temp) > 11 then\n SetLength(Temp, 11);\n StrPCopy(Vol, Temp);\n{$IFDEF MSWINDOWS}\n if Windows.SetVolumeLabel(Root, Vol) then\n Result := 0\n else Result := GetLastError;\n{$ENDIF MSWINDOWS}\n{$IFDEF UNIX}\n{ Volume labels not supported on Unix }\n Result := 0;\n{$ENDIF UNIX}\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF MSWINDOWS}\nfunction AbOffsetFromUTC: LongInt;\n{ local timezone's offset from UTC in seconds (UTC = local + bias) }\nvar\n\tTZI: TTimeZoneInformation;\nbegin\ncase GetTimeZoneInformation(TZI) of\n\tTIME_ZONE_ID_UNKNOWN:\n\t\tResult := TZI.Bias;\n\tTIME_ZONE_ID_DAYLIGHT:\n\t\tResult := TZI.Bias + TZI.DaylightBias;\n\tTIME_ZONE_ID_STANDARD:\n\t\tResult := TZI.Bias + TZI.StandardBias\n\telse\n Result := 0\n\tend;\nResult := Result * SecondsInMinute;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nfunction AbUnixTimeToLocalDateTime(UnixTime : LongInt) : TDateTime;\n{ convert UTC unix date to Delphi TDateTime in local timezone }\n{$IFDEF MSWINDOWS}\nvar\n Hrs, Mins, Secs : Word;\n TodaysSecs : LongInt;\n Time: TDateTime;\nbegin\n UnixTime := UnixTime - AbOffsetFromUTC;\n TodaysSecs := UnixTime mod SecondsInDay;\n Hrs := TodaysSecs div SecondsInHour;\n TodaysSecs := TodaysSecs - (Hrs * SecondsInHour);\n Mins := TodaysSecs div SecondsInMinute;\n Secs := TodaysSecs - (Mins * SecondsInMinute);\n\n if TryEncodeTime(Hrs, Mins, Secs, 0, Time) then\n Result := Unix0Date + (UnixTime div SecondsInDay) + Time\n else\n Result := 0;\n{$ENDIF}\n{$IFDEF UNIX}\nbegin\n Result := FileDateToDateTime(UnixTime);\n{$ENDIF}\nend;\n\n{ -------------------------------------------------------------------------- }\nfunction AbLocalDateTimeToUnixTime(DateTime : TDateTime) : LongInt;\n{ convert local Delphi TDateTime to UTC unix date }\n{$IFDEF MSWINDOWS}\nvar\n Hrs, Mins, Secs, MSecs : Word;\n Dt, Tm : TDateTime;\nbegin\n Dt := Trunc(DateTime);\n Tm := DateTime - Dt;\n if Dt < Unix0Date then\n Result := 0\n else\n Result := Trunc(Dt - Unix0Date) * SecondsInDay;\n\n DecodeTime(Tm, Hrs, Mins, Secs, MSecs);\n Result := Result + (Hrs * SecondsInHour) + (Mins * SecondsInMinute) + Secs;\n Result := Result + AbOffsetFromUTC;\n{$ENDIF}\n{$IFDEF UNIX}\nbegin\n Result := DateTimeToFileDate(DateTime);\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbDosFileDateToDateTime(FileDate, FileTime : Word) : TDateTime;\n{$IFDEF MSWINDOWS}\nvar\n Temp : LongInt;\nbegin\n LongRec(Temp).Lo := FileTime;\n LongRec(Temp).Hi := FileDate;\n Result := FileDateToDateTime(Temp);\n{$ENDIF MSWINDOWS}\n{$IFDEF UNIX}\nvar\n Yr, Mo, Dy : Word;\n Hr, Mn, S : Word;\nbegin\n Yr := FileDate shr 9 + 1980;\n\n Mo := FileDate shr 5 and 15;\n if Mo < 1 then Mo := 1;\n if Mo > 12 then Mo := 12;\n\n Dy := FileDate and 31;\n if Dy < 1 then Dy := 1;\n if Dy > DaysInAMonth(Yr, Mo) then\n Dy := DaysInAMonth(Yr, Mo);\n\n Hr := FileTime shr 11;\n if Hr > 23 then Hr := 23;\n\n Mn := FileTime shr 5 and 63;\n if Mn > 59 then Mn := 59;\n\n S := FileTime and 31 shl 1;\n if S > 59 then S := 59;\n\n Result :=\n EncodeDate(Yr, Mo, Dy) +\n EncodeTime(Hr, Mn, S, 0);\n{$ENDIF UNIX}\nend;\n\nfunction AbDateTimeToDosFileDate(Value : TDateTime) : LongInt;\n{$IFDEF MSWINDOWS}\nbegin\n Result := DateTimeToFileDate(Value);\n{$ENDIF MSWINDOWS}\n{$IFDEF UNIX}\nvar\n Yr, Mo, Dy : Word;\n Hr, Mn, S, MS: Word;\nbegin\n DecodeDate(Value, Yr, Mo, Dy);\n if (Yr < 1980) or (Yr > 2107) then { outside DOS file date year range }\n Yr := 1980;\n DecodeTime(Value, Hr, Mn, S, MS);\n\n LongRec(Result).Lo := (S shr 1) or (Mn shl 5) or (Hr shl 11);\n LongRec(Result).Hi := Dy or (Mo shl 5) or (Word(Yr - 1980) shl 9);\n{$ENDIF UNIX}\nend;\n\n{ -------------------------------------------------------------------------- }\n\nfunction AbGetFileTime(const aFileName: string): TDateTime;\nvar\n Attr: TAbAttrExRec;\nbegin\n AbFileGetAttrEx(aFileName, Attr);\n Result := Attr.Time;\nend;\n\nfunction AbSetFileTime(const aFileName: string; aValue: TDateTime): Boolean;\nbegin\n {$IFDEF MSWINDOWS}\n Result := FileSetDate(aFileName, AbDateTimeToDosFileDate(aValue)) = 0;\n {$ENDIF}\n {$IFDEF UNIX}\n Result := FileSetDate(aFileName, AbLocalDateTimeToUnixTime(aValue)) = 0;\n {$ENDIF}\nend;\n\n{ -------------------------------------------------------------------------- }\nfunction AbSwapLongEndianness(Value : LongInt): LongInt;\n{ convert BigEndian <-> LittleEndian 32-bit value }\ntype\n TCastArray = array [0..3] of Byte;\nvar\n i : Integer;\nbegin\n for i := 3 downto 0 do\n TCastArray(Result)[3-i] := TCastArray(Value)[i];\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbDOS2UnixFileAttributes(Attr: LongInt): LongInt;\nbegin\n {$WARN SYMBOL_PLATFORM OFF}\n Result := { default permissions }\n AB_FPERMISSION_OWNERREAD or\n AB_FPERMISSION_GROUPREAD or\n AB_FPERMISSION_OTHERREAD;\n\n if (Attr and faReadOnly) = 0 then\n Result := Result or AB_FPERMISSION_OWNERWRITE;\n\n if (Attr and faDirectory) <> 0 then\n Result := Result or AB_FMODE_DIR or AB_FPERMISSION_OWNEREXECUTE or\n AB_FPERMISSION_GROUPEXECUTE or AB_FPERMISSION_OTHEREXECUTE\n else\n Result := Result or AB_FMODE_FILE;\n {$WARN SYMBOL_PLATFORM ON}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbUnix2DosFileAttributes(Attr: LongInt): LongInt;\nbegin\n {$WARN SYMBOL_PLATFORM OFF}\n Result := 0;\n case (Attr and $F000) of\n AB_FMODE_FILE, AB_FMODE_FILE2: { standard file }\n Result := 0;\n\n AB_FMODE_DIR: { directory }\n Result := Result or faDirectory;\n\n AB_FMODE_FIFO,\n AB_FMODE_CHARSPECFILE,\n AB_FMODE_BLOCKSPECFILE,\n AB_FMODE_FILELINK,\n AB_FMODE_SOCKET:\n Result := Result or faSysFile;\n end;\n\n if (Attr and AB_FPERMISSION_OWNERWRITE) <> AB_FPERMISSION_OWNERWRITE then\n Result := Result or faReadOnly;\n {$WARN SYMBOL_PLATFORM ON}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbSetFileAttr(const aFileName : string; aAttr: Integer);\nbegin\n {$WARN SYMBOL_PLATFORM OFF}\n {$IFDEF MSWINDOWS}\n FileSetAttr(aFileName, aAttr);\n {$ENDIF}\n {$IF DEFINED(LibcAPI) OR DEFINED(PosixAPI)}\n chmod(PAnsiChar(AbSysString(aFileName)), aAttr);\n {$ELSEIF DEFINED(FPCUnixAPI)}\n fpchmod(aFileName, aAttr);\n {$IFEND}\n {$WARN SYMBOL_PLATFORM ON}\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbFileGetSize(const aFileName : string) : Int64;\nvar\n SR: TAbAttrExRec;\nbegin\n if AbFileGetAttrEx(aFileName, SR) then\n Result := SR.Size\n else\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbFileGetAttrEx(const aFileName: string; out aAttr: TAbAttrExRec) : Boolean;\nvar\n{$IFDEF MSWINDOWS}\n FileDate: LongRec;\n FindData: TWin32FindData;\n LocalFileTime: TFileTime;\n{$ENDIF}\n{$IFDEF FPCUnixAPI}\n StatBuf: stat;\n{$ENDIF}\n{$IFDEF LibcAPI}\n StatBuf: TStatBuf64;\n{$ENDIF}\n{$IFDEF PosixAPI}\n StatBuf: _stat;\n{$ENDIF}\nbegin\n aAttr.Time := 0;\n aAttr.Size := -1;\n aAttr.Attr := -1;\n aAttr.Mode := 0;\n{$IFDEF MSWINDOWS}\n Result := GetFileAttributesEx(PChar(aFileName), GetFileExInfoStandard, @FindData);\n if Result then begin\n if FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime) and\n FileTimeToDosDateTime(LocalFileTime, FileDate.Hi, FileDate.Lo) then\n aAttr.Time := FileDateToDateTime(Integer(FileDate));\n LARGE_INTEGER(aAttr.Size).LowPart := FindData.nFileSizeLow;\n LARGE_INTEGER(aAttr.Size).HighPart := FindData.nFileSizeHigh;\n aAttr.Attr := FindData.dwFileAttributes;\n aAttr.Mode := AbDOS2UnixFileAttributes(FindData.dwFileAttributes);\n end;\n{$ENDIF}\n{$IFDEF UNIX}\n {$IFDEF FPCUnixAPI}\n Result := (FpStat(aFileName, StatBuf) = 0);\n {$ENDIF}\n {$IFDEF LibcAPI}\n // Work around Kylix QC#2761: Stat64, et al., are defined incorrectly\n Result := (__lxstat64(_STAT_VER, PAnsiChar(aFileName), StatBuf) = 0);\n {$ENDIF}\n {$IFDEF PosixAPI}\n Result := (stat(PAnsiChar(AbSysString(aFileName)), StatBuf) = 0);\n {$ENDIF}\n if Result then begin\n aAttr.Time := FileDateToDateTime(StatBuf.st_mtime);\n aAttr.Size := StatBuf.st_size;\n aAttr.Attr := AbUnix2DosFileAttributes(StatBuf.st_mode);\n aAttr.Mode := StatBuf.st_mode;\n end;\n{$ENDIF UNIX}\nend;\n\n\nconst\n MAX_VOL_LABEL = 16;\n\nfunction AbGetVolumeLabel(Drive : Char) : string;\n{-Get the volume label for the specified drive.}\n{$IFDEF MSWINDOWS}\nvar\n Root : string;\n Flags, MaxLength : DWORD;\n NameSize : Integer;\n VolName : string;\n{$ENDIF}\nbegin\n{$IFDEF MSWINDOWS}\n NameSize := 0;\n Root := Drive + ':\\';\n SetLength(VolName, MAX_VOL_LABEL);\n\n Result := '';\n\n if GetVolumeInformation(PChar(Root), PChar(VolName), Length(VolName),\n nil, MaxLength, Flags, nil, NameSize)\n then\n Result := VolName;\n{$ELSE}\n Result := ''; //Stop Gap, spanning support needs to be rethought for Unix\n{$ENDIF}\nend;\n\nprocedure AbSetSpanVolumeLabel(Drive: Char; VolNo : Integer);\nbegin\n AbWriteVolumeLabel(Format(AB_SPAN_VOL_LABEL,\n [VolNo]), Drive);\nend;\n\nfunction AbTestSpanVolumeLabel(Drive: Char; VolNo : Integer): Boolean;\nvar\n VolLabel, TestLabel : string;\nbegin\n TestLabel := Format(AB_SPAN_VOL_LABEL, [VolNo]);\n VolLabel := UpperCase(AbGetVolumeLabel(Drive));\n Result := VolLabel = TestLabel;\nend;\n\n{ Unicode backwards compatibility functions }\n{$IFNDEF UNICODE}\nfunction CharInSet(C: AnsiChar; CharSet: TSysCharSet): Boolean;\nbegin\n Result := C in CharSet;\nend;\n{$ENDIF}\n\nfunction AbLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;\nbegin\n{$IFDEF HasAnsiStrings}\n Result := System.AnsiStrings.LeftStr(AText, ACount);\n{$ELSE}\n Result := StrUtils.LeftStr(AText, ACount);\n{$ENDIF}\nend;\n\nfunction AbStrLen(const Str: PAnsiChar): Cardinal;\nbegin\n{$IFDEF HasAnsiStrings}\n Result := System.AnsiStrings.StrLen(Str);\n{$ELSE}\n Result := SysUtils.StrLen(Str);\n{$ENDIF}\nend;\n\nfunction AbStrPCopy(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar;\nbegin\n{$IFDEF HasAnsiStrings}\n Result := System.AnsiStrings.StrPCopy(Dest, Source);\n{$ELSE}\n Result := SysUtils.StrPCopy(Dest, Source);\n{$ENDIF}\nend;\n\nfunction AbStrPLCopy(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar;\nbegin\n{$IFDEF HasAnsiStrings}\n Result := System.AnsiStrings.StrPLCopy(Dest, Source, MaxLen);\n{$ELSE}\n Result := SysUtils.StrPLCopy(Dest, Source, MaxLen);\n{$ENDIF}\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbVMStrm.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbVMStrm.pas *}\n{*********************************************************}\n{* ABBREVIA: Virtual Memory Stream *}\n{*********************************************************}\n\nunit AbVMStrm;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes;\n\nconst\n AB_VMSPageSize = 4096; {must be a power of two}\n AB_VMSMaxPages = 2048; {makes 8MB with the above value}\n\ntype\n PvmsPage = ^TvmsPage;\n TvmsPage = packed record\n vpStmOfs : Int64; {value will be multiple of AB_VMSPageSize}\n vpLRU : integer; {'time' page was last accessed}\n vpDirty : Boolean; {has the page been changed?}\n vpData : array [0..pred(AB_VMSPageSize)] of byte; {stream data}\n end;\n\ntype\n TAbVirtualMemoryStream = class(TStream)\n protected {private}\n vmsCachePage : PvmsPage; {the latest page used}\n vmsLRU : Longint; {'tick' value}\n vmsMaxMemToUse : Longword; {maximum memory to use for data}\n vmsMaxPages : Integer; {maximum data pages}\n vmsPageList : TList; {page array, sorted by offset}\n vmsPosition : Int64; {position of stream}\n vmsSize : Int64; {size of stream}\n vmsSwapFileDir : string; {swap file directory}\n vmsSwapFileName : string; {swap file name}\n vmsSwapFileSize : Int64; {size of swap file}\n vmsSwapStream : TFileStream;{swap file stream}\n protected\n procedure vmsSetMaxMemToUse(aNewMem : Longword);\n\n function vmsAlterPageList(aNewMem : Longword) : Longword;\n procedure vmsFindOldestPage(out OldestInx : Longint;\n out OldestPage: PvmsPage);\n function vmsGetNextLRU : Longint;\n function vmsGetPageForOffset(aOffset : Int64) : PvmsPage;\n\n procedure vmsSwapFileCreate;\n procedure vmsSwapFileDestroy;\n procedure vmsSwapFileRead(aPage : PvmsPage);\n procedure vmsSwapFileWrite(aPage : PvmsPage);\n public\n constructor Create;\n {-create the virtual memory stream}\n destructor Destroy; override;\n {-destroy the virtual memory stream}\n\n function Read(var Buffer; Count : Longint) : Longint; override;\n {-read from the stream into a buffer}\n function Write(const Buffer; Count : Longint) : Longint; override;\n {-write to the stream from a buffer}\n function Seek(const Offset : Int64; Origin : TSeekOrigin) : Int64; override;\n {-seek to a particular point in the stream}\n\n procedure SetSize(const NewSize : Int64); override;\n {-set the stream size}\n\n property MaxMemToUse : Longword\n read vmsMaxMemToUse write vmsSetMaxMemToUse;\n {-maximum memory to use for data before swapping to disk}\n property SwapFileDirectory : string\n read vmsSwapFileDir write vmsSwapFileDir;\n end;\n\nimplementation\n\nuses\n {$IFDEF MSWINDOWS}\n Windows, // Fix warning about unexpanded inline functions\n {$ENDIF}\n SysUtils,\n AbExcept,\n AbUtils;\n\nconst\n LastLRUValue = $7FFFFFFF;\n\n{===TAbVirtualMemoryStream===========================================}\nconstructor TAbVirtualMemoryStream.Create;\nvar\n Page : PvmsPage;\nbegin\n inherited Create;\n {create the page array}\n vmsPageList := TList.Create;\n {create the first page}\n New(Page);\n with Page^ do begin\n vpStmOfs := 0;\n vpLRU := vmsGetNextLRU;\n vpDirty := False;\n FillChar(vpData, AB_VMSPageSize, 0);\n end;\n vmsPageList.Insert(0, pointer(Page));\n {prime the cache, from now on the cache will never be nil}\n vmsCachePage := Page;\n {default to using all allowed pages}\n MaxMemToUse := AB_VMSMaxPages * AB_VMSPageSize;\nend;\n{--------}\ndestructor TAbVirtualMemoryStream.Destroy;\nvar\n Inx : integer;\nbegin\n {destroy the swap file}\n vmsSwapFileDestroy;\n {throw away all pages in the list}\n if (vmsPageList <> nil) then begin\n for Inx := 0 to pred(vmsPageList.Count) do\n Dispose(PvmsPage(vmsPageList[Inx]));\n vmsPageList.Destroy;\n end;\n {let our ancestor clean up}\n inherited Destroy;\nend;\n{--------}\nfunction TAbVirtualMemoryStream.Read(var Buffer; Count : Longint) : Longint;\nvar\n BufPtr : PByte;\n Page : PvmsPage;\n PageDataInx : integer;\n Posn : int64;\n BytesToGo : int64;\n BytesToRead : int64;\n StartOfs : int64;\nbegin\n {reading is complicated by the fact we can only read in chunks of\n AB_VMSPageSize: we need to partition out the overall read into a read\n from a partial page, zero or more reads from complete pages and\n then a possible read from a partial page}\n\n {initialise some variables, note that the complex calc in the\n expression for PageDataInx is the offset of the start of the page\n where Posn is found.}\n BufPtr := @Buffer;\n Posn := vmsPosition;\n PageDataInx := Posn - (Posn and (not pred(AB_VMSPageSize)));\n BytesToRead := AB_VMSPageSize - PageDataInx;\n {calculate the actual number of bytes to read - this depends on the\n current position and size of the stream}\n BytesToGo := Count;\n if (vmsSize < (vmsPosition + Count)) then\n BytesToGo := vmsSize - vmsPosition;\n if (BytesToGo < 0) then\n BytesToGo := 0;\n Result := BytesToGo;\n\n {while we have bytes to read, read them}\n while (BytesToGo <> 0) do begin\n if (BytesToRead > BytesToGo) then\n BytesToRead := BytesToGo;\n StartOfs := Posn and (not pred(AB_VMSPageSize));\n if (vmsCachePage^.vpStmOfs = StartOfs) then\n Page := vmsCachePage\n else\n Page := vmsGetPageForOffset(StartOfs);\n Move(Page^.vpData[PageDataInx], BufPtr^, BytesToRead);\n dec(BytesToGo, BytesToRead);\n inc(Posn, BytesToRead);\n inc(BufPtr, BytesToRead);\n PageDataInx := 0;\n BytesToRead := AB_VMSPageSize;\n end;\n {remember our new position}\n vmsPosition := Posn;\nend;\n{--------}\nfunction TAbVirtualMemoryStream.Seek(const Offset : Int64;\n Origin : TSeekOrigin) : Int64;\nbegin\n case Origin of\n soBeginning : vmsPosition := Offset;\n soCurrent : inc(vmsPosition, Offset);\n soEnd : vmsPosition := vmsSize + Offset;\n else\n raise EAbVMSInvalidOrigin.Create( Integer(Origin));\n end;\n Result := vmsPosition;\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.SetSize(const NewSize : Int64);\nvar\n Page : PvmsPage;\n Inx : integer;\n NewFileSize : Int64;\nbegin\n if (NewSize < vmsSize) then begin\n {go through the page list discarding pages whose offset is greater\n than our new size; don't bother saving any data from them since\n it be beyond the end of the stream anyway}\n {never delete the last page here}\n for Inx := pred(vmsPageList.Count) downto 1 do begin\n Page := PvmsPage(vmsPageList[Inx]);\n if (Page^.vpStmOfs >= NewSize) then begin\n Dispose(Page);\n vmsPageList.Delete(Inx);\n end else begin\n Break;\n end;\n end;\n\n { Reset cache to the first page in case the cached page was deleted. }\n vmsCachePage := vmsPageList[0];\n\n {force the swap file file size in range, it'll be a multiple of\n AB_VMSPageSize}\n NewFileSize := pred(NewSize + AB_VMSPageSize) and\n (not pred(AB_VMSPageSize));\n if (NewFileSize < vmsSwapFileSize) then\n vmsSwapFileSize := NewFileSize;\n {ignore the swap file itself}\n end;\n vmsSize := NewSize;\n if (vmsPosition > NewSize) then\n vmsPosition := NewSize;\nend;\n{--------}\nfunction TAbVirtualMemoryStream.vmsAlterPageList(aNewMem : Longword) : Longword;\nvar\n NumPages : Longint;\n Page : PvmsPage;\n i : integer;\n OldestPageNum : Longint;\nbegin\n {calculate the max number of pages required}\n if aNewMem = 0 then\n NumPages := 1 // always have at least one page\n else\n NumPages := pred(aNewMem + AB_VMSPageSize) div AB_VMSPageSize;\n if (NumPages > AB_VMSMaxPages) then\n NumPages := AB_VMSMaxPages;\n {if the maximum number of pages means we have to shrink the current\n list, do so, tossing out the oldest pages first}\n if (NumPages < vmsPageList.Count) then\n begin\n for i := 1 to (vmsPageList.Count - NumPages) do begin\n {find the oldest page}\n vmsFindOldestPage(OldestPageNum, Page);\n {if it is dirty, write it out to the swap file}\n if Page^.vpDirty then begin\n vmsSwapFileWrite(Page);\n end;\n {remove it from the page list}\n vmsPageList.Delete(OldestPageNum);\n {free the page memory}\n Dispose(Page);\n end;\n\n { Reset cache to the first page in case the cached page was deleted. }\n vmsCachePage := vmsPageList[0];\n end;\n {remember our new max number of pages}\n vmsMaxPages := NumPages;\n Result := NumPages * AB_VMSPageSize;\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.vmsFindOldestPage(out OldestInx : Longint;\n out OldestPage: PvmsPage);\nvar\n OldestLRU : Longint;\n Inx : integer;\n Page : PvmsPage;\nbegin\n OldestInx := -1;\n OldestLRU := LastLRUValue;\n for Inx := 0 to pred(vmsPageList.Count) do begin\n Page := PvmsPage(vmsPageList[Inx]);\n if (Page^.vpLRU < OldestLRU) then begin\n OldestInx := Inx;\n OldestLRU := Page^.vpLRU;\n OldestPage := Page;\n end;\n end;\nend;\n{--------}\nfunction TAbVirtualMemoryStream.vmsGetNextLRU : Longint;\nvar\n Inx : integer;\nbegin\n if (vmsLRU = LastLRUValue) then begin\n {reset all LRUs in list}\n for Inx := 0 to pred(vmsPageList.Count) do\n PvmsPage(vmsPageList[Inx])^.vpLRU := 0;\n vmsLRU := 0;\n end;\n inc(vmsLRU);\n Result := vmsLRU;\nend;\n{--------}\nfunction TAbVirtualMemoryStream.vmsGetPageForOffset(aOffset : Int64) : PvmsPage;\nvar\n Page : PvmsPage;\n PageOfs : Int64;\n L, M, R : integer;\n OldestPageNum : integer;\n CreatedNewPage: boolean;\nbegin\n {using a sequential or a binary search (depending on the number of\n pages), try to find the page in the cache; we'll do a sequential\n search if the number of pages is very small, eg less than 4}\n if (vmsPageList.Count < 4) then begin\n L := vmsPageList.Count;\n for M := 0 to pred(vmsPageList.Count) do begin\n Page := PvmsPage(vmsPageList[M]);\n PageOfs := Page^.vpStmOfs;\n if (aOffset < PageOfs) then begin\n L := M;\n Break;\n end;\n if (aOffset = PageOfs) then begin\n Page^.vpLRU := vmsGetNextLRU;\n vmsCachePage := Page;\n Result := Page;\n Exit;\n end;\n end;\n end\n else {we need to do a binary search} begin\n L := 0;\n R := pred(vmsPageList.Count);\n repeat\n M := (L + R) div 2;\n Page := PvmsPage(vmsPageList[M]);\n PageOfs := Page^.vpStmOfs;\n if (aOffset < PageOfs) then\n R := pred(M)\n else if (aOffset > PageOfs) then\n L := succ(M)\n else {aOffset = PageOfs} begin\n Page^.vpLRU := vmsGetNextLRU;\n vmsCachePage := Page;\n Result := Page;\n Exit;\n end;\n until (L > R);\n end;\n {if we get here the page for the offset is not present in the page\n list, and once created/loaded, the page should be inserted at L}\n\n {enter a try..except block so that if a new page is created and an\n exception occurs, the page is freed}\n CreatedNewPage := false;\n Result := nil;\n try\n {if there is room to insert a new page, create one ready}\n if (vmsPageList.Count < vmsMaxPages) then begin\n New(Page);\n CreatedNewPage := true;\n end\n {otherwise there is no room for the insertion, so find the oldest\n page in the list and discard it}\n else {vmsMaxPages <= vmsPageList.Count} begin\n {find the oldest page}\n vmsFindOldestPage(OldestPageNum, Page);\n {if it is dirty, write it out to the swap file}\n if Page^.vpDirty then begin\n vmsSwapFileWrite(Page);\n end;\n {remove it from the page list}\n vmsPageList.Delete(OldestPageNum);\n {patch up the insertion point, in case the page just deleted was\n before it}\n if (OldestPageNum < L) then\n dec(L);\n end;\n {set all the page fields}\n with Page^ do begin\n vpStmOfs := aOffset;\n vpLRU := vmsGetNextLRU;\n vpDirty := False;\n vmsSwapFileRead(Page);\n end;\n {insert the page into the correct spot}\n vmsPageList.Insert(L, pointer(Page));\n {return the page, remembering to save it in the cache}\n vmsCachePage := Page;\n Result := Page;\n except\n if CreatedNewPage then\n Dispose(Page);\n end;{try..except}\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.vmsSetMaxMemToUse(aNewMem : Longword);\nbegin\n vmsMaxMemToUse := vmsAlterPageList(aNewMem);\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.vmsSwapFileCreate;\nbegin\n if (vmsSwapStream = nil) then begin\n vmsSwapFileName := AbCreateTempFile(vmsSwapFileDir);\n try\n vmsSwapStream := TFileStream.Create(vmsSwapFileName, fmCreate);\n except\n DeleteFile(vmsSwapFileName);\n raise EAbVMSErrorOpenSwap.Create( vmsSwapFileName );\n end;\n vmsSwapFileSize := 0;\n end;\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.vmsSwapFileDestroy;\nbegin\n if (vmsSwapStream <> nil) then begin\n FreeAndNil(vmsSwapStream);\n DeleteFile(vmsSwapFileName);\n end;\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.vmsSwapFileRead(aPage : PvmsPage);\nvar\n BytesRead : Longint;\n SeekResult: Int64;\nbegin\n if (vmsSwapStream = nil) or (aPage^.vpStmOfs >= vmsSwapFileSize) then begin\n {there is nothing to be read from the disk (either the swap file\n doesn't exist or it's too small) so zero out the page data}\n FillChar(aPage^.vpData, AB_VMSPageSize, 0)\n end\n else {there is something to be read from the swap file} begin\n SeekResult := vmsSwapStream.Seek(aPage^.vpStmOfs, soBeginning);\n if (SeekResult = -1) then\n raise EAbVMSSeekFail.Create( vmsSwapFileName );\n BytesRead := vmsSwapStream.Read(aPage^.vpData, AB_VMSPageSize);\n if (BytesRead <> AB_VMSPageSize) then\n raise EAbVMSReadFail.Create( AB_VMSPageSize, vmsSwapFileName );\n end;\nend;\n{--------}\nprocedure TAbVirtualMemoryStream.vmsSwapFileWrite(aPage : PvmsPage);\nvar\n NewPos : Int64;\n SeekResult: Int64;\n BytesWritten : Longint;\nbegin\n if (vmsSwapStream = nil) then\n vmsSwapFileCreate;\n SeekResult := vmsSwapStream.Seek(aPage^.vpStmOfs, soBeginning);\n if (SeekResult = -1) then\n raise EAbVMSSeekFail.Create( vmsSwapFileName );\n BytesWritten := vmsSwapStream.Write(aPage^.vpData, AB_VMSPageSize);\n if BytesWritten <> AB_VMSPageSize then\n raise EAbVMSWriteFail.Create( AB_VMSPageSize, vmsSwapFileName ); \n NewPos := aPage^.vpStmOfs + AB_VMSPageSize;\n if (NewPos > vmsSwapFileSize) then\n vmsSwapFileSize := NewPos;\nend;\n{--------}\nfunction TAbVirtualMemoryStream.Write(const Buffer; Count : Longint) : Longint;\nvar\n BufPtr : PByte;\n Page : PvmsPage;\n PageDataInx : integer;\n Posn : Int64;\n BytesToGo : Int64;\n BytesToWrite: Int64;\n StartOfs : Int64;\nbegin\n {writing is complicated by the fact we can only write in chunks of\n AB_VMSPageSize: we need to partition out the overall write into a\n write to a partial page, zero or more writes to complete pages and\n then a possible write to a partial page}\n\n {initialise some variables, note that the complex calc in the\n expression for PageDataInx is the offset of the start of the page\n where Posn is found.}\n BufPtr := @Buffer;\n Posn := vmsPosition;\n PageDataInx := Posn - (Posn and (not pred(AB_VMSPageSize)));\n BytesToWrite := AB_VMSPageSize - PageDataInx;\n {calculate the actual number of bytes to write}\n BytesToGo := Count;\n Result := BytesToGo;\n\n {while we have bytes to write, write them}\n while (BytesToGo <> 0) do begin\n if (BytesToWrite > BytesToGo) then\n BytesToWrite := BytesToGo;\n StartOfs := Posn and (not pred(AB_VMSPageSize));\n if (vmsCachePage^.vpStmOfs = StartOfs) then\n Page := vmsCachePage\n else\n Page := vmsGetPageForOffset(StartOfs);\n Move(BufPtr^, Page^.vpData[PageDataInx], BytesToWrite);\n Page^.vpDirty := True;\n dec(BytesToGo, BytesToWrite);\n inc(Posn, BytesToWrite);\n inc(BufPtr, BytesToWrite);\n PageDataInx := 0;\n BytesToWrite := AB_VMSPageSize;\n end;\n {remember our new position}\n vmsPosition := Posn;\n {if we've grown the stream, make a note of it}\n if (vmsPosition > vmsSize) then\n vmsSize := vmsPosition;\nend;\n{====================================================================}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbView.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbView.pas *}\n{*********************************************************}\n{* ABBREVIA: Base archive viewer component *}\n{* Use AbQView.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbView;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n Types,\n{$IFDEF MSWINDOWS}\n Windows,\n Messages,\n{$ENDIF}\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n{$IFDEF UsingCLX }\n Qt,\n QControls,\n QGraphics,\n QGrids,\n{$ELSE}\n Controls,\n Graphics,\n Grids,\n{$ENDIF}\n AbArcTyp;\n\ntype\n TAbViewAttribute =\n (vaItemName, vaPacked, vaMethod, vaRatio, vaCRC,\n vaFileAttributes, vaFileType, vaEncryption, vaTimeStamp,\n vaFileSize, vaVersionMade, vaVersionNeeded, vaPath);\n TAbViewAttributes = set of TAbViewAttribute;\n\n TAbDisplayOption =\n (doAlternateColors, doColLines, doColMove, doColSizing, doMultiSelect,\n doRowLines, doShowIcons, doThumbTrack, doTrackActiveRow);\n TAbDisplayOptions = set of TAbDisplayOption;\n\n TAbSortAttribute =\n (saItemName, saPacked, saPath, saRatio, saTimeStamp, saFileSize);\n TAbSortAttributes = set of TAbSortAttribute;\n\nconst\n AbDefColWidth = 150;\n AbDefRowHeight = 24;\n AbHeaderRow = 0;\n AbDefSelColor = clHighlight;\n AbDefSelTextColor = clHighlightText;\n AbDefHighColor = clAqua;\n AbDefHighTextColor = clRed;\n AbDefDelColor = clYellow;\n AbDefDelTextColor = clNavy;\n\n\n{ ===== TAbColors ========================================================== }\ntype\n TAbColors = class(TPersistent)\n protected {private}\n FSelected : TColor;\n FSelectedText : TColor;\n FAlternate : TColor;\n FAlternateText : TColor;\n FDeleted : TColor;\n FDeletedText : TColor;\n FUpdating : Boolean;\n FOnChange : TNotifyEvent;\n procedure DoOnChange;\n procedure SetSelected(Value : TColor);\n procedure SetSelectedText(Value : TColor);\n procedure SetAlternate(Value : TColor);\n procedure SetAlternateText(Value : TColor);\n procedure SetDeleted(Value : TColor);\n procedure SetDeletedText(Value : TColor);\n public\n procedure BeginUpdate;\n procedure EndUpdate;\n property OnChange : TNotifyEvent\n read FOnChange\n write FOnChange;\n published\n property Selected : TColor\n read FSelected\n write SetSelected;\n property SelectedText : TColor\n read FSelectedText\n write SetSelectedText;\n property Alternate : TColor\n read FAlternate\n write SetAlternate;\n property AlternateText : TColor\n read FAlternateText\n write SetAlternateText;\n property Deleted : TColor\n read FDeleted\n write SetDeleted;\n property DeletedText : TColor\n read FDeletedText\n write SetDeletedText;\n end;\n\n\n{ ===== TAbSelList ========================================================= }\ntype\n TAbSelList = class\n protected {private}\n FList : TList;\n FCurrent : Longint;\n public {methods}\n constructor Create;\n destructor Destroy;\n override;\n procedure Clear;\n procedure Deselect(Index : Longint);\n function IsSelected(Index : Longint) : Boolean;\n procedure Select(Index : Longint);\n procedure SelectAll(Count : Longint);\n function SelCount : Longint;\n procedure Toggle(Index : Longint);\n function FindFirst : Longint;\n function FindNext : Longint;\n end;\n\n\n{ ===== TAbRowMap ========================================================== }\ntype\n TAbRowMap = class\n protected {private}\n FRows : TList;\n FInvRows : TList;\n FSortAscending : Boolean;\n function GetRow(RowNum : Longint) : Longint;\n function GetInvRow(RowNum : Longint) : Longint;\n procedure SortOnItemName(ItemList : TAbArchiveList);\n procedure SortOnItemDir(ItemList : TAbArchiveList);\n public {methods}\n constructor Create;\n destructor Destroy;\n override;\n procedure Clear;\n procedure Init(RowCount : Longint);\n procedure SortBy(Attr : TAbSortAttribute; ItemList : TAbArchiveList);\n public {properties}\n property Rows[RowNum : Longint] : Longint\n read GetRow; default;\n property InvRows[RowNum : Longint] : Longint\n read GetInvRow;\n property SortAscending : Boolean\n read FSortAscending;\n end;\n\n\n{ ===== TAbBaseViewer ==================================================== }\ntype\n TAbColHeadings = class(TStringList)\n end;\n TAbSortedEvent =\n procedure (Sender : TObject; Attr : TAbViewAttribute) of object;\n TAbDrawSortArrowEvent =\n procedure (Sender : TObject; Column : Integer; Ascending: Boolean;\n Cnv: TCanvas; Rect : TRect) of object;\n\n TAbBaseViewer = class(TCustomGrid)\n protected {private}\n FAllowInvalidate : Boolean;\n FAttributes : TAbViewAttributes;\n FDisplayOptions : TAbDisplayOptions;\n FSortAttributes : TAbSortAttributes;\n FColMap : array[TAbViewAttribute] of Integer;\n FColSizing : Boolean;\n FColMoving : Boolean;\n FHeadings : TAbColHeadings;\n FItemList : TAbArchiveList;\n FRowMap : TAbRowMap;\n FFileName : string;\n FFontSize : Integer;\n FItemIndex : Longint;\n FColors : TAbColors;\n FButtonDown : Boolean;\n FIcons : TStringList;\n FSelList : TAbSelList;\n FMultiSelecting : Boolean;\n FShiftState : TShiftState;\n FSortCol : Integer;\n RowAnchor : Longint;\n ViewMouseCoord : TGridCoord;\n\n FOnChange : TNotifyEvent;\n FOnClick : TNotifyEvent;\n FOnDblClick : TNotifyEvent;\n FOnSorted : TAbSortedEvent;\n FOnDrawSortArrow : TAbDrawSortArrowEvent;\n\n function AttrToSortAttribute(Attr : TAbViewAttribute;\n var SortAttr : TAbSortAttribute) : Boolean;\n function AttrToStr(Attr : TAbViewAttribute; aItem : TAbArchiveItem) : string;\n function ColMap(ColNum : Integer) : Integer;\n procedure ColorsChange(Sender : TObject);\n procedure DrawHeaderButton(ACol : Integer; const AText : string);\n procedure DrawSortArrow;\n function DrawTextFormat(Attr : TAbViewAttribute; var Rect : TRect) : Word;\n function GetCount : Longint;\n function GetActiveRow : Longint;\n function GetHeaderRowHeight : Integer;\n{$IFDEF MSWINDOWS}\n function GetIcon(const ItemName : string) : HIcon;\n{$ENDIF}\n{$IFDEF UsingClx}\n { no file type icons in Clx }\n{$ENDIF}\n function GetSelCount : Longint;\n function GetSelected(RowNum : Longint) : Boolean;\n function GetVersion : string;\n procedure InitColMap;\n procedure InvalidateRow(ARow: Longint);\n procedure MoveColumn(FromCol, ToCol : Integer);\n procedure RefreshCell(ARow, ACol: Longint);\n procedure RefreshRow(ARow: Longint);\n procedure SetActiveRow(RowNum : Longint);\n procedure SetAttributes(Value : TAbViewAttributes);\n procedure SetDisplayOptions(Value : TAbDisplayOptions);\n procedure SetSortAttributes(Value : TAbSortAttributes);\n procedure SetHeaderRowHeight(Value : Integer);\n procedure SetHeadings(Value: TAbColHeadings);\n procedure SetSelected(RowNum : Longint; Value : Boolean);\n procedure SetVersion(const Value : string);\n function UpdateColCount(Attributes : TAbViewAttributes) : Integer;\n{$IFDEF UsingCLX}\n procedure FontChanged; override;\n procedure SizeChanged(OldColCount, OldRowCount: Longint); override;\n{$ELSE}\n procedure WMSize(var Msg: TWMSize);\n message WM_SIZE;\n procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd);\n message WM_ERASEBKGND;\n procedure CMFontChanged(var Message: TMessage);\n message CM_FONTCHANGED;\n{$ENDIF UsingCLX}\n\n protected {overridden methods}\n procedure Click;\n override;\n procedure DblClick;\n override;\n procedure KeyDown(var Key: Word; Shift: TShiftState);\n override;\n procedure KeyUp(var Key: Word; Shift: TShiftState);\n override;\n procedure Loaded;\n override;\n procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y : Integer);\n override;\n procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);\n override;\n procedure MouseMove(Shift: TShiftState; X, Y: Integer);\n override;\n procedure ColumnMoved(FromIndex, ToIndex: Longint);\n override;\n{$IFDEF HasGridDrawingStyle}\n procedure Paint;\n override;\n{$ENDIF}\n procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);\n override;\n procedure TopLeftChanged;\n override;\n\n protected {virtual methods}\n procedure DoChange(Sender : TObject);\n virtual;\n procedure DoLoad(Sender : TObject);\n virtual;\n procedure DoSorted(Attr : TAbViewAttribute);\n virtual;\n\n protected {properties}\n property Attributes : TAbViewAttributes\n read FAttributes\n write SetAttributes;\n property DisplayOptions : TAbDisplayOptions\n read FDisplayOptions\n write SetDisplayOptions;\n property HeaderRowHeight : Integer\n read GetHeaderRowHeight\n write SetHeaderRowHeight;\n property Headings : TAbColHeadings\n read FHeadings\n write SetHeadings;\n property ItemList : TAbArchiveList\n read FItemList\n write FItemList;\n property SortAttributes : TAbSortAttributes\n read FSortAttributes\n write SetSortAttributes;\n property Version : string\n read GetVersion\n write SetVersion\n stored False;\n\n protected {events}\n property OnChange : TNotifyEvent\n read FOnChange\n write FOnChange;\n property OnClick : TNotifyEvent\n read FOnClick\n write FOnClick;\n property OnDblClick : TNotifyEvent\n read FOnDblClick\n write FOnDblClick;\n property OnSorted : TAbSortedEvent\n read FOnSorted\n write FOnSorted;\n property OnDrawSortArrow : TAbDrawSortArrowEvent\n read FOnDrawSortArrow\n write FOnDrawSortArrow;\n\n public {methods}\n constructor Create(AOwner : TComponent);\n override;\n destructor Destroy;\n override;\n procedure BeginUpdate;\n procedure EndUpdate;\n procedure ClearSelections;\n procedure SelectAll;\n\n public {run-time properties}\n property ActiveRow : Longint\n read GetActiveRow write SetActiveRow;\n property Colors : TAbColors\n read FColors write FColors;\n property Count : Longint\n read GetCount;\n property SelCount : Longint\n read GetSelCount;\n property Selected[RowNum : Longint] : Boolean\n read GetSelected write SetSelected;\n\n property ColWidths;\n property RowHeights;\n published\n property OnDragDrop;\n property OnDragOver;\n end;\n\n\nimplementation\n\nuses\n{$IFDEF MSWINDOWS}\n ShellApi,\n{$ENDIF}\n{$IFDEF HasUITypes}\n UITypes,\n{$ENDIF}\n SysUtils,\n AbUtils,\n AbConst,\n AbResString,\n AbZipTyp;\n\n{ ===== TAbColors ========================================================== }\nprocedure TAbColors.BeginUpdate;\nbegin\n FUpdating := True;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.EndUpdate;\nbegin\n FUpdating := False;\n DoOnChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.DoOnChange;\nbegin\n if not FUpdating and Assigned(FOnChange) then\n FOnChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.SetSelected(Value : TColor);\nbegin\n if (Value <> FSelected) then begin\n FSelected := Value;\n DoOnChange;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.SetSelectedText(Value : TColor);\nbegin\n if (Value <> FSelectedText) then begin\n FSelectedText := Value;\n DoOnChange;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.SetAlternate(Value : TColor);\nbegin\n if (Value <> FAlternate) then begin\n FAlternate := Value;\n DoOnChange;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.SetAlternateText(Value : TColor);\nbegin\n if (Value <> FAlternateText) then begin\n FAlternateText := Value;\n DoOnChange;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.SetDeleted(Value : TColor);\nbegin\n if (Value <> FDeleted) then begin\n FDeleted := Value;\n DoOnChange;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbColors.SetDeletedText(Value : TColor);\nbegin\n if (Value <> FDeletedText) then begin\n FDeletedText := Value;\n DoOnChange;\n end;\nend;\n\n\n{ ===== TAbSelList ========================================================= }\nconstructor TAbSelList.Create;\nbegin\n FList := TList.Create;\n FCurrent := -1;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbSelList.Destroy;\nbegin\n FList.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbSelList.Clear;\nbegin\n FList.Clear;\n FCurrent := -1;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbSelList.Select(Index: Longint);\nbegin\n if FList.IndexOf(Pointer(Index)) < 0 then\n FList.Add(Pointer(Index));\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbSelList.Deselect(Index: Longint);\nvar\n i : Longint;\nbegin\n i := FList.IndexOf(Pointer(Index));\n if (i >= 0) then\n FList.Delete(i);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbSelList.IsSelected(Index : Longint) : Boolean;\nbegin\n Result := FList.IndexOf(Pointer(Index)) >= 0;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbSelList.Toggle(Index: Longint);\nbegin\n if IsSelected(Index) then\n Deselect(Index)\n else\n Select(Index);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbSelList.SelCount : Longint;\nbegin\n Result := FList.Count;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbSelList.SelectAll(Count : Longint);\nvar\n i : Longint;\nbegin\n for i := 0 to Pred(Count) do\n Select(i);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbSelList.FindFirst : Longint;\nbegin\n FCurrent := -1;\n if (FList.Count > 0) then\n Result := FindNext\n else\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbSelList.FindNext : Longint;\nbegin\n if (FList.Count > 0) and (FCurrent < Pred(FList.Count)) then begin\n Inc(FCurrent);\n Result := Longint(FList[FCurrent]);\n end else\n Result := -1;\nend;\n\n\n{ ===== TAbRowMap ========================================================== }\nprocedure TAbRowMap.Clear;\nbegin\n FRows.Clear;\n FInvRows.Clear;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbRowMap.GetRow(RowNum : Longint) : Longint;\nbegin\n if (RowNum >= 0) and (RowNum < FRows.Count) then\n Result := Longint(FRows[RowNum])\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbRowMap.GetInvRow(RowNum : Longint) : Longint;\nbegin\n if (RowNum >= 0) and (RowNum < FInvRows.Count) then\n Result := Longint(FInvRows[RowNum])\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nconstructor TAbRowMap.Create;\nbegin\n inherited Create;\n FRows := TList.Create;\n FInvRows := TList.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbRowMap.Init(RowCount : Longint);\nvar\n i : Longint;\nbegin\n Clear;\n if (RowCount > 0) then\n for i := 0 to Pred(RowCount) do begin\n FRows.Add(Pointer(i));\n FInvRows.Add(Pointer(i));\n end;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbRowMap.Destroy;\nbegin\n FRows.Free;\n FInvRows.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbRowMap.SortBy(Attr : TAbSortAttribute; ItemList : TAbArchiveList);\ntype\n PSortRec = ^TSortRec;\n TSortRec = record\n Val : Double;\n Index : Longint;\n end;\nvar\n i, LI : Longint;\n SL : TList;\n RowCount : Longint;\n P : PSortRec;\n DT : TDateTime;\n aItem : TAbArchiveItem;\n\n procedure QuickSort(SL : TList; L, R: Integer);\n var\n i, j: Integer;\n P: PSortRec;\n begin\n i := L;\n j := R;\n P := SL[(L + R) shr 1];\n repeat\n while PSortRec(SL[i])^.Val < P^.Val do Inc(i);\n while PSortRec(SL[j])^.Val > P^.Val do Dec(j);\n if (i <= j) then\n begin\n SL.Exchange(i, j);\n Inc(i);\n Dec(j);\n end;\n until i > j;\n if L < j then QuickSort(SL, L, j);\n if i < R then QuickSort(SL, i, R);\n end;\n\nbegin\n if (ItemList.Count <= 0) then\n Exit;\n case Attr of\n saItemName : SortOnItemName(ItemList);\n saPath : SortOnItemDir(ItemList);\n else begin\n RowCount := ItemList.Count;\n SL := TList.Create;\n try {SL}\n SL.Capacity := RowCount;\n for i := 0 to Pred(RowCount) do begin\n GetMem(P, SizeOf(TSortRec));\n aItem := TAbArchiveItem(ItemList.Items[i]);\n case Attr of\n saPacked : P^.Val := aItem.CompressedSize;\n saRatio :\n begin\n if (aItem is TAbZipItem) then\n P^.Val := TAbZipItem(aItem).CompressionRatio\n else\n P^.Val := 0;\n end;\n saFileSize : P^.Val := aItem.UnCompressedSize;\n saTimeStamp : begin\n LI := LongInt(aItem.LastModFileDate) shl 16 +\n aItem.LastModFileTime;\n DT := FileDateToDateTime(LI);\n P^.Val := Double(DT);\n end;\n end;\n P^.Index := i;\n SL.Add(P);\n end;\n QuickSort(SL, 0, Pred(SL.Count));\n for i := 0 to Pred(SL.Count) do begin\n if FSortAscending then\n P := SL[i]\n else\n P := SL[Pred(SL.Count) - i];\n FRows[i] := Pointer(P^.Index)\n end;\n finally {SL}\n while (SL.Count > 0) do begin\n FreeMem(SL[0], Sizeof(TSortRec));\n SL.Delete(0);\n end;\n SL.Free;\n end; {SL}\n end;\n end;\n\n FSortAscending := not FSortAscending;\n for i := 0 to Pred(ItemList.Count) do\n FInvRows[Rows[i]] := Pointer(i);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbRowMap.SortOnItemName(ItemList : TAbArchiveList);\nvar\n i, RowCount : Longint;\n SL : TStringList;\n FN : string;\nbegin\n RowCount := ItemList.Count;\n SL := TStringList.Create;\n try {SL}\n for i := 0 to Pred(RowCount) do begin\n FN := TAbArchiveItem(ItemList.Items[i]).Filename;\n AbUnFixName(FN);\n SL.AddObject(ExtractFilename(FN), Pointer(i));\n end;\n SL.Sort;\n for i := 0 to Pred(RowCount) do begin\n if FSortAscending then\n FRows[i] := SL.Objects[i]\n else\n FRows[i] := SL.Objects[Pred(RowCount) - i];\n end;\n finally {SL}\n SL.Free;\n end; {SL}\nend;\n\n{ -------------------------------------------------------------------------- }\nprocedure TAbRowMap.SortOnItemDir(ItemList : TAbArchiveList);\nvar\n i, RowCount : Longint;\n SL : TStringList;\n FN : string;\nbegin\n RowCount := ItemList.Count;\n SL := TStringList.Create;\n try {SL}\n for i := 0 to Pred(RowCount) do begin\n FN := TAbArchiveItem(ItemList.Items[i]).DiskPath;\n AbUnFixName(FN);\n SL.AddObject(ExtractFilePath(FN), Pointer(i));\n end;\n SL.Sort;\n for i := 0 to Pred(RowCount) do begin\n if FSortAscending then\n FRows[i] := SL.Objects[i]\n else\n FRows[i] := SL.Objects[Pred(RowCount) - i];\n end;\n finally {SL}\n SL.Free;\n end; {SL}\nend;\n\n{===== TAbBaseViewer ===============================================}\nconstructor TAbBaseViewer.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\n\n FItemList := TAbArchiveList.Create(False);\n\n RowCount := 2;\n FixedCols := 0;\n FixedRows := 1; {Header Row}\n FSortCol := -1;\n Color := clWindow;\n FColors := TAbColors.Create;\n FColors.OnChange := ColorsChange;\n FColors.Selected := AbDefSelColor;\n FColors.SelectedText := AbDefSelTextColor;\n FColors.Alternate := AbDefHighColor;\n FColors.AlternateText := AbDefHighTextColor;\n FColors.Deleted := AbDefDelColor;\n FColors.DeletedText := AbDefDelTextColor;\n DefaultColWidth := AbDefColWidth;\n DefaultRowHeight := AbDefRowHeight;\n DefaultDrawing := False;\n ParentColor := False;\n{$IFNDEF UsingCLX}\n ParentCtl3D := True;\n{$ENDIF}\n ParentFont := True;\n ParentShowHint := True;\n FHeadings := TAbColHeadings.Create;\n InitColMap;\n FColSizing := False;\n FColMoving := False;\n FAllowInvalidate := True;\n FRowMap := TAbRowMap.Create;\n FIcons := TStringList.Create;\n FSelList := TAbSelList.Create;\n Attributes := [vaItemname, vaPacked, vaTimeStamp, vaFileSize, vaPath];\n SetDisplayOptions([doColSizing]);\n Visible := True;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbBaseViewer.Destroy;\nbegin\n FRowMap.Free;\n FHeadings.Free;\n FColors.Free;\n FIcons.Free;\n FSelList.Free;\n FItemList.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.AttrToSortAttribute(Attr : TAbViewAttribute;\n var SortAttr : TAbSortAttribute) : Boolean;\nbegin\n Result := True;\n case Attr of\n vaItemName : SortAttr := saItemName;\n vaPacked : SortAttr := saPacked;\n vaFileSize : SortAttr := saFileSize;\n vaRatio : SortAttr := saRatio;\n vaTimeStamp : SortAttr := saTimeStamp;\n vaPath : SortAttr := saPath;\n else\n Result := False;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.AttrToStr(Attr : TAbViewAttribute;\n aItem : TAbArchiveItem) : string;\nvar\n FN : string;\n LI : Longint;\nbegin\n Result := '';\n if Attr in [vaItemName, vaPath] then begin\n FN := aItem.Filename;\n AbUnFixName(FN);\n end;\n\n {first take care of common attributes}\n with aItem do case Attr of\n vaCRC :\n Result := IntToHex(CRC32, 8);\n vaItemname :\n Result := ExtractFilename(FN);\n vaPacked :\n Result := IntToStr(CompressedSize);\n vaFileSize :\n Result := IntToStr(UncompressedSize);\n vaFileAttributes :\n begin\n{$IFDEF MSWINDOWS}\n{$WARN SYMBOL_PLATFORM OFF}\n if (faReadOnly and ExternalFileAttributes) = faReadOnly then\n Result := Result + AbReadOnlyS;\n if (faHidden and ExternalFileAttributes) = faHidden then\n Result := Result + AbHiddenS;\n if (faSysFile and ExternalFileAttributes) = faSysFile then\n Result := Result + AbSystemS;\n if (faArchive and ExternalFileAttributes) = faArchive then\n Result := Result + AbArchivedS;\n{$WARN SYMBOL_PLATFORM OFF}\n{$ENDIF MSWINDOWS}\n end;\n vaEncryption :\n if IsEncrypted then\n Result := AbEncryptedS;\n vaTimeStamp :\n if (LastModFileDate + LastModFileTime = 0) then\n Result := AbUnknownS\n else begin\n LI := LongInt(LastModFileDate) shl 16 + LastModFileTime;\n Result := DateTimeToStr(FileDateToDateTime(LI));\n end;\n vaPath :\n Result := DiskPath;\n end;\n\n {now handle the zip specific attributes}\n if (aItem is TAbZipItem) then with TAbZipItem(aItem) do case Attr of\n vaFileType :\n if (InternalFileAttributes = 1) then\n Result := AbTextS\n else\n Result := AbBinaryS;\n vaMethod :\n Result := ZipCompressionMethodToString(CompressionMethod);\n vaRatio :\n Result := IntToStr(Round(CompressionRatio));\n vaVersionMade :\n Result := IntToStr(Round(Lo(VersionMadeBy)/ 10.0));\n vaVersionNeeded :\n Result := IntToStr(Round(Lo(VersionNeededToExtract)/ 10.0));\n end;\n{$IFDEF LINUX}\n Result := ' ' + Result;\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.BeginUpdate;\nbegin\n FAllowInvalidate := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.EndUpdate;\nbegin\n FAllowInvalidate := True;\n Refresh;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.ClearSelections;\nvar\n i : Longint;\nbegin\n if (FSelList.SelCount > 0) then begin\n i := FSelList.FindFirst;\n repeat\n InvalidateRow(FRowMap.InvRows[i]+1);\n i := FSelList.FindNext;\n until (i < 0);\n FSelList.Clear;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.Click;\n {Here is the logic for MultiSelect}\nvar\n i : Longint;\nbegin\n inherited Click;\n if Assigned(FItemList) and (FItemList.Count > 0) then begin\n if (ssCtrl in FShiftState) and (doMultiSelect in FDisplayOptions) then\n Selected[ActiveRow] := not Selected[ActiveRow]\n else begin\n if not ((ssShift in FShiftState) and\n (doMultiSelect in FDisplayOptions)) then begin\n ClearSelections;\n Selected[ActiveRow] := True;\n end else begin\n ClearSelections;\n if (RowAnchor < ActiveRow) then\n for i := RowAnchor to ActiveRow do\n Selected[i] := True\n else\n for i := ActiveRow to RowAnchor do\n Selected[i] := True;\n end;\n end;\n Update;\n if Assigned(FOnClick) then\n FOnClick(Self);\n end;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF UsingCLX}\nprocedure TAbBaseViewer.FontChanged;\n{$ELSE}\nprocedure TAbBaseViewer.CMFontChanged(var Message: TMessage);\n{$ENDIF}\nbegin\n inherited;\n if not (csLoading in ComponentState) then begin\n Canvas.Font := Font;\n DefaultRowHeight := Canvas.TextHeight('W') + 2;\n HeaderRowHeight := Canvas.TextHeight('W') + 4;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.ColMap(ColNum : Integer) : Integer;\nbegin\n Result := FColMap[TAbViewAttribute(ColNum)];\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.ColorsChange(Sender : TObject);\nbegin\n Invalidate;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.ColumnMoved(FromIndex, ToIndex : Longint);\nbegin\n MoveColumn(FromIndex, ToIndex);\n Invalidate;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DblClick;\n {Dont pass along the event if double click in header}\nbegin\n inherited DblClick;\n if (ViewMouseCoord.Y <> abHeaderRow) then\n if Assigned(FItemList) and (FItemList.Count > 0) then\n if Assigned(FOnDblClick) then\n FOnDblClick(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DoChange;\nbegin\n RowCount := 2; {HeaderRow + 1}\n FSelList.Clear;\n if Assigned(FItemList) then begin\n FRowMap.Init(FItemList.Count);\n if (FItemList.Count > 0) then\n RowCount := FItemList.Count + 1\n else begin\n{ RefreshRow(1);}\n FSortCol := -1;\n end;\n end;\n if FAllowInvalidate then\n Refresh;\n if Assigned(FOnChange) then\n FOnChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DoLoad;\nbegin\n FIcons.Clear;\n FSelList.Clear;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DoSorted(Attr : TAbViewAttribute);\nbegin\n DrawSortArrow;\n if Assigned(FOnSorted) then\n FOnSorted(Self, Attr);\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF HasGridDrawingStyle}\nprocedure TAbBaseViewer.Paint;\nbegin\n DefaultDrawing := FInternalDrawingStyle <> gdsClassic;\n inherited;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DrawCell(ACol, ARow: Longint; ARect: TRect;\n AState: TGridDrawState);\nvar\n s : string;\n aItem : TAbArchiveItem;\n TxtRect : TRect;\n Attr : TAbViewAttribute;\n DTFormat : Word;\n{$IFNDEF UsingClx}\n H : Integer;\n Icon : HIcon;\n{$ENDIF}\nbegin\n{$IFDEF LINUX}\n if not DefaultDrawing then\n DefaultDrawing := true;\n{$ENDIF}\n\n Canvas.Font := Font;\n if (ARow = AbHeaderRow) then begin\n DrawHeaderButton(ACol, FHeadings[ColMap(ACol)])\n end else if not FAllowInvalidate then {waiting for EndUpdate}\n Exit\n else with Canvas do begin\n if not (doColLines in DisplayOptions) then\n ARect.Right := ARect.Right + 1;\n Brush.Color := clWindow;\n if (not Assigned(FItemList)) or (FItemList.Count = 0) then begin\n if not DefaultDrawing then Canvas.FillRect(ARect);\n Exit;\n end;\n\n aItem := FItemList.Items[FRowMap[ARow-1]];\n Attr := TAbViewAttribute(ColMap(ACol));\n S := AttrToStr(Attr, aItem);\n if (gdSelected in AState) or FSelList.IsSelected(FRowMap[ARow-1]) then begin\n if not DefaultDrawing then begin\n Brush.Color := FColors.Selected;\n Font.Color := FColors.SelectedText;\n end\n{$IFDEF HasGridDrawingStyle}\n else begin\n if DrawingStyle = gdsGradient then\n Canvas.Font.Color := clHighlightText;\n if not (gdSelected in AState) then begin\n if (goRowSelect in Options) then\n Include(AState, gdRowSelected);\n DrawCellHighlight(ARect, AState, ACol, ARow);\n end;\n end;\n{$ENDIF}\n end else if aItem.Action = aaDelete then begin\n Brush.Color := FColors.Deleted;\n Font.Color := FColors.DeletedText;\n end else if ((doAlternateColors in FDisplayOptions) and\n not Odd(ARow)) then begin\n Brush.Color := FColors.Alternate;\n Font.Color := FColors.AlternateText;\n end;\n if not DefaultDrawing then\n Canvas.FillRect(ARect);\n Canvas.Brush.Style := bsClear;\n TxtRect := ARect;\n{$IFNDEF UsingCLX}\n Icon := 0;\n if (Attr = vaItemName) then\n Icon := GetIcon(aItem.Filename);\n if (Icon <> 0) then begin\n H := ARect.Bottom - ARect.Top;\n DrawIconEx(Canvas.Handle, ARect.Left+1, ARect.Top+1, Icon,\n H - 2, H - 2, 0, 0, DI_NORMAL);\n TxtRect.Left := TxtRect.Left + H;\n end;\n{$ENDIF}\n\n DTFormat := DrawTextFormat(Attr, TxtRect);\n{$IFNDEF UsingCLX}\n DrawText(Canvas.Handle, PChar(s), -1, TxtRect, DTFormat);\n{$ELSE}\n Canvas.TextRect(TxtRect, TxtRect.Left, TxtRect.Top, s, DTFormat);\n{$ENDIF}\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DrawHeaderButton(ACol : Integer; const AText : string);\nvar\n ARect : TRect;\n DTFormat : Word;\nbegin\n ARect := CellRect(ACol, 0);\n if not DefaultDrawing then with Canvas do begin\n Brush.Style := bsSolid;\n Brush.Color := clBtnface;\n FillRect(ARect);\n if FButtonDown then\n Pen.Color := clBtnHighlight\n else\n Pen.Color := clBtnShadow;\n MoveTo(ARect.Left, ARect.Bottom - 1);\n LineTo(ARect.Right - 1, ARect.Bottom - 1);\n LineTo(ARect.Right - 1, ARect.Top -1);\n if FButtonDown then\n Pen.Color := clBtnShadow\n else\n Pen.Color := clBtnHighlight;\n MoveTo(ARect.Left, ARect.Bottom - 2);\n LineTo(ARect.Left, ARect.Top);\n LineTo(ARect.Right - 1, ARect.Top);\n Brush.Style := bsClear;\n end;\n ARect.Right := ARect.Left + ColWidths[ACol];\n if FSortCol = ACol then\n ARect.Right := ARect.Right - 5 - (2 * (ARect.Bottom - ARect.Top) div 10);\n{$IFDEF UsingCLX}\n { prefix is off by default in Qt}\n DTFormat := Integer(AlignmentFlags_AlignVCenter) or\n Integer(AlignmentFlags_SingleLine) or\n Integer(AlignmentFlags_AlignHCenter);\n{$ELSE}\n DTFormat := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_CENTER;\n{$ENDIF}\n if FButtonDown then\n ARect := Rect(ARect.Left+1, ARect.Top+1, ARect.Right, ARect.Bottom);\n{$IFDEF UsingCLX}\n Canvas.TextRect(ARect, ARect.Left, ARect.Top, AText, DTFormat);\n{$ELSE}\n DrawText(Canvas.Handle, PChar(AText), -1, ARect, DTFormat);\n{$ENDIF}\n if FSortCol = ACol then\n DrawSortArrow;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.DrawSortArrow;\nvar\n ARect : TRect;\n SavedColor : TColor;\nbegin\n if (FSortCol > -1) then begin\n { set up Rect for the OnDrawSortArrow event }\n ARect := CellRect(FSortCol, 0);\n ARect.Top := (ARect.Bottom - ARect.Top) div 10;\n ARect.Bottom := ARect.Bottom - ARect.Top;\n ARect.Right := ARect.Left + ColWidths[FSortCol] - 5;\n ARect.Left := ARect.Right - ((ARect.Bottom - ARect.Top));\n\n if Assigned(FOnDrawSortArrow) then begin\n FOnDrawSortArrow(Self, FSortCol, FRowMap.SortAscending, Canvas, ARect);\n Exit;\n end;\n { make ARect smaller for our own drawing }\n inc(ARect.Left, 10);\n inc(ARect.Top, 5);\n dec(ARect.Bottom, 5);\n\n with Canvas do begin\n Pen.Color := clBtnShadow;\n\n SavedColor := Brush.Color;\n Brush.Color := clBtnFace;\n with ARect do\n if FRowMap.SortAscending then begin\n Polygon([Point(((Right-Left)div 2)+Left, Bottom), Point(Right, Top),\n Point(Left, Top)]);\n{$IFNDEF UsingCLX}\n if Ctl3D then begin\n Pen.Color := clBtnHighlight;\n MoveTo(((Right-Left)div 2)+Left, Bottom);\n LineTo(Right, Top);\n end;\n{$ENDIF}\n end else begin\n Polygon([Point(((Right-Left)div 2)+Left, Top), Point(Right, Bottom),\n Point(Left, Bottom)]);\n{$IFNDEF UsingCLX}\n if Ctl3D then begin\n Pen.Color := clBtnHighlight;\n MoveTo(((Right-Left)div 2)+Left, Top);\n LineTo(Right, Bottom);\n LineTo(Left, Bottom);\n Pen.Color := clBtnShadow;\n LineTo(((Right-Left)div 2)+Left, Top);\n end;\n{$ENDIF}\n end;\n Brush.Color := SavedColor;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.DrawTextFormat(Attr : TAbViewAttribute;\n var Rect : TRect) : Word;\nbegin\n{$IFDEF MSWINDOWS}\n Result := DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;\n case Attr of\n vaItemname : Result := Result or DT_LEFT;\n vaPacked : Result := Result or DT_RIGHT;\n vaFileSize : Result := Result or DT_RIGHT;\n vaMethod : Result := Result or DT_CENTER;\n vaRatio : Result := Result or DT_CENTER;\n vaCRC : Result := Result or DT_CENTER;\n vaFileAttributes : Result := Result or DT_CENTER;\n vaFileType : Result := Result or DT_CENTER;\n vaEncryption : Result := Result or DT_CENTER;\n vaTimeStamp : Result := Result or DT_LEFT;\n vaVersionMade : Result := Result or DT_CENTER;\n vaVersionNeeded : Result := Result or DT_CENTER;\n vaPath : Result := Result or DT_LEFT;\n end;\n if (Result and 3) = DT_LEFT then\n OffsetRect(Rect, 5, 0)\n else if (Result and 3) = DT_RIGHT then\n OffsetRect(Rect, -5, 0);\n{$ENDIF}\n{$IFDEF LINUX}\n Result := Integer(AlignmentFlags_AlignVCenter) or\n Integer(AlignmentFlags_SingleLine);\n case Attr of\n vaItemname : Result := Result or Integer(AlignmentFlags_AlignLeft);\n vaPacked : Result := Result or Integer(AlignmentFlags_AlignRight);\n vaFileSize : Result := Result or Integer(AlignmentFlags_AlignRight);\n vaMethod : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaRatio : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaCRC : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaFileAttributes : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaFileType : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaEncryption : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaTimeStamp : Result := Result or Integer(AlignmentFlags_AlignLeft);\n vaVersionMade : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaVersionNeeded : Result := Result or Integer(AlignmentFlags_AlignCenter);\n vaPath : Result := Result or Integer(AlignmentFlags_AlignLeft);\n end;\n{$ENDIF}\nend;\n\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.GetActiveRow : Longint;\nbegin\n Result := Row - 1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.GetCount : Longint;\nbegin\n if Assigned(FItemList) then\n Result := FItemList.Count\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.GetHeaderRowHeight : Integer;\nbegin\n Result := RowHeights[AbHeaderRow];\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF MSWINDOWS}\nfunction TAbBaseViewer.GetIcon(const ItemName : string) : HIcon;\nvar\n i : Longint;\n t : string;\n sfi : SHFILEINFO;\nbegin\n Result := 0;\n if not (doShowIcons in FDisplayOptions) then\n Exit;\n t := ExtractFileExt(ItemName);\n i := FIcons.IndexOf(t);\n if (i > -1) then\n Result := HIcon(FIcons.Objects[i])\n else begin\n SHGetFileInfo(PChar(t), FILE_ATTRIBUTE_NORMAL, sfi, sizeof(sfi),\n SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);\n Result := sfi.hIcon;\n FIcons.AddObject(t, Pointer(Result));\n end;\nend;\n{$ENDIF}\n{$IFDEF UsingCLX }\n { no file type icons in CLX }\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.GetSelCount : Longint;\nbegin\n Result := FSelList.SelCount;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.GetSelected(RowNum : Longint) : Boolean;\nbegin\n if Assigned(FItemList) then\n Result := FSelList.IsSelected(FRowMap[RowNum])\n else\n Result := False;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.GetVersion : string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.InitColMap;\nconst\n cResString: array[TAbViewAttribute] of string = (AbItemNameHeadingS,\n AbPackedHeadingS, AbMethodHeadingS, AbRatioHeadingS, AbCRCHeadingS,\n AbFileAttrHeadingS, AbFileFormatHeadingS, AbEncryptionHeadingS,\n AbTimeStampHeadingS, AbFileSizeHeadingS, AbVersionMadeHeadingS,\n AbVersionNeededHeadingS, AbPathHeadingS);\nvar\n i : TAbViewAttribute;\nbegin\n FHeadings.Clear;\n for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin\n FHeadings.Add(cResString[i]);\n FColMap[i] := Ord(i);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.InvalidateRow(ARow: Longint);\nvar\n Rect: TRect;\nbegin\n if not HandleAllocated then\n Exit;\n if ((ARow < TopRow) or (ARow > TopRow + VisibleRowCount)) and (ARow <> 0) then\n Exit;\n Rect := CellRect(0, ARow);\n Rect.Right := ClientWidth;\n{$IFDEF UsingCLX}\n InvalidateRect(Rect, False);\n{$ELSE}\n InvalidateRect(Handle, @Rect, True);\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.KeyDown(var Key: Word; Shift: TShiftState);\nbegin\n FShiftState := Shift;\n inherited KeyDown(Key, Shift);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.KeyUp(var Key: Word; Shift: TShiftState);\nbegin\n FShiftState := Shift;\n inherited KeyUp(Key, Shift);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.Loaded;\nbegin\n inherited Loaded;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.MouseDown(Button: TMouseButton;\n Shift: TShiftState; X, Y : Integer);\n\n function GetMinLen(Col: Integer): Word;\n var\n I, L : Integer;\n s : String;\n aItem : TAbArchiveItem;\n Attr : TAbViewAttribute;\n Sorted : Boolean;\n begin\n Attr := TAbViewAttribute(ColMap(Col));\n Result := Canvas.TextWidth(FHeadings[ColMap(Col)]);\n case Attr of\n vaItemName : Sorted := saItemName in FSortAttributes;\n vaPacked : Sorted := saPacked in FSortAttributes;\n vaRatio : Sorted := saRatio in FSortAttributes;\n vaTimeStamp: Sorted := saTimeStamp in FSortAttributes;\n vaFileSize : Sorted := saFileSize in FSortAttributes;\n vaPath : Sorted := saPath in FSortAttributes;\n else Sorted := False;\n end;\n if Sorted then\n Result := Result + RowHeights[0] + 16\n else\n Result := Result + 8;\n\n if Assigned(FItemList) then\n for I := 0 to (FItemList.Count-1) do begin\n aItem := FItemList.Items[I];\n S := AttrToStr(Attr, aItem);\n L := Canvas.TextWidth(S) + 8;\n if (doShowIcons in FDisplayOptions) and (Attr = vaItemName) then\n inc(L, RowHeights[I]);\n if L > Result then\n Result := L;\n end;\n end;\n\nvar\n ACol : Longint;\n ARow : Longint;\n Rect : TRect;\nbegin\n ViewMouseCoord := MouseCoord(X, Y);\n inherited MouseDown(Button, Shift, X, Y);\n\n FShiftState := Shift;\n { handle double clicks on header row dividers }\n if (ssDouble in FShiftState) and (ViewMouseCoord.Y = AbHeaderRow) then begin\n FColSizing := True;\n Rect := CellRect(ViewMouseCoord.X, ViewMouseCoord.Y);\n Rect.Left := Rect.Right - 3;\n if PtInRect(Rect, Point(X, Y)) then begin\n ColWidths[MouseCoord(Rect.Left, Y).X] :=\n GetMinLen(MouseCoord(Rect.Left, Y).X)\n end\n else begin\n Rect := CellRect(ViewMouseCoord.X, ViewMouseCoord.Y);\n Rect.Right := Rect.Left + 4;\n if PtInRect(Rect, Point(X, Y)) then\n ColWidths[MouseCoord(Rect.Left, Y).X-1] :=\n GetMinLen(MouseCoord(Rect.Left, Y).X-1);\n end;\n end;\n\n { if grid is being resized }\n if (FGridState = gsColSizing) then begin\n FColSizing := True;\n Exit; {dont press button when resizing column}\n end;\n\n { refresh the headers}\n if Assigned(FItemList) then\n if (FItemList.Count > 0) then begin\n ARow := ViewMouseCoord.Y;\n ACol := ViewMouseCoord.X;\n if (ARow = abHeaderRow) then begin\n {if not (doColMove in FDisplayOptions) then}\n if not (doColMove in FDisplayOptions) and not FColSizing then\n FButtonDown := True;\n RefreshCell(0, ACol);\n end else if not (ssShift in Shift) then\n RowAnchor := ActiveRow;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.MouseUp(Button: TMouseButton;\n Shift: TShiftState; X, Y: Integer);\nvar\n ACol : Longint;\n ARow : Longint;\n Attr : TAbViewAttribute;\n SortAttribute : TAbSortAttribute;\nbegin\n inherited MouseUp(Button, Shift, X, Y);\n if csDesigning in ComponentState then Exit;\n\n FShiftState := Shift;\n FButtonDown := False;\n\n if FColSizing then begin\n Refresh;\n FColSizing := False;\n end else\n if Assigned(FItemList) then\n if (FItemList.Count > 0) then begin\n ARow := ViewMouseCoord.Y;\n ACol := ViewMouseCoord.X;\n if (ARow = abHeaderRow) then begin\n Attr := TAbViewAttribute(ColMap(ACol));\n if not FColMoving and\n AttrToSortAttribute(Attr, SortAttribute) and\n (SortAttribute in FSortAttributes) then begin\n FSortCol := ACol;\n FItemIndex := FRowMap[Row-1];\n FRowMap.SortBy(SortAttribute, FItemList);\n FButtonDown := False;\n RefreshCell(0, ACol);\n if (doTrackActiveRow in FDisplayOptions) then\n Row := FRowMap.InvRows[FItemIndex] + 1;\n Refresh;\n DoSorted(Attr);\n end else begin\n FButtonDown := False;\n RefreshCell(0, ACol);\n end;\n end else\n Paint;\n end;\n\n FColMoving := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.MouseMove(Shift: TShiftState; X, Y: Integer);\nbegin\n inherited MouseMove(Shift, X, Y);\n\n if (FGridState = gsColMoving) then\n FColMoving := True;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.MoveColumn(FromCol, ToCol : Integer);\nvar\n temp, i : Integer;\nbegin\n Temp := ColMap(FromCol);\n if (FromCol < ToCol) then begin\n for i := (FromCol + 1) to ToCol do\n FColMap[TAbViewAttribute(i-1)] := FColMap[TAbViewAttribute(i)]; {Shift left}\n end else begin\n for i := (FromCol - 1) downto ToCol do\n FColMap[TAbViewAttribute(i+1)] := FColMap[TAbViewAttribute(i)]; {Shift right}\n end;\n FColMap[TAbViewAttribute(ToCol)] := Temp;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.RefreshCell(ARow, ACol: Longint);\nvar\n Rect: TRect;\nbegin\n if not HandleAllocated then\n Exit;\n Rect := CellRect(ACol, ARow);\n{$IFDEF UsingCLX}\n InvalidateRect(Rect, False);\n{$ELSE}\n InvalidateRect(Handle, @Rect, False);\n{$ENDIF}\n Update;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.RefreshRow(ARow: Longint);\nbegin\n InvalidateRow(ARow);\n Update;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SelectAll;\nbegin\n if Assigned(FItemList) then\n if (FItemList.Count > 0) then begin\n FSelList.SelectAll(FItemList.Count);\n Invalidate;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetActiveRow(RowNum : Longint);\nbegin\n if Assigned(FItemList) then\n if (RowNum >= 0) and (RowNum < FItemList.Count) then\n Row := RowNum + 1;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetAttributes(Value : TAbViewAttributes);\nbegin\n FAttributes := Value;\n ColCount := UpdateColCount(FAttributes);\n DoChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetDisplayOptions(Value : TAbDisplayOptions);\n {maps DisplayOptions to TGridOptions}\nbegin\n FDisplayOptions := Value;\n Options := [goFixedVertLine, goFixedHorzLine, goRowSelect];\n{$IFDEF HasGridDrawingStyle}\n Options := Options + [goFixedRowClick]; // Highlight pressed header when themed\n{$ENDIF}\n\n if (doColLines in Value) then\n Options := Options + [goVertLine];\n if (doColMove in Value) then\n Options := Options + [goColMoving];\n if (doColSizing in Value) then\n Options := Options + [goColSizing];\n if (doRowLines in Value) then\n Options := Options + [goHorzLine];\n if (doThumbTrack in Value) then\n Options := Options + [goThumbTracking];\n DoChange(nil);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetHeaderRowHeight(Value : Integer);\nbegin\n RowHeights[abHeaderRow] := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetHeadings(Value: TAbColHeadings);\nbegin\n Headings.Assign(Value);\n Refresh;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetSortAttributes(Value : TAbSortAttributes);\nbegin\n FSortAttributes := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetSelected(RowNum : Longint; Value: Boolean);\nbegin\n if Assigned(FItemList) then\n case Value of\n True : FSelList.Select(FRowMap[RowNum]);\n False : FSelList.Deselect(FRowMap[RowNum]);\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.SetVersion(const Value : string);\nbegin\n {NOP}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbBaseViewer.TopLeftChanged;\nbegin\n if FAllowInvalidate then\n Invalidate;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbBaseViewer.UpdateColCount(Attributes : TAbViewAttributes) : Integer;\nvar\n i : TAbViewAttribute;\nbegin\n Result := 0;\n for i := Low(TAbViewAttribute) to High(TAbViewAttribute) do begin\n if (i in Attributes) then begin\n FColMap[TAbViewAttribute(Result)] := Ord(i);\n Inc(Result);\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF UsingCLX}\nprocedure TAbBaseViewer.SizeChanged(OldColCount, OldRowCount: Longint);\nbegin\n inherited SizeChanged(OldColCount, OldRowCount);\n Refresh;\nend;\n{$ELSE}\nprocedure TAbBaseViewer.WMSize(var Msg: TWMSize);\nbegin\n inherited;\n Refresh;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\n{$IFNDEF UsingCLX}\nprocedure TAbBaseViewer.WMEraseBkgnd(var Msg: TWMEraseBkgnd);\nbegin\n Msg.Result := -1;\nend;\n{$ENDIF}\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbWavPack.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is Craig Peterson\n *\n * Portions created by the Initial Developer are Copyright (C) 2011\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbWavPack.pas *}\n{*********************************************************}\n{* ABBREVIA: WavPack decompression procedures *}\n{*********************************************************}\n\nunit AbWavPack;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes;\n\n// Decompress a WavPack compressed stream from aSrc and write to aDes.\n// aSrc must not allow reads past the compressed data.\nprocedure DecompressWavPack(aSrc, aDes: TStream);\n\n\nimplementation\n\nuses\n AbCrtl,\n Math,\n SysUtils;\n\n// Compile using\n// bcc32 -DWIN32 -DNO_USE_FSTREAMS -c -w-8004 -w-8012 -w-8017 -w-8057 -w-8065 *.c\n//\n// In wavpack_local.h remove the line \"#define FASTCALL __fastcall\"\n\n{ C runtime library ======================================================== }\n\nfunction fabs(x: Double): Double; cdecl;\nbegin\n if x < 0 then Result := -1\n else Result := x\nend;\n\nfunction floor(x: Double): Integer; cdecl;\nbegin\n Result := Floor(x);\nend;\n\nfunction labs(n: Integer): Integer; cdecl;\nbegin\n if n < 0 then Result := -n\n else Result := n;\nend;\n\nfunction _stricmp(str1, str2: PAnsiChar): Integer; cdecl;\n external 'msvcrt.dll' name '_stricmp';\n\nfunction strncmp(str1, str2: PAnsiChar; num: Integer): Integer; cdecl;\n external 'msvcrt.dll' {$IFDEF BCB}name '_strncmp'{$ENDIF};\n\n\n{ Forward declarations ===================================================== }\n\n// bits.c\nprocedure bs_open_read; external;\nprocedure bs_close_read; external;\nprocedure bs_open_write; external;\nprocedure bs_close_write; external;\nprocedure little_endian_to_native; external;\nprocedure native_to_little_endian; external;\n\n// extra1.c\nprocedure execute_mono; external;\n\n// extra2.c\nprocedure execute_stereo; external;\n\n// float.c\nprocedure float_values; external;\nprocedure read_float_info; external;\nprocedure scan_float_data; external;\nprocedure send_float_data; external;\nprocedure WavpackFloatNormalize; external;\nprocedure write_float_info; external;\n\n// metadata.c\nprocedure add_to_metadata; external;\nprocedure copy_metadata; external;\nprocedure free_metadata; external;\nprocedure process_metadata; external;\nprocedure read_metadata_buff; external;\nprocedure write_metadata_block; external;\n\n// pack.c\nprocedure pack_block; external;\nprocedure pack_init; external;\n\n// tags.c\nprocedure load_tag; external;\nprocedure valid_tag; external;\n\n// unpack.c\nprocedure check_crc_error; external;\nprocedure free_tag; external;\nprocedure unpack_init; external;\nprocedure unpack_samples; external;\n\n// unpack3.c\nprocedure free_stream3; external;\nprocedure get_version3; external;\nprocedure get_sample_index3; external;\nprocedure open_file3; external;\nprocedure seek_sample3; external;\nprocedure unpack_samples3; external;\n\n// words.c\nprocedure exp2s; external;\nprocedure flush_word; external;\nprocedure get_word; external;\nprocedure get_words_lossless; external;\nprocedure init_words; external;\nprocedure log2s; external;\nprocedure log2buffer; external;\nprocedure nosend_word; external;\nprocedure read_hybrid_profile; external;\nprocedure read_entropy_vars; external;\nprocedure restore_weight; external;\nprocedure scan_word; external;\nprocedure send_word; external;\nprocedure send_words_lossless; external;\nprocedure store_weight; external;\nprocedure write_entropy_vars; external;\nprocedure write_hybrid_profile; external;\n\n\n{ Linker derectives ======================================================== }\n\n{$IF DEFINED(WIN32)}\n {$L Win32\\wv_bits.obj}\n {$L Win32\\wv_extra1.obj}\n {$L Win32\\wv_extra2.obj}\n {$L Win32\\wv_float.obj}\n {$L Win32\\wv_metadata.obj}\n {$L Win32\\wv_pack.obj}\n {$L Win32\\wv_tags.obj}\n {$L Win32\\wv_unpack.obj}\n {$L Win32\\wv_unpack3.obj}\n {$L Win32\\wv_words.obj}\n {$L Win32\\wv_wputils.obj}\n{$ELSEIF DEFINED(WIN64)}\n {$L Win64\\wv_bits.obj}\n {$L Win64\\wv_extra1.obj}\n {$L Win64\\wv_extra2.obj}\n {$L Win64\\wv_float.obj}\n {$L Win64\\wv_metadata.obj}\n {$L Win64\\wv_pack.obj}\n {$L Win64\\wv_tags.obj}\n {$L Win64\\wv_unpack.obj}\n {$L Win64\\wv_unpack3.obj}\n {$L Win64\\wv_words.obj}\n {$L Win64\\wv_wputils.obj}\n{$IFEND}\n\n{ wavpack_local.h ========================================================== }\n\nconst\n OPEN_WVC = $1; // open/read \"correction\" file\n OPEN_TAGS = $2; // read ID3v1 / APEv2 tags (seekable file)\n OPEN_WRAPPER = $4; // make audio wrapper available (i.e. RIFF)\n OPEN_2CH_MAX = $8; // open multichannel as stereo (no downmix)\n OPEN_NORMALIZE = $10; // normalize floating point data to +/- 1.0\n OPEN_STREAMING = $20; // \"streaming\" mode blindly unpacks blocks\n // w/o regard to header file position info\n OPEN_EDIT_TAGS = $40; // allow editing of tags\n\ntype\n int32_t = LongInt;\n uint32_t = LongWord;\n\n WavpackStreamReader = record\n read_bytes: function(id, data: Pointer; bcount: int32_t): int32_t; cdecl;\n get_pos: function(id: Pointer): uint32_t; cdecl;\n set_pos_abs: function(id: Pointer; pos: uint32_t): Integer; cdecl;\n set_pos_rel: function(id: Pointer; delta: int32_t; mode: Integer): Integer; cdecl;\n push_back_byte: function(id: Pointer; c: Integer): Integer; cdecl;\n get_length: function(id: Pointer): uint32_t; cdecl;\n can_seek: function(id: Pointer): Integer; cdecl;\n write_bytes: function(id, data: Pointer; bcount: int32_t): int32_t; cdecl;\n end;\n\n WavpackContext = Pointer;\n\n\n{ wputils.c ================================================================ }\n\nfunction WavpackOpenFileInputEx(const reader: WavpackStreamReader;\n wv_id, wvc_id: Pointer; error: PAnsiChar; flags, norm_offset: Integer): WavpackContext;\n cdecl; external;\n\nfunction WavpackGetWrapperBytes(wpc: WavpackContext): uint32_t; cdecl; external;\nfunction WavpackGetWrapperData(wpc: WavpackContext): PByte; cdecl; external;\nprocedure WavpackFreeWrapper (wpc: WavpackContext); cdecl; external;\n\nprocedure WavpackSeekTrailingWrapper(wpc: WavpackContext); cdecl; external;\n\nfunction WavpackGetNumSamples(wpc: WavpackContext): uint32_t; cdecl; external;\nfunction WavpackGetNumChannels(wpc: WavpackContext): Integer; cdecl; external;\nfunction WavpackGetBytesPerSample (wpc: WavpackContext): Integer; cdecl; external;\n\nfunction WavpackUnpackSamples(wpc: WavpackContext; buffer: Pointer;\n samples: uint32_t): uint32_t; cdecl; external;\n\nfunction WavpackCloseFile(wpc: WavpackContext): WavpackContext; cdecl; external;\n\n\n{ TWavPackStream implementation ============================================ }\n\ntype\n PWavPackStream = ^TWavPackStream;\n TWavPackStream = record\n HasPushedByte: Boolean;\n PushedByte: Byte;\n Stream: TStream;\n end;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_read_bytes(id, data: Pointer; bcount: int32_t): int32_t; cdecl;\nbegin\n if PWavPackStream(id).HasPushedByte then begin\n PByte(data)^ := PWavPackStream(id).PushedByte;\n PWavPackStream(id).HasPushedByte := False;\n Inc(PByte(data));\n Dec(bcount);\n if bcount = 0 then\n Result := 1\n else\n Result := PWavPackStream(id).Stream.Read(data^, bcount) + 1;\n end\n else\n Result := PWavPackStream(id).Stream.Read(data^, bcount);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_get_pos(id: Pointer): uint32_t; cdecl;\nbegin\n Result := PWavPackStream(id).Stream.Position;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_set_pos_abs(id: Pointer; pos: uint32_t): Integer; cdecl;\nbegin\n PWavPackStream(id).Stream.Position := pos;\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_set_pos_rel(id: Pointer; delta: int32_t;\n mode: Integer): Integer; cdecl;\nbegin\n PWavPackStream(id).Stream.Seek(delta, mode);\n Result := 1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_push_back_byte(id: Pointer; c: Integer): Integer; cdecl;\nbegin\n Assert(not PWavPackStream(id).HasPushedByte);\n PWavPackStream(id).HasPushedByte := True;\n PWavPackStream(id).PushedByte := Byte(c);\n Result := 1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_get_length(id: Pointer): uint32_t; cdecl;\nbegin\n Result := PWavPackStream(id).Stream.Size;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_can_seek(id: Pointer): Integer; cdecl;\nbegin\n Result := 1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TWavPackStream_write_bytes(id, data: Pointer;\n bcount: int32_t): int32_t; cdecl;\nbegin\n Result := PWavPackStream(id).Stream.Write(data^, bcount);\nend;\n\n\n{ Decompression routines =================================================== }\n\n{ -------------------------------------------------------------------------- }\n// Reformat samples from longs in processor's native endian mode to\n// little-endian data with (possibly) less than 4 bytes / sample.\n//\n// Based on wvunpack.c::format_samples.\n// Conversions simplified since we only support little-endian processors\nfunction FormatSamples(bps: Integer; dst, src: PByte; samcnt: uint32_t): PByte;\nvar\n sample: LongWord;\nbegin\n while samcnt > 0 do begin\n Dec(samcnt);\n // Get next sample\n sample := PLongWord(src)^;\n // Convert and write to output\n case bps of\n 1: begin\n dst^ := sample + 128;\n end;\n 2: begin\n PWord(dst)^ := sample;\n end;\n 3: begin\n PByteArray(dst)[0] := sample;\n PByteArray(dst)[1] := sample shr 8;\n PByteArray(dst)[2] := sample shr 16;\n end;\n 4: begin\n PLongWord(dst)^ := sample;\n end;\n end;\n Inc(src, SizeOf(LongWord));\n Inc(dst, bps);\n end;\n Result := dst;\nend;\n{ -------------------------------------------------------------------------- }\n// Decompress a WavPack compressed stream from aSrc and write to aDes.\n// aSrc must not allow reads past the compressed data.\n//\n// Based on wvunpack.c::unpack_file()\nprocedure DecompressWavPack(aSrc, aDes: TStream);\ntype\n PtrInt = {$IF DEFINED(CPUX64)}Int64{$ELSE}LongInt{$IFEND};\nconst\n OutputBufSize = 256 * 1024;\nvar\n StreamReader: WavpackStreamReader;\n Context: WavpackContext;\n Src: TWavpackStream;\n Error: array[0..79] of AnsiChar;\n SamplesToUnpack, SamplesUnpacked: uint32_t;\n NumChannels, bps, BytesPerSample: Integer;\n OutputBuf, OutputPtr: PByte;\n DecodeBuf: Pointer;\nbegin\n OutputBuf := nil;\n DecodeBuf := nil;\n\n StreamReader.read_bytes := TWavPackStream_read_bytes;\n StreamReader.get_pos := TWavPackStream_get_pos;\n StreamReader.set_pos_abs := TWavPackStream_set_pos_abs;\n StreamReader.set_pos_rel := TWavPackStream_set_pos_rel;\n StreamReader.push_back_byte := TWavPackStream_push_back_byte;\n StreamReader.get_length := TWavPackStream_get_length;\n StreamReader.can_seek := TWavPackStream_can_seek;\n StreamReader.write_bytes := TWavPackStream_write_bytes;\n\n FillChar(Src, SizeOf(Src), 0);\n Src.Stream := aSrc;\n\n Context := WavpackOpenFileInputEx(StreamReader, @Src, nil, Error, OPEN_WRAPPER, 0);\n if Context = nil then\n raise Exception.Create('WavPack decompression failed: ' + Error);\n try\n // Write .wav header\n if WavpackGetWrapperBytes(Context) > 0 then begin\n aDes.WriteBuffer(WavpackGetWrapperData(Context)^, WavpackGetWrapperBytes(Context));\n WavpackFreeWrapper(Context);\n end;\n\n NumChannels := WavpackGetNumChannels(Context);\n bps := WavpackGetBytesPerSample(Context);\n BytesPerSample := NumChannels * bps;\n\n GetMem(OutputBuf, OutputBufSize);\n OutputPtr := OutputBuf;\n GetMem(DecodeBuf, 4096 * NumChannels * SizeOf(Integer));\n\n repeat\n // Unpack samples\n SamplesToUnpack := (OutputBufSize - (PtrInt(OutputPtr) - PtrInt(OutputBuf))) div BytesPerSample;\n if (SamplesToUnpack > 4096) then\n SamplesToUnpack := 4096;\n SamplesUnpacked := WavpackUnpackSamples(Context, DecodeBuf, SamplesToUnpack);\n\n // Convert from 32-bit integers down to appriopriate bit depth\n // and copy to output buffer.\n if (SamplesUnpacked > 0) then\n OutputPtr := FormatSamples(bps, OutputPtr, DecodeBuf,\n SamplesUnpacked * uint32_t(NumChannels));\n\n // Write output when it's full or when we're done\n if (SamplesUnpacked = 0) or\n ((OutputBufSize - (PtrInt(OutputPtr) - PtrInt(OutputBuf))) < BytesPerSample) then begin\n aDes.WriteBuffer(OutputBuf^, PtrInt(OutputPtr) - PtrInt(OutputBuf));\n OutputPtr := OutputBuf;\n end;\n until (SamplesUnpacked = 0);\n\n // Write .wav footer\n while WavpackGetWrapperBytes(Context) > 0 do begin\n try\n aDes.WriteBuffer(WavpackGetWrapperData(Context)^,\n WavpackGetWrapperBytes(Context));\n finally\n WavpackFreeWrapper(Context);\n end;\n // Check for more RIFF data\n WavpackUnpackSamples (Context, DecodeBuf, 1);\n end;\n finally\n if DecodeBuf <> nil then\n FreeMemory(DecodeBuf);\n if OutputBuf <> nil then\n FreeMemory(OutputBuf);\n WavpackCloseFile(Context);\n end;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbZBrows.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZBrows.pas *}\n{*********************************************************}\n{* ABBREVIA: Zip file Browser Component *}\n{*********************************************************}\n\nunit AbZBrows;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbArcTyp, AbBrowse, AbSpanSt, AbZipTyp;\n\ntype\n TAbCustomZipBrowser = class(TAbBaseBrowser)\n private\n function GetTarAutoHandle: Boolean;\n procedure SetTarAutoHandle(const Value: Boolean);\n protected {private}\n FPassword : AnsiString;\n FOnRequestLastDisk : TAbRequestDiskEvent;\n FOnRequestNthDisk : TAbRequestNthDiskEvent;\n FOnRequestBlankDisk : TAbRequestDiskEvent;\n FTarAutoHandle : Boolean;\n\n protected {methods}\n function GetItem(Index : Integer) : TAbZipItem; virtual;\n function GetStream: TStream;\n function GetZipfileComment : AnsiString;\n procedure InitArchive;\n override;\n procedure SetFileName(const aFileName : string);\n override;\n procedure SetStream(aValue: TStream);\n procedure SetOnRequestLastDisk(Value : TAbRequestDiskEvent);\n procedure SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent);\n procedure SetOnRequestBlankDisk(Value : TAbRequestDiskEvent);\n\n procedure SetPassword(const Value : AnsiString);\n procedure SetZipfileComment(const Value : AnsiString);\n virtual;\n\n protected {properties}\n property Password : AnsiString\n read FPassword\n write SetPassword;\n\n protected {events}\n property OnRequestLastDisk : TAbRequestDiskEvent\n read FOnRequestLastDisk\n write SetOnRequestLastDisk;\n property OnRequestNthDisk : TAbRequestNthDiskEvent\n read FOnRequestNthDisk\n write SetOnRequestNthDisk;\n property OnRequestBlankDisk : TAbRequestDiskEvent\n read FOnRequestBlankDisk\n write SetOnRequestBlankDisk;\n\n public {methods}\n constructor Create(AOwner : TComponent); override;\n destructor Destroy; override;\n\n public {properties}\n property Items[Index : Integer] : TAbZipItem\n read GetItem; default;\n property Stream : TStream // This can be used instead of Filename\n read GetStream write SetStream;\n property ZipArchive : {TAbZipArchive} TAbArchive\n read FArchive;\n property ZipfileComment : AnsiString\n read GetZipfileComment\n write SetZipfileComment;\n\n property TarAutoHandle : Boolean\n read GetTarAutoHandle\n write SetTarAutoHandle;\n end;\n\n TAbZipBrowser = class(TAbCustomZipBrowser)\n published\n property ArchiveProgressMeter;\n property ItemProgressMeter;\n property BaseDirectory;\n property LogFile;\n property Logging;\n property OnArchiveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmProcessItem;\n property OnLoad;\n property OnProcessItemFailure;\n property OnRequestLastDisk;\n property OnRequestNthDisk;\n property Version;\n property TarAutoHandle;\n property FileName; {must be after OnLoad}\n end;\n\n\nimplementation\n\nuses\n SysUtils, AbBzip2Typ, AbExcept, AbGzTyp, AbTarTyp, AbUtils;\n\n{ TAbCustomZipBrowser implementation ======================================= }\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbCustomZipBrowser.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomZipBrowser.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipBrowser.GetItem(Index : Integer) : TAbZipItem;\nbegin\n Result := TAbZipItem(ZipArchive.ItemList[Index]);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipBrowser.GetStream: TStream;\nbegin\n if FArchive <> nil then\n Result := FArchive.FStream\n else\n Result := nil\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipBrowser.GetTarAutoHandle: Boolean;\nbegin\n Result := False;\n if FArchive is TAbGzipArchive then\n Result := TAbGzipArchive(FArchive).TarAutoHandle\n else if FArchive is TAbBzip2Archive then\n Result := TAbBzip2Archive(FArchive).TarAutoHandle;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipBrowser.GetZipfileComment : AnsiString;\nbegin\n if FArchive is TAbZipArchive then\n Result := TAbZipArchive(FArchive).ZipfileComment\n else\n Result := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.InitArchive;\nbegin\n inherited InitArchive;\n if FArchive is TAbZipArchive then begin\n {properties}\n TAbZipArchive(FArchive).Password := FPassword;\n {events}\n TAbZipArchive(FArchive).OnRequestLastDisk := FOnRequestLastDisk;\n TAbZipArchive(FArchive).OnRequestNthDisk := FOnRequestNthDisk;\n end;\nend;\n{ -------------------------------------------------------------------------- }\n\nprocedure TAbCustomZipBrowser.SetFileName(const aFileName : string);\nvar\n ArcType : TAbArchiveType;\nbegin\n\n FFileName := aFileName;\n if csDesigning in ComponentState then\n Exit;\n try\n if Assigned(FArchive) then begin\n FArchive.Save;\n end;\n except\n end;\n FArchive.Free;\n FArchive := nil;\n\n if FileName <> '' then begin\n if FileExists(FileName) then begin { open it }\n ArcType := ArchiveType;\n if not ForceType then\n ArcType := AbDetermineArcType(FileName, atUnknown);\n\n case ArcType of\n atZip, atSpannedZip, atSelfExtZip : begin\n FArchive := TAbZipArchive.Create(FileName, fmOpenRead or fmShareDenyNone);\n InitArchive;\n end;\n\n atTar : begin\n FArchive := TAbTarArchive.Create(FileName, fmOpenRead or fmShareDenyNone);\n inherited InitArchive;\n end;\n\n atGZip : begin\n FArchive := TAbGzipArchive.Create(FileName, fmOpenRead or fmShareDenyNone);\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := False;\n inherited InitArchive;\n end;\n\n atGZippedTar : begin\n FArchive := TAbGzipArchive.Create(FileName, fmOpenRead or fmShareDenyNone);\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := True;\n inherited InitArchive;\n end;\n\n atBzip2 : begin\n FArchive := TAbBzip2Archive.Create(FileName, fmOpenRead or fmShareDenyNone);\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := False;\n inherited InitArchive;\n end;\n\n atBzippedTar : begin\n FArchive := TAbBzip2Archive.Create(FileName, fmOpenRead or fmShareDenyNone);\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := True;\n inherited InitArchive;\n end;\n\n else\n raise EAbUnhandledType.Create;\n end {case};\n FArchive.Load;\n FArchiveType := ArcType;\n end;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.SetStream(aValue: TStream);\nvar\n ArcType : TAbArchiveType;\nbegin\n FFileName := '';\n try\n if FArchive <> nil then\n FArchive.Save;\n except\n end;\n FreeAndNil(FArchive);\n\n if aValue <> nil then begin\n ArcType := ArchiveType;\n if not ForceType then\n ArcType := AbDetermineArcType(aValue);\n\n case ArcType of\n atZip, atSpannedZip, atSelfExtZip : begin\n FArchive := TAbZipArchive.CreateFromStream(aValue, '');\n end;\n\n atTar : begin\n FArchive := TAbTarArchive.CreateFromStream(aValue, '');\n end;\n\n atGZip, atGZippedTar : begin\n FArchive := TAbGzipArchive.CreateFromStream(aValue, '');\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := (ArcType = atGZippedTar);\n end;\n\n atBzip2, atBzippedTar : begin\n FArchive := TAbBzip2Archive.CreateFromStream(aValue, '');\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := (ArcType = atBzippedTar);\n end;\n\n else\n raise EAbUnhandledType.Create;\n end {case};\n InitArchive;\n FArchive.Load;\n FArchiveType := ArcType;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.SetOnRequestBlankDisk(Value : TAbRequestDiskEvent);\nbegin\n FOnRequestBlankDisk := Value;\n if FArchive is TAbZipArchive then\n TAbZipArchive(FArchive).OnRequestBlankDisk := FOnRequestBlankDisk;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.SetOnRequestLastDisk(Value : TAbRequestDiskEvent);\nbegin\n FOnRequestLastDisk := Value;\n if FArchive is TAbZipArchive then\n TAbZipArchive(FArchive).OnRequestLastDisk := FOnRequestLastDisk;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent);\nbegin\n FOnRequestNthDisk := Value;\n if FArchive is TAbZipArchive then\n TAbZipArchive(FArchive).OnRequestNthDisk := FOnRequestNthDisk;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.SetPassword(const Value : AnsiString);\nbegin\n FPassword := Value;\n if FArchive is TAbZipArchive then\n TAbZipArchive(FArchive).Password := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipBrowser.SetTarAutoHandle(const Value: Boolean);\nbegin\n FTarAutoHandle := Value;\n\n if FArchive is TAbGzipArchive then begin\n if TAbGzipArchive(FArchive).TarAutoHandle <> Value then begin\n TAbGzipArchive(FArchive).TarAutoHandle := Value;\n InitArchive;\n FArchive.Load;\n DoChange;\n end;\n end;\n if FArchive is TAbBzip2Archive then begin\n if TAbBzip2Archive(FArchive).TarAutoHandle <> Value then begin\n TAbBzip2Archive(FArchive).TarAutoHandle := Value;\n InitArchive;\n FArchive.Load;\n DoChange;\n end;\n end;\nend;\n\nprocedure TAbCustomZipBrowser.SetZipfileComment(const Value : AnsiString);\nbegin\n {NOP - descendents wishing to set this property should override}\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbZLTyp.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZLTyp.pas *}\n{*********************************************************}\n{* ABBREVIA: TAbZlItem class *}\n{*********************************************************}\n{* Misc. constants, types, and routines for working *}\n{* with ZLib compressed data *}\n{* See: RFC 1950 *}\n{* \"ZLIB Compressed Data Format Specification *}\n{* version 3.3\" for more information on ZLib *}\n{*********************************************************}\n\nunit AbZLTyp;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils, Classes, AbUtils, AbArcTyp, AbZipPrc, AbDfBase, AbDfDec, AbDfEnc;\n\nconst\n AB_ZL_PRESET_DICT = $20;\n\n AB_ZL_DEF_COMPRESSIONMETHOD = $8; { Deflate }\n AB_ZL_DEF_COMPRESSIONINFO = $7; { 32k window for Deflate }\n\n AB_ZL_FASTEST_COMPRESSION = $0;\n AB_ZL_FAST_COMPRESSION = $1;\n AB_ZL_DEFAULT_COMPRESSION = $2;\n AB_ZL_MAXIMUM_COMPRESSION = $3;\n\n AB_ZL_FCHECK_MASK = $1F;\n AB_ZL_CINFO_MASK = $F0; { mask out leftmost 4 bits }\n AB_ZL_FLEVEL_MASK = $C0; { mask out leftmost 2 bits }\n AB_ZL_CM_MASK = $0F; { mask out rightmost 4 bits }\n\n\ntype\n TAbZLHeader = packed record\n CMF : Byte;\n FLG : Byte;\n end;\n\n TAbZLItem = class(TAbArchiveItem)\n private\n function GetCompressionInfo: Byte;\n function GetCompressionLevel: Byte;\n function GetIsPresetDictionaryPresent: Boolean;\n procedure SetCompressionInfo(Value: Byte);\n procedure SetCompressionLevel(Value: Byte);\n function GetCompressionMethod: Byte;\n procedure SetCompressionMethod(Value: Byte);\n function GetFCheck: Byte;\n procedure MakeFCheck;\n protected { private }\n FZLHeader : TAbZlHeader;\n FAdler32 : LongInt;\n public\n constructor Create;\n\n property IsPresetDictionaryPresent : Boolean\n read GetIsPresetDictionaryPresent;\n property CompressionLevel : Byte\n read GetCompressionLevel write SetCompressionLevel;\n property CompressionInfo : Byte\n read GetCompressionInfo write SetCompressionInfo;\n\n property CompressionMethod : Byte\n read GetCompressionMethod write SetCompressionMethod;\n property Adler32 : LongInt\n read FAdler32 write FAdler32;\n\n property FCheck : Byte\n read GetFCheck;\n\n procedure SaveZLHeaderToStream(AStream : TStream);\n procedure ReadZLHeaderFromStream(AStream : TStream);\n end;\n\n TAbZLStreamHelper = class(TAbArchiveStreamHelper)\n protected { private }\n FItem : TAbZLItem;\n public\n constructor Create(AStream : TStream);\n destructor Destroy; override;\n\n property Item : TAbZLItem\n read FItem;\n\n procedure ExtractItemData(AStream : TStream); override;\n function FindFirstItem : Boolean; override;\n function FindNextItem : Boolean; override;\n procedure ReadHeader; override;\n procedure ReadTail; override;\n function SeekItem(Index : Integer): Boolean; override;\n procedure WriteArchiveHeader; override;\n procedure WriteArchiveItem(AStream : TStream); override;\n procedure WriteArchiveTail; override;\n function GetItemCount : Integer; override;\n end;\n\n\nimplementation\n\n{ TAbZLStreamHelper }\n\nconstructor TAbZLStreamHelper.Create(AStream: TStream);\nbegin\n inherited Create(AStream);\n FItem := TAbZLItem.Create;\nend;\n\ndestructor TAbZLStreamHelper.Destroy;\nbegin\n FItem.Free;\n inherited Destroy;\nend;\n\nprocedure TAbZLStreamHelper.ExtractItemData(AStream: TStream);\n{ assumes already positioned appropriately }\nvar\n Hlpr : TAbDeflateHelper;\nbegin\n Hlpr := TAbDeflateHelper.Create;\n Hlpr.Options := Hlpr.Options or dfc_UseAdler32;\n if not FItem.IsPresetDictionaryPresent then\n Inflate(FStream, AStream, Hlpr)\n else\n raise Exception.Create('preset dictionaries unsupported');\n Hlpr.Free;\nend;\n\nfunction TAbZLStreamHelper.FindFirstItem: Boolean;\nvar\n ZLH : TAbZLHeader;\nbegin\n FStream.Seek(0, soBeginning);\n Result := FStream.Read(ZLH, SizeOf(TAbZLHeader)) = SizeOf(TAbZLHeader);\n FItem.FZLHeader := ZLH;\n FStream.Seek(0, soBeginning);\nend;\n\nfunction TAbZLStreamHelper.FindNextItem: Boolean;\nbegin\n { only one item in a ZLib Stream }\n Result := FindFirstItem;\nend;\n\nfunction TAbZLStreamHelper.GetItemCount: Integer;\nbegin\n { only one item in a ZLib Stream }\n Result := 1;\nend;\n\nprocedure TAbZLStreamHelper.ReadHeader;\n{ assumes already positioned appropriately }\nvar\n ZLH : TAbZLHeader;\nbegin\n FStream.Read(ZLH, SizeOf(TAbZlHeader));\n FItem.FZLHeader := ZLH;\nend;\n\nprocedure TAbZLStreamHelper.ReadTail;\n{ assumes already positioned appropriately }\nvar\n Adler: LongInt;\nbegin\n FStream.Read(Adler, SizeOf(LongInt));\n FItem.Adler32 := Adler;\nend;\n\nfunction TAbZLStreamHelper.SeekItem(Index: Integer): Boolean;\nbegin\n { only one item in a ZLib Stream }\n if Index <> 1 then\n Result := False\n else\n Result := FindFirstItem;\nend;\n\nprocedure TAbZLStreamHelper.WriteArchiveHeader;\nbegin\n Item.SaveZLHeaderToStream(FStream);\nend;\n\nprocedure TAbZLStreamHelper.WriteArchiveItem(AStream: TStream);\nvar\n Hlpr : TAbDeflateHelper;\nbegin\n { Compress file }\n Hlpr := TAbDeflateHelper.Create;\n Hlpr.Options := Hlpr.Options or dfc_UseAdler32;\n Item.Adler32 := AbDfEnc.Deflate(AStream, FStream, Hlpr);\n Hlpr.Free;\nend;\n\nprocedure TAbZLStreamHelper.WriteArchiveTail;\nvar\n Ad32 : LongInt;\nbegin\n Ad32 := AbSwapLongEndianness(Item.Adler32);\n FStream.Write(Ad32, SizeOf(LongInt));\nend;\n\n{ TAbZLItem }\n\nconstructor TAbZLItem.Create;\nbegin\n { Set default Values for fields }\n FillChar(FZLHeader, SizeOf(TAbZlHeader), #0);\n FZLHeader.CMF := (AB_ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size }\n FZLHeader.CMF := FZLHeader.CMF or AB_ZL_DEF_COMPRESSIONMETHOD; { Deflate }\n FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_PRESET_DICT; { no preset dictionary}\n FZLHeader.FLG := FZLHeader.FLG or (AB_ZL_DEFAULT_COMPRESSION shl 6); { assume default compression }\n MakeFCheck;\nend;\n\nfunction TAbZLItem.GetCompressionInfo: Byte;\nbegin\n Result := FZLHeader.CMF shr 4;\nend;\n\nfunction TAbZLItem.GetCompressionLevel: Byte;\nbegin\n Result := FZLHeader.FLG shr 6;\nend;\n\nfunction TAbZLItem.GetCompressionMethod: Byte;\nbegin\n Result := FZLHeader.CMF and AB_ZL_CM_MASK;\nend;\n\nfunction TAbZLItem.GetFCheck: Byte;\nbegin\n Result := FZLHeader.FLG and AB_ZL_FCHECK_MASK;\nend;\n\nfunction TAbZLItem.GetIsPresetDictionaryPresent: Boolean;\nbegin\n Result := (FZLHeader.FLG and AB_ZL_PRESET_DICT) = AB_ZL_PRESET_DICT;\nend;\n\nprocedure TAbZLItem.MakeFCheck;\n{ create the FCheck value for the current Header }\nvar\n zlh : Word;\nbegin\n FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_FCHECK_MASK;\n zlh := (FZLHeader.CMF * 256) + FZLHeader.FLG;\n Inc(FZLHeader.FLG, 31 - (zlh mod 31));\nend;\n\nprocedure TAbZLItem.ReadZLHeaderFromStream(AStream: TStream);\nbegin\n AStream.Read(FZLHeader, SizeOf(TAbZLHeader));\nend;\n\nprocedure TAbZLItem.SaveZLHeaderToStream(AStream: TStream);\nbegin\n MakeFCheck;\n AStream.Write(FZLHeader, SizeOf(TAbZlHeader));\nend;\n\nprocedure TAbZLItem.SetCompressionInfo(Value: Byte);\nbegin\n FZLHeader.CMF := FZLHeader.CMF and not AB_ZL_CINFO_MASK;\n FZLHeader.CMF := FZLHeader.CMF or (Value shl 4); { shift value and add to bit field }\nend;\n\nprocedure TAbZLItem.SetCompressionLevel(Value: Byte);\nvar\n Temp : Byte;\nbegin\n Temp := Value;\n if not Temp in [AB_ZL_FASTEST_COMPRESSION..AB_ZL_MAXIMUM_COMPRESSION] then\n Temp := AB_ZL_DEFAULT_COMPRESSION;\n FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_FLEVEL_MASK;\n FZLHeader.FLG := FZLHeader.FLG or (Temp shl 6); { shift value and add to bit field }\nend;\n\nprocedure TAbZLItem.SetCompressionMethod(Value: Byte);\nbegin\n if Value > AB_ZL_CM_MASK then Value := (Value shl 4) shr 4;\n FZLHeader.CMF := FZLHeader.CMF and not AB_ZL_CM_MASK;\n FZLHeader.CMF := FZLHeader.CMF or Value;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbZView.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZView.pas *}\n{*********************************************************}\n{* ABBREVIA: Zip archive viewer component *}\n{* Use AbQZView.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbZView;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF UsingCLX }\n QControls,\n AbQView,\n{$ELSE}\n Controls,\n AbView,\n{$ENDIF}\n AbZBrows,\n AbZipTyp;\n\ntype\n TAbIncludeItemEvent = procedure (Sender: TObject;\n Item: TAbZipItem;\n var Include: Boolean) of object;\n\n TAbZipView = class(TAbBaseViewer)\n protected\n FZipComponent : TAbCustomZipBrowser;\n FOnIncludeItem: TAbIncludeItemEvent;\n\n function GetItem(RowNum : Longint) : TAbZipItem;\n procedure SetZipComponent(Value : TAbCustomZipBrowser);\n procedure Notification(AComponent : TComponent; Operation : TOperation);\n override;\n procedure DoChange(Sender : TObject);\n override;\n public\n property Items[RowNum : Longint] : TAbZipItem\n read GetItem;\n published {properties}\n property Align;\n property Anchors;\n property Attributes;\n{$IFNDEF UsingCLX}\n property BevelEdges;\n property BevelInner;\n property BevelKind;\n property BevelOuter;\n property BevelWidth;\n{$ENDIF}\t\n property BorderStyle;\n property Color;\n property Colors;\n{$IFNDEF UsingCLX}\n property Ctl3D;\n property ParentCtl3D;\n property DragCursor;\n{$ENDIF}\n property Cursor;\n property Headings;\n property DefaultColWidth;\n property DefaultRowHeight;\n property DisplayOptions;\n property HeaderRowHeight;\n property SortAttributes;\n property DragMode;\n{$IFDEF HasGridDrawingStyle}\n property DrawingStyle;\n{$ENDIF}\n property Enabled;\n property Font;\n{$IFDEF HasGridDrawingStyle}\n property GradientEndColor;\n property GradientStartColor;\n{$ENDIF}\n property ParentColor;\n property ParentFont;\n property ParentShowHint;\n property PopupMenu;\n property ShowHint;\n property TabOrder;\n property TabStop;\n{$IFDEF HasTouch}\n property Touch;\n{$ENDIF}\n property Version;\n property ZipComponent : TAbCustomZipBrowser\n read FZipComponent write SetZipComponent;\n published {Events}\n property OnChange;\n property OnClick;\n property OnDblClick;\n property OnEnter;\n property OnExit;\n{$IFDEF HasTouch}\n property OnGesture;\n{$ENDIF}\n property OnKeyDown;\n property OnKeyPress;\n property OnKeyUp;\n{$IFDEF HasOnMouseActivate}\n property OnMouseActivate;\n{$ENDIF}\n property OnMouseDown;\n{$IFDEF HasOnMouseEnter}\n property OnMouseEnter;\n property OnMouseLeave;\n{$ENDIF}\n property OnMouseMove;\n property OnMouseUp;\n property OnSorted;\n property OnDrawSortArrow;\n\n property OnIncludeItem: TAbIncludeItemEvent\n read FOnIncludeItem\n write FOnIncludeItem;\nend;\n\nimplementation\n\nuses\n AbArcTyp;\n\n{ ===== TAbZipView ========================================================= }\nfunction TAbZipView.GetItem(RowNum : Longint) : TAbZipItem;\nbegin\n if Assigned(FItemList) then\n Result := TAbZipItem(FItemList.Items[FRowMap[RowNum]])\n else\n Result := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipView.Notification(AComponent : TComponent; Operation : TOperation);\nbegin\n inherited Notification(AComponent, Operation);\n if Operation = opRemove then\n if Assigned(FZipComponent) and (AComponent = FZipComponent) then begin\n FZipComponent := nil;\n Refresh;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipView.SetZipComponent(Value : TAbCustomZipBrowser);\nbegin\n if Value <> nil then begin\n FZipComponent := Value;\n\n if not (csDesigning in ComponentState) then begin\n FZipComponent.OnChange := DoChange;\n FZipComponent.OnLoad := DoLoad;\n DoChange(Self);\n end;\n end\n else\n FZipComponent := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipView.DoChange(Sender : TObject);\nvar\n i : Integer;\n TheArchive : TAbArchive;\n Include : Boolean;\nbegin\n FItemList.Clear;\n if Assigned(FZipComponent) then begin\n { let's make this a bit easier to read }\n TheArchive := FZipComponent.FArchive;\n\n if Assigned(TheArchive) then begin\n for i := 0 to Pred(TheArchive.ItemList.Count) do begin\n if Assigned(FOnIncludeItem) then begin\n FOnIncludeItem(self, TAbZipItem(TheArchive.ItemList[i]), Include);\n if Include then\n FItemList.Add(TheArchive.ItemList[i]);\n end\n else begin\n { if it doesn't look like a folder place holder... }\n if TAbZipItem(TheArchive.ItemList[i]).DiskFileName <>\n TAbZipItem(TheArchive.ItemList[i]).DiskPath then\n { ...add it to the display list }\n FItemList.Add(TheArchive.ItemList[i]);\n end;\n end;\n end\n else\n FItemList.Clear;\n end\n else\n FItemList.Clear;\n inherited DoChange(Sender);\nend;\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbZipExt.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZipExt.pas *}\n{*********************************************************}\n{* ABBREVIA: Zip file registration *}\n{*********************************************************}\n\nunit AbZipExt;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n SysUtils, Classes;\n\nfunction AbExistingZipAssociation : Boolean;\nfunction AbGetZipAssociation(var App, ID, FileType : string) : Boolean;\nfunction AbRegisterZipExtension(const App : string;\n ID, FileType : string;\n Replace : Boolean) : Boolean;\n\n\nimplementation\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n Messages,\n Registry,\n ShellAPI,\n{$ENDIF}\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n AbConst;\n\nconst\n ZipExt = '.zip';\n DefZipID = 'Zip';\n DefZipType = 'Zip File';\n OpenCommand = 'Shell\\Open\\Command';\n DefaultIcon = 'DefaultIcon';\n\nvar\n Reg : TRegistry;\n\n{ -------------------------------------------------------------------------- }\nfunction AbExistingZipAssociation : Boolean;\nvar\n App, ID, FileType : string;\nbegin\n Result := False;\n Reg := TRegistry.Create;\n Reg.RootKey := HKEY_CLASSES_ROOT;\n Reg.OpenKey('',False);\n if Reg.OpenKey(ZipExt, False) then begin\n ID := Reg.ReadString('');\n if Reg.OpenKey('\\' + ID, False) then begin\n FileType := Reg.ReadString('');\n if Reg.OpenKey(OpenCommand, False) then begin\n App := Reg.ReadString('');\n if (App <> '') then\n Result := True;\n end;\n end;\n end;\n Reg.Free;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbGetZipAssociation(var App, ID, FileType : string) : Boolean;\nbegin\n Result := False;\n Reg := TRegistry.Create;\n Reg.RootKey := HKEY_CLASSES_ROOT;\n Reg.OpenKey('',False);\n if Reg.OpenKey(ZipExt, False) then begin\n ID := Reg.ReadString('');\n if Reg.OpenKey('\\' + ID, False) then begin\n FileType := Reg.ReadString('');\n if Reg.OpenKey(OpenCommand, False) then begin\n App := Reg.ReadString('');\n Result := True;\n end;\n end;\n end;\n Reg.Free;\nend;\n{ -------------------------------------------------------------------------- }\nfunction AbRegisterZipExtension(const App : string;\n ID, FileType : string;\n Replace : Boolean) : Boolean;\nbegin\n Result := False;\n if AbExistingZipAssociation and not Replace then\n Exit;\n try\n if (ID = '') then\n ID := DefZipID;\n if (FileType = '') then\n FileType := DefZipType;\n Reg := TRegistry.Create;\n Reg.RootKey := HKEY_CLASSES_ROOT;\n Reg.OpenKey('',False);\n Reg.OpenKey(ZipExt, True);\n Reg.WriteString('', ID);\n Reg.OpenKey('\\' + ID, True);\n Reg.WriteString('', FileType);\n Reg.OpenKey(OpenCommand, True);\n Reg.WriteString('', App);\n Reg.OpenKey('\\' + DefaultIcon, True);\n Reg.WriteString('', App + ',0');\n Result := True;\n finally\n Reg.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n"
},
{
"path": "lib/abbrevia/source/AbZipKit.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZipKit.pas *}\n{*********************************************************}\n{* ABBREVIA: TABZipKit component *}\n{*********************************************************}\n\nunit AbZipKit;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes, AbZipper, AbArcTyp, AbZipTyp;\n\ntype\n TAbCustomZipKit = class(TAbCustomZipper)\n protected {private}\n FExtractOptions : TAbExtractOptions;\n FOnConfirmOverwrite : TAbConfirmOverwriteEvent;\n FOnNeedPassword : TAbNeedPasswordEvent;\n FPasswordRetries : Byte;\n\n protected {methods}\n procedure DoConfirmOverwrite(var Name : string; var Confirm : Boolean);\n virtual;\n procedure DoNeedPassword(Sender : TObject; var NewPassword : AnsiString);\n virtual;\n procedure InitArchive;\n override;\n procedure SetExtractOptions(Value : TAbExtractOptions);\n procedure SetPasswordRetries(Value : Byte);\n procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem;\n const NewName : string );\n procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\n procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem);\n\n protected {properties}\n property ExtractOptions : TAbExtractOptions\n read FExtractOptions\n write SetExtractOptions\n default AbDefExtractOptions;\n property PasswordRetries : Byte\n read FPasswordRetries\n write SetPasswordRetries\n default AbDefPasswordRetries;\n\n protected {events}\n property OnConfirmOverwrite : TAbConfirmOverwriteEvent\n read FOnConfirmOverwrite\n write FOnConfirmOverwrite;\n property OnNeedPassword : TAbNeedPasswordEvent\n read FOnNeedPassword\n write FOnNeedPassword;\n\n public {methods}\n constructor Create(AOwner : TComponent);\n override;\n destructor Destroy;\n override;\n procedure ExtractAt(Index : Integer; const NewName : string);\n procedure ExtractFiles(const FileMask : string);\n {extract all files from the archive that match the mask}\n procedure ExtractFilesEx(const FileMask, ExclusionMask : string);\n {extract files matching FileMask except those matching ExclusionMask}\n procedure ExtractTaggedItems;\n {extract all tagged items from the archive}\n procedure ExtractToStream(const aFileName : string; ToStream : TStream);\n {extract the specified item to TStream descendant}\n procedure TestTaggedItems;\n {test all tagged items in the archive}\n\n public {property}\n property Spanned;\n end;\n\n TAbZipKit = class(TAbCustomZipKit)\n published\n property ArchiveProgressMeter;\n property ArchiveSaveProgressMeter;\n property AutoSave;\n property BaseDirectory;\n property CompressionMethodToUse;\n property DeflationOption;\n {$IFDEF MSWINDOWS}\n property DOSMode;\n {$ENDIF}\n property ExtractOptions;\n property SpanningThreshold;\n property ItemProgressMeter;\n property LogFile;\n property Logging;\n property OnArchiveProgress;\n property OnArchiveSaveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmOverwrite;\n property OnConfirmProcessItem;\n property OnConfirmSave;\n property OnLoad;\n property OnNeedPassword;\n property OnProcessItemFailure;\n property OnRequestBlankDisk;\n property OnRequestImage;\n property OnRequestLastDisk;\n property OnRequestNthDisk;\n property OnSave;\n property Password;\n property PasswordRetries;\n property StoreOptions;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad}\n end;\n\n\nimplementation\n\nuses\n AbExcept,\n AbUnzPrc,\n AbZBrows;\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbCustomZipKit.Create( AOwner : TComponent );\nbegin\n inherited Create( AOwner );\n PasswordRetries := AbDefPasswordRetries;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomZipKit.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.DoConfirmOverwrite( var Name : string;\n var Confirm : Boolean );\nbegin\n Confirm := True;\n if Assigned( FOnConfirmOverwrite ) then\n FOnConfirmOverwrite( Name, Confirm );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.DoNeedPassword( Sender : TObject;\n var NewPassword : AnsiString );\nbegin\n if Assigned( FOnNeedPassword ) then begin\n FOnNeedPassword( Self, NewPassword );\n FPassword := NewPassword;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.ExtractAt(Index : Integer; const NewName : string);\n {extract a file from the archive that match the index}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractAt( Index, NewName )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.ExtractFiles(const FileMask : string);\n {extract all files from the archive that match the mask}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractFiles( FileMask )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.ExtractFilesEx(const FileMask, ExclusionMask : string);\n {extract files matching FileMask except those matching ExclusionMask}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractFilesEx( FileMask, ExclusionMask )\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.ExtractTaggedItems;\n {extract all tagged items from the archive}\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.ExtractToStream(const aFileName : string;\n ToStream : TStream);\nbegin\n if (FArchive <> nil) then\n FArchive.ExtractToStream(aFileName, ToStream)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.InitArchive; \nbegin\n inherited InitArchive;\n if (FArchive <> nil) then begin\n FArchive.ExtractOptions := FExtractOptions;\n FArchive.OnConfirmOverwrite := DoConfirmOverwrite;\n end;\n if FArchive is TAbZipArchive then begin\n {properties}\n TAbZipArchive(FArchive).PasswordRetries := FPasswordRetries;\n {events}\n TAbZipArchive(FArchive).OnNeedPassword := DoNeedPassword;\n TAbZipArchive(FArchive).ExtractHelper := UnzipProc;\n TAbZipArchive(FArchive).ExtractToStreamHelper := UnzipToStreamProc;\n TAbZipArchive(FArchive).TestHelper := TestItemProc;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.SetExtractOptions( Value : TAbExtractOptions );\nbegin\n FExtractOptions := Value;\n if (FArchive <> nil) then\n FArchive.ExtractOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.SetPasswordRetries( Value : Byte );\nbegin\n FPasswordRetries := Value;\n if (FArchive <> nil) then\n (FArchive as TAbZipArchive).PasswordRetries := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.TestTaggedItems;\n {test all tagged items in the archive}\nbegin\n if (FArchive <> nil) then\n FArchive.TestTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.UnzipProc( Sender : TObject; Item : TAbArchiveItem;\n const NewName : string );\nbegin\n AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\nbegin\n AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipKit.TestItemProc(Sender : TObject; Item : TAbArchiveItem);\nbegin\n AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item));\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbZipOut.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZipOut.pas *}\n{*********************************************************}\n{* ABBREVIA: Visual Component with Zip and unzip support *}\n{* Use AbQZpOut.pas for CLX *}\n{*********************************************************}\n\n{$IFNDEF UsingCLX}\nunit AbZipOut;\n{$ENDIF}\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n{$IFDEF MSWINDOWS}\n Windows,\n Messages,\n{$ENDIF}\n Types,\n{$IFDEF UsingCLX}\n QGraphics,\n QComCtrls,\n QImglist,\n QControls,\n QForms,\n{$ELSE}\n Graphics,\n Controls,\n Forms,\n ComCtrls,\n Imglist,\n{$ENDIF}\n AbArcTyp,\n AbBrowse,\n AbUtils,\n AbZipTyp;\n\n\nconst\n cBitmapHeight = 16;\n cBitmapWidth = 16;\n\ntype\n TAbZipAttribute =\n (zaCompressedSize, zaCompressionMethod, zaCompressionRatio, zaCRC,\n zaExternalFileAttributes, zaInternalFileAttributes, zaEncryption,\n zaTimeStamp, zaUncompressedSize, zaVersionMade, zaVersionNeeded,\n zaComment);\n\n TAbZipAttributes = set of TAbZipAttribute;\n\nconst\n AbDefZipAttributes =\n [zaCompressedSize, zaCompressionMethod, zaCompressionRatio, zaCRC,\n zaExternalFileAttributes, zaEncryption, zaTimeStamp, zaUncompressedSize];\n\n AbDefColor = clWindow;\n AbDefHierarchy = True;\n AbDefParentColor = False;\n\n{.Z+}\ntype\n TTreeNodeFriend = class(TTreeNode)\n end;\n{.Z-}\n\ntype\n TWindowsDropEvent =\n procedure(Sender : TObject; FileName : string) of object;\n{TAbZipDisplayOutline does not support Owner-Draw}\ntype\n TAbZipDisplayOutline = class(TTreeView)\n private\n FDirBitMap : TBitMap;\n FFileBitMap : TBitMap;\n FAttrBitMap : TBitMap;\n FDirBitMapSelected : TBitMap;\n FFileBitMapSelected : TBitMap;\n FAttrBitMapSelected : TBitMap;\n FImageList : TImageList;\n FFileIndex : integer;\n FFileSelectedIndex : integer;\n FDirectoryIndex : integer;\n FDirSelectedIndex : integer;\n FAttrIndex : integer;\n FBitMapHeight : integer;\n FBitMapWidth : integer;\n FAttrSelectedIndex : integer;\n\n FOnWindowsDrop : TWindowsDropEvent;\n\n{$IFNDEF UsingCLX}\n procedure WMDropFiles(var Msg : TWMDropFiles);\n message WM_DROPFILES;\n{$ENDIF}\n\n procedure IndexBitmaps;\n\n procedure SetDirectoryBitMap(Value : TBitmap);\n procedure SetFileBitMap(Value : TBitmap);\n procedure SetAttributeBitMap(Value : TBitmap);\n procedure SetDirectoryBitMapSelected(Value : TBitmap);\n procedure SetFileBitMapSelected(Value : TBitmap);\n procedure SetAttributeBitMapSelected(Value : TBitmap);\n procedure SetBitMapHeight(Value : Integer);\n procedure SetBitMapWidth(Value : Integer);\n\n protected\n procedure DoOnWindowsDrop(FileName : string); virtual;\n\n{$IFDEF UsingCLX}\n function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;\n const MousePos: TPoint): Boolean;\n override;\n{$ELSE}\n function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;\n MousePos: TPoint): Boolean;\n override;\n{$ENDIF}\n procedure Loaded; override;\n procedure SetOnWindowsDrop(Value : TWindowsDropEvent);\n public\n constructor Create(AOwner : TComponent); override;\n destructor Destroy; override;\n public\n property zdPictureDirectory : TBitmap\n read FDirBitMap\n write SetDirectoryBitMap;\n property zdPictureFile : TBitmap\n read FFileBitMap\n write SetFileBitMap;\n property zdPictureZipAttribute : TBitmap\n read FAttrBitMap\n write SetAttributeBitMap;\n property zdPictureDirectorySelected : TBitmap\n read FDirBitMapSelected\n write SetDirectoryBitMapSelected;\n property zdPictureFileSelected : TBitmap\n read FFileBitMapSelected\n write SetFileBitMapSelected;\n property zdPictureZipAttributeSelected : TBitmap\n read FAttrBitMapSelected\n write SetAttributeBitMapSelected;\n property BitMapHeight : Integer\n read FBitMapHeight\n write SetBitMapHeight;\n property BitMapWidth : Integer\n read FBitMapWidth\n write SetBitMapWidth;\n property OnWindowsDrop : TWindowsDropEvent\n read FOnWindowsDrop\n write SetOnWindowsDrop;\n end;\n\ntype\n{$IFDEF UsingClx}\n TAbCustomZipOutline = class(TWidgetControl)\n{$ELSE}\n TAbCustomZipOutline = class(TWinControl)\n{$ENDIF}\n protected {private}\n FArchive : TAbZipArchive;\n FItemProgressMeter : IAbProgressMeter;\n FArchiveProgressMeter : IAbProgressMeter;\n FAttributes : TAbZipAttributes;\n FAutoSave : Boolean;\n FBaseDirectory : string;\n FCompressionMethodToUse : TAbZipSupportedMethod;\n FDeflationOption : TAbZipDeflationOption;\n{$IFDEF MSWINDOWS}\n FDOSMode : Boolean;\n{$ENDIF}\n FFileName : string;\n FExtractOptions : TAbExtractOptions;\n FHierarchy : Boolean;\n FLogFile : string;\n FLogging : Boolean;\n FSpanningThreshold : Longint;\n FOutline : TAbZipDisplayOutline;\n FPassword : AnsiString;\n FPasswordRetries : Byte;\n FStoreOptions : TAbStoreOptions;\n FTempDirectory : string;\n\n FOnProcessItemFailure : TAbArchiveItemFailureEvent;\n FOnArchiveItemProgress : TAbArchiveItemProgressEvent;\n FOnArchiveProgress : TAbArchiveProgressEvent;\n FOnChange : TNotifyEvent;\n FOnClick : TNotifyEvent;\n FOnCollapse : TTVExpandedEvent;\n FOnConfirmOverwrite : TAbConfirmOverwriteEvent;\n FOnConfirmProcessItem : TAbArchiveItemConfirmEvent;\n FOnConfirmSave : TAbArchiveConfirmEvent;\n FOnDblClick : TNotifyEvent;\n FOnDragDrop : TDragDropEvent;\n FOnDragOver : TDragOverEvent;\n FOnEndDrag : TEndDragEvent;\n FOnEnter : TNotifyEvent;\n FOnExit : TNotifyEvent;\n FOnExpand : TTVExpandedEvent;\n FOnKeyDown : TKeyEvent;\n FOnKeyPress : TKeyPressEvent;\n FOnKeyUp : TKeyEvent;\n FOnLoad : TAbArchiveEvent;\n FOnMouseDown : TMouseEvent;\n FOnMouseMove : TMouseMoveEvent;\n FOnMouseUp : TMouseEvent;\n FOnNeedPassword : TAbNeedPasswordEvent;\n FOnRequestImage : TAbRequestImageEvent;\n FOnRequestLastDisk : TAbRequestDiskEvent;\n FOnRequestNthDisk : TAbRequestNthDiskEvent;\n FOnRequestBlankDisk : TAbRequestDiskEvent;\n FOnSave : TAbArchiveEvent;\n{$IFDEF MSWINDOWS}\n FOnStartDrag : TStartDragEvent;\n{$ENDIF MSWINDOWS}\n FOnWindowsDrop : TWindowsDropEvent;\n\n protected {methods}\n procedure AddAttributeNodes(Item : TAbZipItem; oNode : TTreeNode);\n procedure DoProcessItemFailure(Sender : TObject; Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer); virtual;\n procedure DoArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem;\n Progress : Byte; var Abort : Boolean); virtual;\n procedure DoArchiveProgress(Sender : TObject; Progress : Byte;\n var Abort : Boolean); virtual;\n procedure DoChange; virtual;\n procedure DoClick(Sender : TObject); virtual;\n procedure DoCollapse(Sender : TObject; Node: TTreeNode); virtual;\n procedure DoConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n var Confirm : Boolean); virtual;\n procedure DoConfirmOverwrite(var Name : string; var Confirm : Boolean); virtual;\n procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean); virtual;\n procedure DoDblClick(Sender : TObject); virtual;\n procedure DoDragDrop(Sender, Source: TObject; X, Y: Integer); virtual;\n procedure DoDragOver(Sender, Source: TObject; X, Y: Integer;\n State: TDragState; var Accept: Boolean); virtual;\n procedure DoOnEndDrag(Sender, Target: TObject; X, Y: Integer); virtual;\n procedure DoOnEnter(Sender : TObject); virtual;\n procedure DoOnExit(Sender : TObject); virtual;\n procedure DoExpand(Sender: TObject; Node : TTreeNode); virtual;\n procedure DoKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState);\n virtual;\n procedure DoKeyPress(Sender : TObject; var Key: Char); virtual;\n procedure DoKeyUp(Sender : TObject; var Key: Word; Shift: TShiftState);\n virtual;\n procedure DoLoad(Sender : TObject); virtual;\n procedure DoMouseDown(Sender : TObject; Button: TMouseButton;\n Shift: TShiftState; X, Y : Integer); virtual;\n procedure DoMouseMove(Sender : TObject; Shift: TShiftState; X, Y: Integer);\n virtual;\n procedure DoMouseUp(Sender : TObject; Button: TMouseButton;\n Shift: TShiftState; X, Y: Integer); virtual;\n procedure DoNeedPassword(Sender : TObject; var NewPassword : AnsiString);\n virtual;\n procedure DoSave(Sender : TObject); virtual;\n{$IFDEF MSWINDOWS}\n procedure DoOnStartDrag(Sender: TObject; var DragObject: TDragObject);\n virtual;\n{$ENDIF}\n procedure DoWindowsDrop(Sender : TObject; FileName : string); virtual;\n function GetBorderStyle : TBorderStyle;\n function GetCount : Integer;\n function GetCursor : TCursor;\n{$IFNDEF UsingCLX}\n function GetDragCursor : TCursor;\n{$ENDIF}\n function GetDragMode : TDragMode;\n function GetItem(Index : Integer) : TAbZipItem;\n function GetPictureDirectory : TBitmap;\n function GetPictureFile : TBitmap;\n function GetPictureZipAttribute: TBitmap;\n function GetPictureDirectorySelected : TBitmap;\n function GetPictureFileSelected : TBitmap;\n function GetPictureZipAttributeSelected : TBitmap;\n function GetPictureHeight : Integer;\n function GetPictureWidth : Integer;\n function GetSelectedItem : LongInt;\n function GetSelectedZipItem : TAbZipItem;\n function GetStatus : TAbArchiveStatus;\n function GetVersion : string;\n function GetZipfileComment : AnsiString;\n procedure InitArchive;\n procedure Loaded; override;\n procedure Notification(Component: TComponent; Operation: TOperation);\n override;\n procedure PutItem(Index : Integer; Value : TAbZipItem);\n procedure SetArchiveProgressMeter(const Value: IAbProgressMeter);\n procedure SetAttributes(Value : TAbZipAttributes);\n procedure SetAutoSave(Value : Boolean);\n procedure SetBaseDirectory(Value : string);\n procedure SetBorderStyle(Value : TBorderStyle);\n procedure SetCompressionMethodToUse(Value : TAbZipSupportedMethod);\n procedure SetDeflationOption(Value : TAbZipDeflationOption);\n{$IFDEF MSWINDOWS}\n procedure SetDOSMode(Value : Boolean);\n{$ENDIF}\n procedure SetCursor(Value : TCursor);\n{$IFNDEF UsingCLX}\n procedure SetDragCursor(Value : TCursor);\n{$ENDIF}\n{$IFNDEF UsingCLX}\n procedure SetDragMode(Value : TDragMode); override;\n{$ENDIF}\n procedure SetExtractOptions(Value : TAbExtractOptions);\n procedure SetFileName(const aFileName : string); virtual;\n procedure SetHierarchy(Value : Boolean);\n procedure SetItemProgressMeter(const Value: IAbProgressMeter);\n procedure SetLogFile(Value : string);\n procedure SetLogging(Value : Boolean);\n procedure SetOnRequestImage(Value : TAbRequestImageEvent);\n procedure SetOnRequestLastDisk(Value : TAbRequestDiskEvent);\n procedure SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent);\n procedure SetOnRequestBlankDisk(Value : TAbRequestDiskEvent);\n procedure SetOnWindowsDrop(Value : TWindowsDropEvent);\n procedure SetPassword(Value : AnsiString);\n procedure SetPasswordRetries(Value : Byte);\n procedure SetPictureDirectory(Value : TBitmap);\n procedure SetPictureFile(Value : TBitmap);\n procedure SetPictureZipAttribute(Value : TBitmap);\n procedure SetPictureDirectorySelected(Value : TBitmap);\n procedure SetPictureFileSelected(Value : TBitmap);\n procedure SetPictureZipAttributeSelected(Value : TBitmap);\n procedure SetPictureHeight(Value : Integer);\n procedure SetPictureWidth(Value : Integer);\n procedure SetSelectedItem(Value : LongInt);\n procedure SetStoreOptions(Value : TAbStoreOptions);\n procedure SetTempDirectory(Value : string);\n procedure SetSpanningThreshold(Value : Longint);\n procedure SetVersion(Value : string);\n procedure SetZipfileComment(Value : AnsiString);\n procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem);\n procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem;\n const NewName : string);\n procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\n procedure UpdateOutline;\n procedure ZipProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\n procedure ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream, InStream : TStream);\n\n protected {properties}\n property ArchiveProgressMeter : IAbProgressMeter\n read FArchiveProgressMeter\n write SetArchiveProgressMeter;\n property Attributes : TAbZipAttributes\n read FAttributes\n write SetAttributes\n default AbDefZipAttributes;\n property AutoSave : Boolean\n read FAutoSave\n write SetAutoSave\n default AbDefAutoSave;\n property BaseDirectory : string\n read FBaseDirectory\n write SetBaseDirectory;\n property BorderStyle : TBorderStyle\n read GetBorderStyle\n write SetBorderStyle;\n property CompressionMethodToUse : TAbZipSupportedMethod\n read FCompressionMethodToUse\n write SetCompressionMethodToUse\n default AbDefCompressionMethodToUse;\n property Cursor : TCursor\n read GetCursor\n write SetCursor;\n property DeflationOption : TAbZipDeflationOption\n read FDeflationOption\n write SetDeflationOption\n default AbDefDeflationOption;\n{$IFDEF MSWINDOWS}\n property DOSMode : Boolean\n read FDOSMode\n write SetDOSMode;\n{$ENDIF}\n{$IFNDEF UsingCLX}\n property DragCursor : TCursor\n read GetDragCursor\n write SetDragCursor;\n property DragMode : TDragMode\n read GetDragMode\n write SetDragMode;\n{$ENDIF}\n property ExtractOptions : TAbExtractOptions\n read FExtractOptions\n write SetExtractOptions\n default AbDefExtractOptions;\n property FileName : string\n read FFileName\n write SetFileName;\n property Hierarchy : Boolean\n read FHierarchy\n write SetHierarchy\n default AbDefHierarchy;\n property SpanningThreshold : Longint\n read FSpanningThreshold\n write SetSpanningThreshold\n default 0;\n property ItemProgressMeter : IAbProgressMeter\n read FItemProgressMeter\n write SetItemProgressMeter;\n property LogFile : string\n read FLogFile\n write SetLogFile;\n property Logging : Boolean\n read FLogging\n write SetLogging;\n property OnWindowsDrop : TWindowsDropEvent\n read FOnWindowsDrop\n write SetOnWindowsDrop;\n property Password : AnsiString\n read FPassword\n write SetPassword;\n property PasswordRetries : Byte\n read FPasswordRetries\n write SetPasswordRetries\n default AbDefPasswordRetries;\n property PictureDirectory : TBitmap\n read GetPictureDirectory\n write SetPictureDirectory;\n property PictureFile : TBitmap\n read GetPictureFile\n write SetPictureFile;\n property PictureZipAttribute : TBitmap\n read GetPictureZipAttribute\n write SetPictureZipAttribute;\n property PictureDirectorySelected : TBitmap\n read GetPictureDirectorySelected\n write SetPictureDirectorySelected;\n property PictureFileSelected : TBitmap\n read GetPictureFileSelected\n write SetPictureFileSelected;\n property PictureZipAttributeSelected : TBitmap\n read GetPictureZipAttributeSelected\n write SetPictureZipAttributeSelected;\n property PictureHeight : Integer\n read GetPictureHeight\n write SetPictureHeight;\n property PictureWidth : Integer\n read GetPictureWidth\n write SetPictureWidth;\n property StoreOptions : TAbStoreOptions\n read FStoreOptions\n write SetStoreOptions\n default AbDefStoreOptions;\n property Version : string\n read GetVersion\n write SetVersion\n stored False;\n\n protected {events}\n property OnProcessItemFailure : TAbArchiveItemFailureEvent\n read FOnProcessItemFailure\n write FOnProcessItemFailure;\n property OnArchiveItemProgress : TAbArchiveItemProgressEvent\n read FOnArchiveItemProgress\n write FOnArchiveItemProgress;\n property OnArchiveProgress : TAbArchiveProgressEvent\n read FOnArchiveProgress\n write FOnArchiveProgress;\n property OnChange : TNotifyEvent\n read FOnChange\n write FOnChange;\n property OnClick : TNotifyEvent\n read FOnClick\n write FOnClick;\n property OnConfirmProcessItem : TAbArchiveItemConfirmEvent\n read FOnConfirmProcessItem\n write FOnConfirmProcessItem;\n property OnConfirmOverwrite : TAbConfirmOverwriteEvent\n read FOnConfirmOverwrite\n write FOnConfirmOverwrite;\n property OnConfirmSave : TAbArchiveConfirmEvent\n read FOnConfirmSave\n write FOnConfirmSave;\n property OnCollapse : TTVExpandedEvent\n read FOnCollapse\n write FOnCollapse;\n property OnDblClick : TNotifyEvent\n read FOnDblClick\n write FOnDblClick;\n property OnDragDrop : TDragDropEvent\n read FOnDragDrop\n write FOnDragDrop;\n property OnDragOver : TDragOverEvent\n read FOnDragOver\n write FOnDragOver;\n property OnEndDrag : TEndDragEvent\n read FOnEndDrag\n write FOnEndDrag;\n property OnEnter : TNotifyEvent\n read FOnEnter\n write FOnEnter;\n property OnExit : TNotifyEvent\n read FOnExit\n write FOnExit;\n property OnExpand : TTVExpandedEvent\n read FOnExpand\n write FOnExpand;\n property OnKeyDown : TKeyEvent\n read FOnKeyDown\n write FOnKeyDown;\n property OnKeyPress : TKeyPressEvent\n read FOnKeyPress\n write FOnKeyPress;\n property OnKeyUp : TKeyEvent\n read FOnKeyUp\n write FOnKeyUp;\n property OnLoad : TAbArchiveEvent\n read FOnLoad\n write FOnLoad;\n property OnMouseDown : TMouseEvent\n read FOnMouseDown\n write FOnMouseDown;\n property OnMouseMove : TMouseMoveEvent\n read FOnMouseMove\n write FOnMouseMove;\n property OnMouseUp : TMouseEvent\n read FOnMouseUp\n write FOnMouseUp;\n property OnNeedPassword : TAbNeedPasswordEvent\n read FOnNeedPassword\n write FOnNeedPassword;\n property OnRequestImage : TAbRequestImageEvent\n read FOnRequestImage\n write SetOnRequestImage;\n property OnRequestLastDisk : TAbRequestDiskEvent\n read FOnRequestLastDisk\n write SetOnRequestLastDisk;\n property OnRequestNthDisk : TAbRequestNthDiskEvent\n read FOnRequestNthDisk\n write SetOnRequestNthDisk;\n property OnRequestBlankDisk : TAbRequestDiskEvent\n read FOnRequestBlankDisk\n write SetOnRequestBlankDisk;\n property OnSave : TAbArchiveEvent\n read FOnSave\n write FOnSave;\n{$IFDEF MSWINDOWS}\n property OnStartDrag : TStartDragEvent\n read FOnStartDrag\n write FOnStartDrag;\n{$ENDIF MSWINDOWS}\n\n public {methods}\n constructor Create(AOwner : TComponent); override;\n destructor Destroy; override;\n\n procedure AddFiles(const FileMask : string; SearchAttr : Integer);\n {Add files to the archive where the disk filespec matches}\n procedure AddFilesEx(const FileMask, ExclusionMask : string;\n SearchAttr : Integer);\n {Add files that match Filemask except those matching ExclusionMask}\n procedure AddFromStream(const NewName : string; FromStream : TStream);\n {Create and add a zip item directly from a stream}\n procedure ClearTags;\n {Clear all tags from the archive}\n procedure CloseArchive;\n {closes the archive by setting FileName to ''}\n procedure DeleteAt(Index : Integer);\n {delete item specified by index}\n procedure DeleteFiles(const FileMask : string);\n {Delete all files from the archive that match the file mask}\n procedure DeleteFilesEx(const FileMask, ExclusionMask : string);\n {Delete files that match Filemask except those matching ExclusionMask}\n procedure DeleteTaggedItems;\n {delete all tagged items from the archive}\n procedure ExtractAt(Index : Integer; const NewName : string);\n {extract item specified by index}\n procedure ExtractFiles(const FileMask : string);\n {extract all files from the archive that match the mask}\n procedure ExtractFilesEx(const FileMask, ExclusionMask : string);\n {Extract files that match Filemask except those matching ExclusionMask}\n procedure ExtractTaggedItems;\n {extract all tagged items from the archive}\n procedure ExtractToStream(const aFileName : string; ToStream : TStream);\n {extract an item directly to a stream}\n function FindItem(aItem : TAbArchiveItem) : Integer;\n {extract specified item}\n function FindFile(const aFileName : string) : Integer;\n {find the item with the given file name}\n procedure FreshenFiles(const FileMask : string);\n {freshen all items that match the file mask}\n procedure FreshenFilesEx(const FileMask, ExclusionMask : string);\n {freshen items matching FileMask but not ExclusionMask}\n procedure FreshenTaggedItems;\n {freshen all tagged items}\n procedure FullCollapse;\n procedure FullExpand;\n function GetTextItem(const Value: string): LongInt;\n function GetOutLineItem(X, Y : Integer): LongInt;\n procedure Move(aItem : TAbArchiveItem; NewStoredPath : string);\n procedure OpenArchive(const aFileName : String);\n {opens the archive}\n procedure Replace(aItem : TAbArchiveItem);\n procedure Save;\n {saves the archive}\n procedure TagItems(const FileMask : string);\n procedure TestTaggedItems;\n procedure UnTagItems(const FileMask : string);\n\n public {properties}\n property Count : Integer\n read GetCount;\n property Items[Index : Integer] : TAbZipItem\n read GetItem\n write PutItem; default;\n property SelectedItem: LongInt\n read GetSelectedItem\n write SetSelectedItem;\n property SelectedZipItem : TAbZipItem\n read GetSelectedZipItem;\n property Status : TAbArchiveStatus\n read GetStatus;\n property TempDirectory : string\n read FTempDirectory\n write SetTempDirectory;\n property ZipfileComment : AnsiString\n read GetZipfileComment\n write SetZipfileComment;\n end;\n\n\ntype\n TAbZipOutline = class(TAbCustomZipOutline)\n published\n property Align;\n property ArchiveProgressMeter;\n property ItemProgressMeter;\n property Attributes;\n property AutoSave;\n property BaseDirectory;\n property BorderStyle;\n property Color\n default AbDefColor;\n property CompressionMethodToUse;\n property Count;\n{$IFNDEF UsingCLX}\n property Ctl3D;\n{$ENDIF}\n property Cursor;\n property DeflationOption;\n{$IFDEF MSWINDOWS}\n property DOSMode;\n{$ENDIF}\n{$IFNDEF UsingCLX}\n property DragCursor;\n{$ENDIF}\n property DragMode;\n property Enabled;\n property ExtractOptions;\n property Font;\n property Hierarchy;\n property LogFile;\n property Logging;\n property OnProcessItemFailure;\n property OnArchiveItemProgress;\n property OnArchiveProgress;\n property OnChange;\n property OnClick;\n property OnConfirmProcessItem;\n property OnConfirmOverwrite;\n property OnConfirmSave;\n property OnCollapse;\n property OnDblClick;\n property OnDragDrop;\n property OnDragOver;\n property OnEndDrag;\n property OnEnter;\n property OnExit;\n property OnExpand;\n property OnKeyDown;\n property OnKeyPress;\n property OnKeyUp;\n property OnLoad;\n property OnMouseDown;\n property OnMouseMove;\n property OnMouseUp;\n{$IFNDEF UsingCLX}\n property OnMouseWheel;\n property OnMouseWheelDown;\n property OnMouseWheelUp;\n{$ENDIF}\n property OnNeedPassword;\n property OnRequestImage;\n property OnRequestLastDisk;\n property OnRequestNthDisk;\n property OnRequestBlankDisk;\n property OnSave;\n{$IFDEF MSWINDOWS}\n property OnStartDrag;\n{$ENDIF MSWINDOWS}\n property OnWindowsDrop;\n property ParentColor\n default AbDefParentColor;\n{$IFNDEF UsingCLX}\n property ParentCtl3D;\n{$ENDIF}\n property ParentFont;\n property ParentShowHint;\n property Password;\n property PasswordRetries;\n property PictureDirectory;\n property PictureDirectorySelected;\n property PictureFile;\n property PictureFileSelected;\n property PictureZipAttribute;\n property PictureZipAttributeSelected;\n property PopupMenu;\n property ShowHint;\n property StoreOptions;\n property TabOrder;\n property TabStop;\n property SpanningThreshold;\n property Version;\n property TempDirectory;\n property Visible;\n property FileName; {must be after OnLoad}\n end;\n\nimplementation\n\nuses\n{$IFDEF MSWINDOWS}\n ShellApi,\n{$ENDIF}\n SysUtils,\n AbConst,\n AbExcept,\n AbResString,\n AbUnzPrc,\n AbZipPrc;\n\n{$R AbZipOut.res}\n\ntype\n TAbZipArchiveFriend = class(TAbZipArchive)\n end;\n\n{ -------------------------------------------------------------------------- }\n{ ========================================================================== }\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.IndexBitmaps;\nbegin\n FImageList.Clear;\n\n FImageList.Height := FBitMapHeight;\n FImageList.Width := FBitMapWidth;\n\n if not FAttrBitMap.Empty then\n FAttrIndex := FImageList.Add( FAttrBitMap, nil );\n if not FAttrBitMap.Empty then\n FAttrSelectedIndex := FImageList.Add( FAttrBitMapSelected, nil );\n if not FAttrBitMap.Empty then\n FDirectoryIndex := FImageList.Add( FDirBitMap, nil );\n if not FAttrBitMap.Empty then\n FDirSelectedIndex := FImageList.Add( FDirBitMapSelected , nil );\n if not FAttrBitMap.Empty then\n FFileIndex := FImageList.Add( FFileBitMap, nil );\n if not FAttrBitMap.Empty then\n FFileSelectedIndex := FImageList.Add( FFileBitMapSelected, nil );\nend;\n{ -------------------------------------------------------------------------- }\nconstructor TAbZipDisplayOutline.Create(AOwner : TComponent);\nbegin\n FBitMapHeight := cBitmapHeight;\n FBitMapWidth := cBitmapWidth;\n\n FDirBitMap := TBitMap.Create;\n FFileBitMap := TBitMap.Create;\n FAttrBitMap := TBitMap.Create;\n FDirBitMapSelected := TBitMap.Create;\n FFileBitMapSelected := TBitMap.Create;\n FAttrBitMapSelected := TBitMap.Create;\n\n FDirBitMap.LoadFromResourceName( HInstance, 'DIR' );\n FFileBitMap.LoadFromResourceName( HInstance, 'FILEFIX' );\n FAttrBitMap.LoadFromResourceName( HInstance, 'ATTR' );\n FDirBitMapSelected.LoadFromResourceName ( HInstance, 'DIRS' );\n FFileBitMapSelected.LoadFromResourceName( HInstance, 'FILES' );\n FAttrBitMapSelected.LoadFromResourceName( HInstance, 'ATTRS' );\n\n inherited Create(AOwner);\n\n FImageList := TImageList.Create(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.Loaded;\nbegin\n inherited Loaded;\n{$IFNDEF UsingCLX}\n if Assigned(FOnWindowsDrop) then\n DragAcceptFiles(Handle, True);\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbZipDisplayOutline.Destroy;\nbegin\n FImageList.Free;\n FDirBitMap.Free;\n FFileBitMap.Free;\n FAttrBitMap.Free;\n FDirBitMapSelected.Free;\n FFileBitMapSelected.Free;\n FAttrBitMapSelected.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetAttributeBitMap(Value : TBitmap);\nbegin\n if Value <> nil then begin\n FAttrBitMap.assign( Value )\n end else begin\n FAttrBitMap.LoadFromResourceName( HInstance, 'ATTR' );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetDirectoryBitMap(Value : TBitmap);\nbegin\n if Value <> nil then begin\n FDirBitMap.assign( Value )\n end else begin\n FDirBitMap.LoadFromResourceName( HInstance, 'DIR' );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetFileBitMap(Value : TBitmap);\nbegin\n if Value <> nil then begin\n FFileBitMap.assign( Value )\n end else begin\n FFileBitMap.LoadFromResourceName( HInstance, 'FILEFIX' );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetAttributeBitMapSelected(Value : TBitmap);\nbegin\n if Value <> nil then\n FAttrBitMapSelected.assign( Value )\n else begin\n FAttrBitMapSelected.LoadFromResourceName( HInstance, 'ATTRS' );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetDirectoryBitMapSelected(Value : TBitmap);\nbegin\n if Value <> nil then\n FDirBitMapSelected.assign( Value )\n else begin\n FDirBitMapSelected.LoadFromResourceName ( HInstance, 'DIRS' );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetFileBitMapSelected(Value : TBitmap);\nbegin\n if Value <> nil then\n FFileBitMapSelected.assign( Value )\n else begin\n FFileBitMapSelected.LoadFromResourceName( HInstance, 'FILES' );\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetBitMapHeight(Value : Integer);\nbegin\n if FBitMapHeight <> Value then\n FBitMapHeight := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetBitMapWidth(Value : Integer);\nbegin\n if FBitMapWidth <> Value then\n FBitMapWidth := Value;\nend;\n{$IFNDEF UsingCLX}\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.WMDropFiles(var Msg : TWMDropFiles);\nvar\n FileName : string;\n I : Integer;\n NumFiles : Integer;\nbegin\n Msg.Result := 1;\n NumFiles := DragQueryFile(Msg.Drop, Cardinal(-1), nil, 0);\n try\n for I := 0 to pred(NumFiles) do begin\n SetLength(FileName, DragQueryFile(Msg.Drop, I, nil, 0));\n DragQueryFile(Msg.Drop, I, PChar(FileName), Length(FileName) + 1);\n DoOnWindowsDrop(FileName);\n end;\n finally\n DragFinish(Msg.Drop);\n end;\n if IsIconic(Application.Handle) then\n ShowWindow(Application.Handle, SW_SHOWNORMAL)\n else\n BringWindowToTop(Handle);\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.DoOnWindowsDrop(FileName : string);\nbegin\n if csDesigning in ComponentState then\n Exit;\n if csLoading in ComponentState then\n Exit;\n if Assigned(FOnWindowsDrop) then\n FOnWindowsDrop(Self, FileName);\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF UsingCLX}\nfunction TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState;\n WheelDelta: Integer; const MousePos: TPoint): Boolean;\n{$ELSE}\nfunction TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState;\n WheelDelta: Integer; MousePos: TPoint): Boolean;\n{$ENDIF}\n const\n WHEEL_DELTA = 120;\n var\n oHold : TTreeNode;\n oNode : TTreeNode;\nbegin\n { We always return true - if there's an event handler that returns }\n { false, we'll do the work; if it returns true, the work has been }\n { done, ergo this routine should return true. }\n Result := True;\n if not inherited DoMouseWheel(Shift, WheelDelta, MousePos) then begin\n if Items.Count = 0 then\n Exit;\n\n if Selected = nil then\n exit;\n if Selected.HasChildren then\n Selected.Expand( false );\n\n oNode := nil;\n oHold := Selected;\n if WheelDelta < 0 then begin\n if oHold.HasChildren then\n oNode := oHold.getFirstChild;\n if oNode = nil then\n oNode := oHold.GetNextChild( oHold );\n if oNode = nil then\n oNode := oHold.GetNext;\n end else begin\n oNode := oHold.GetPrevChild( oHold );\n if oNode <> nil then begin\n if oNode.HasChildren then\n oNode := oNode.GetLastChild;\n end else\n oNode := oHold.GetPrev;\n end;\n if oNode <> nil then\n Selected := oNode;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDisplayOutline.SetOnWindowsDrop(Value : TWindowsDropEvent);\n{$IFNDEF UsingCLX}\nvar\n WasAccepting : Boolean;\n{$ENDIF}\nbegin\n{$IFNDEF UsingCLX}\n WasAccepting := Assigned(FOnWindowsDrop);\n FOnWindowsDrop := Value;\n if csLoading in ComponentState then\n Exit;\n if csDestroying in ComponentState then\n Exit;\n if Assigned(Value) then\n DragAcceptFiles(Handle, True)\n else if WasAccepting then\n DragAcceptFiles(Handle, False);\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\n{ ========================================================================== }\n{ -------------------------------------------------------------------------- }\nconstructor TAbCustomZipOutline.Create(AOwner : TComponent);\nbegin\n inherited Create(AOwner);\n Width := 300;\n Height := 143;\n Color := AbDefColor;\n ParentColor := AbDefParentColor;\n\n FOutline := TAbZipDisplayOutline.Create(Self);\n FOutline.Parent := Self;\n FOutline.Visible := True;\n FOutline.Align := alClient;\n FOutline.ParentColor := True;\n{$IFNDEF UsingCLX}\n FOutline.ParentCtl3D := True;\n{$ENDIF}\n FOutline.ParentFont := True;\n FOutline.ParentShowHint := True;\n\n FOutline.Images := FOutline.FImageList;\n\n AutoSave := AbDefAutoSave;\n Attributes := AbDefZipAttributes;\n CompressionMethodToUse := AbDefCompressionMethodToUse;\n DeflationOption := AbDefDeflationOption;\n ExtractOptions := AbDefExtractOptions;\n Hierarchy := AbDefHierarchy;\n PasswordRetries := AbDefPasswordRetries;\n StoreOptions := AbDefStoreOptions;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomZipOutline.Destroy;\nbegin\n FArchive.Free;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.AddAttributeNodes( Item : TAbZipItem;\n oNode : TTreeNode );\nvar\n ExtAttrString : string;\n dt : TDateTime;\n li : LongInt;\n s : string;\n tmpNode : TTreeNode;\nbegin\n with Item do begin\n if zaCompressedSize in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode,\n Format(AbCompressedSizeFormatS,\n [CompressedSize]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaUnCompressedSize in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbUncompressedSizeFormatS,\n [UncompressedSize]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaCompressionMethod in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbCompressionMethodFormatS,\n [ZipCompressionMethodToString(CompressionMethod)]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaCompressionRatio in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbCompressionRatioFormatS,\n [CompressionRatio]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaCRC in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbCRCFormatS,\n [CRC32]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaExternalFileAttributes in Attributes then begin\n ExtAttrString := '';\n{$IFDEF MSWINDOWS}\n{$WARN SYMBOL_PLATFORM OFF}\n if (faReadOnly and ExternalFileAttributes) = faReadOnly then\n ExtAttrString := ExtAttrString + AbReadOnlyS;\n if (faHidden and ExternalFileAttributes) = faHidden then\n ExtAttrString := ExtAttrString + AbHiddenS;\n if (faSysFile and ExternalFileAttributes) = faSysFile then\n ExtAttrString := ExtAttrString + AbSystemS;\n if (faArchive and ExternalFileAttributes) = faArchive then\n ExtAttrString := ExtAttrString + AbArchivedS;\n{$WARN SYMBOL_PLATFORM ON}\n{$ENDIF}\n tmpNode := FOutline.Items.AddChild(oNode,\n Format(AbEFAFormatS,\n [ExtAttrString]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaInternalFileAttributes in Attributes then\n if InternalFileAttributes = 1 then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbIFAFormatS,\n [AbTextS]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end else begin\n tmpNode := FOutline.Items.AddChild(oNode,\n Format(AbIFAFormatS,\n [AbBinaryS]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaEncryption in Attributes then\n if IsEncrypted then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbEncryptionFormatS,\n [AbEncryptedS]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end else begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbEncryptionFormatS,\n [AbNotEncryptedS]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaTimeStamp in Attributes then begin\n if (LastModFileDate + LastModFileTime = 0) then\n s := AbUnknownS\n else begin\n li := LongInt(LastModFileDate) shl 16 + LastModFileTime;\n dt := FileDateToDateTime(li);\n s := DateTimeToStr(dt);\n end;\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbTimeStampFormatS, [s]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaVersionMade in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbMadeByFormatS,\n [Lo(VersionMadeBy)/ 10.0]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaVersionNeeded in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode, \n Format(AbNeededFormatS,\n [Lo(VersionNeededToExtract)/ 10.0]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n if zaComment in Attributes then begin\n tmpNode := FOutline.Items.AddChild(oNode,\n Format(AbCommentFormatS,\n [FileComment]));\n tmpNode.ImageIndex := FOutline.FAttrIndex;\n tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;\n end;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.AddFiles(const FileMask : string;\n SearchAttr : Integer);\n {Add files to the archive where the disk filespec matches}\nbegin\n if Assigned(FArchive) then\n FArchive.AddFiles(FileMask, SearchAttr)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.AddFilesEx(const FileMask, ExclusionMask : string;\n SearchAttr : Integer);\n {Add files that match Filemask except those matching ExclusionMask}\nbegin\n if Assigned(FArchive) then\n FArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.AddFromStream(const NewName : string;\n FromStream : TStream);\n {Add zip item directly from TStream descendant}\nbegin\n if Assigned(FArchive) then begin\n FromStream.Position := 0;\n FArchive.AddFromStream(NewName, FromStream);\n end else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ClearTags;\n {Clear all tags from the archive}\nbegin\n if Assigned(FArchive) then\n FArchive.ClearTags\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DeleteAt(Index : Integer);\n {delete item at Index}\nbegin\n if Assigned( FArchive ) then\n FArchive.DeleteAt( Index )\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DeleteFiles(const FileMask : string);\n {delete all files from the archive that match the file mask}\nbegin\n if Assigned(FArchive) then\n FArchive.DeleteFiles(FileMask)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DeleteFilesEx(const FileMask, ExclusionMask : string);\n {Delete files that match Filemask except those matching ExclusionMask}\nbegin\n if Assigned(FArchive) then\n FArchive.DeleteFilesEx(FileMask, ExclusionMask)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DeleteTaggedItems;\n {delete all tagged items from the archive}\nbegin\n if Assigned(FArchive) then\n FArchive.DeleteTaggedItems\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoProcessItemFailure(Sender : TObject;\n Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n ErrorClass : TAbErrorClass;\n ErrorCode : Integer);\nbegin\n if Assigned(FOnProcessItemFailure) then\n FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoArchiveItemProgress(Sender : TObject;\n Item : TAbArchiveItem;\n Progress : Byte;\n var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FItemProgressMeter) then\n FItemProgressMeter.DoProgress(Progress);\n if Assigned(FOnArchiveItemProgress) then\n FOnArchiveItemProgress(Self, Item, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoArchiveProgress(Sender : TObject;\n Progress : Byte;\n var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FArchiveProgressMeter) then\n FArchiveProgressMeter.DoProgress(Progress);\n if Assigned(FOnArchiveProgress) then\n FOnArchiveProgress(Self, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoChange;\nbegin\n {Archive now points to the new zip file}\n UpdateOutline;\n {then, call the FOnChange event...}\n if Assigned(FOnChange) then\n FOnChange(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoClick(Sender : TObject);\nbegin\n if Assigned(FOnClick) then\n FOnClick(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoCollapse(Sender: TObject; Node: TTreeNode);\nbegin\n if Assigned(FOnCollapse) then\n FOnCollapse(Self, Node);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoConfirmProcessItem(Sender : TObject;\n Item : TAbArchiveItem;\n ProcessType : TAbProcessType;\n var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FItemProgressMeter) then\n FItemProgressMeter.Reset;\n if Assigned(FOnConfirmProcessItem) then\n FOnConfirmProcessItem(Self, Item, ProcessType, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoConfirmOverwrite(var Name : string;\n var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmOverwrite) then\n FOnConfirmOverwrite(Name, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoConfirmSave(Sender : TObject;\n var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmSave) then\n FOnConfirmSave(Self, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoDblClick(Sender : TObject);\nbegin\n if Assigned(FOnDblClick) then\n FOnDblClick(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoDragDrop(Sender, Source: TObject; X, Y: Integer);\nbegin\n if Assigned(FOnDragDrop) then\n FOnDragDrop(Self, Source, X, Y);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoDragOver(Sender, Source: TObject; X, Y: Integer;\n State: TDragState; var Accept: Boolean);\nbegin\n Accept := False;\n if Assigned(FOnDragOver) then\n FOnDragOver(Self, Source, X, Y, State, Accept);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoOnEndDrag(Sender, Target: TObject; X, Y: Integer);\nbegin\n if Assigned(FOnEndDrag) then\n FOnEndDrag(Self, Target, X, Y);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoOnEnter(Sender : TObject);\nbegin\n if Assigned(FOnEnter) then\n FOnEnter(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoOnExit(Sender : TObject);\nbegin\n if Assigned(FOnExit) then\n FOnExit(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoExpand(Sender: TObject; Node : TTreeNode);\nbegin\n if Assigned(FOnExpand) then\n FOnExpand(Self, Node);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoKeyDown(Sender : TObject; var Key: Word;\n Shift: TShiftState);\nbegin\n if Assigned(FOnKeyDown) then\n FOnKeyDown(Self, Key, Shift);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoKeyPress(Sender : TObject; var Key: Char);\nbegin\n if Assigned(FOnKeyPress) then\n FOnKeyPress(Self, Key);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoKeyUp(Sender : TObject; var Key: Word;\n Shift: TShiftState);\nbegin\n if Assigned(FOnKeyUp) then\n FOnKeyUp(Self, Key, Shift);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoLoad(Sender : TObject);\nbegin\n if Assigned(FOnLoad) then\n FOnLoad(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoMouseDown(Sender : TObject; Button: TMouseButton;\n Shift: TShiftState;\n X, Y : Integer);\nbegin\n if Assigned(FOnMouseDown) then\n FOnMouseDown(Self, Button, Shift, X, Y);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoMouseMove(Sender : TObject;\n Shift: TShiftState; X, Y: Integer);\nbegin\n if Assigned(FOnMouseMove) then\n FOnMouseMove(Self, Shift, X, Y);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoMouseUp(Sender : TObject;\n Button: TMouseButton; Shift: TShiftState;\n X, Y: Integer);\nbegin\n if Assigned(FOnMouseUp) then\n FOnMouseUp(Self, Button, Shift, X, Y);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoNeedPassword(Sender : TObject;\n var NewPassword : AnsiString);\nbegin\n if Assigned(FOnNeedPassword) then begin\n FOnNeedPassword(Sender, NewPassword);\n Password := NewPassword;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoSave(Sender : TObject);\nbegin\n if Assigned(FOnSave) then\n FOnSave(Self);\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF MSWINDOWS}\nprocedure TAbCustomZipOutline.DoOnStartDrag(Sender: TObject;\n var DragObject: TDragObject);\nbegin\n if Assigned(FOnStartDrag) then\n FOnStartDrag(Self, DragObject);\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.DoWindowsDrop(Sender : TObject;\n FileName : string);\nbegin\n if csDesigning in ComponentState then\n Exit;\n if csLoading in ComponentState then\n Exit;\n if Assigned(FOnWindowsDrop) then\n FOnWindowsDrop(Self, FileName);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ExtractAt(Index : Integer; const NewName : string);\n {extract a file from the archive that match the index}\nbegin\n if Assigned(FArchive) then\n FArchive.ExtractAt(Index, NewName)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ExtractFiles(const FileMask : string);\n {extract all files from the archive that match the mask}\nbegin\n if Assigned(FArchive) then\n FArchive.ExtractFiles(FileMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ExtractFilesEx(const FileMask, ExclusionMask : string);\n {extract files that match FileMask except those matching ExclusionMask}\nbegin\n if Assigned(FArchive) then\n FArchive.ExtractFilesEx(FileMask, ExclusionMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ExtractTaggedItems;\n {extract all tagged items from the archive}\nbegin\n if Assigned(FArchive) then\n FArchive.ExtractTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ExtractToStream(const aFileName : string;\n ToStream : TStream);\nbegin\n if Assigned(FArchive) then\n FArchive.ExtractToStream(aFileName, ToStream)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.FindFile(const aFileName : string) : Integer;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.FindFile(aFileName)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.FindItem(aItem : TAbArchiveItem) : Integer;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.FindItem(aItem)\n else\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.FreshenFiles(const FileMask : string);\n {freshen all items that match the file mask}\nbegin\n if Assigned(FArchive) then\n FArchive.FreshenFiles(FileMask)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.FreshenFilesEx(const FileMask, ExclusionMask : string);\n {freshen all items matching FileMask except those matching ExclusionMask}\nbegin\n if Assigned(FArchive) then\n FArchive.FreshenFilesEx(FileMask, ExclusionMask)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.FreshenTaggedItems;\n {freshen all tagged items}\nbegin\n if Assigned(FArchive) then\n FArchive.FreshenTaggedItems\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.FullCollapse;\nbegin\n FOutline.FullCollapse;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.FullExpand;\nbegin\n FOutline.FullExpand;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetBorderStyle : TBorderStyle;\nbegin\n Result := FOutline.BorderStyle;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetCount : Integer;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.Count\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetCursor : TCursor;\nbegin\n Result := FOutline.Cursor;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFNDEF UsingCLX}\nfunction TAbCustomZipOutline.GetDragCursor : TCursor;\nbegin\n Result := FOutline.DragCursor;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetDragMode : TDragMode;\nbegin\n Result := FOutline.DragMode;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetItem(Index : Integer) : TAbZipItem;\nbegin\n if Assigned(FArchive) then\n Result := TAbZipItem(FArchive.ItemList[Index])\n else\n Result := nil;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureDirectory : TBitmap;\nbegin\n Result := FOutline.zdPictureDirectory;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureFile : TBitmap;\nbegin\n Result := FOutline.zdPictureFile;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureZipAttribute: TBitmap;\nbegin\n Result := FOutline.zdPictureZipAttribute;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureDirectorySelected : TBitmap;\nbegin\n Result := FOutline.zdPictureDirectorySelected;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureFileSelected : TBitmap;\nbegin\n Result := FOutline.zdPictureFileSelected;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureZipAttributeSelected: TBitmap;\nbegin\n Result := FOutline.zdPictureZipAttributeSelected;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureHeight: Integer;\nbegin\n Result := FOutline.FBitMapHeight;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetPictureWidth: Integer;\nbegin\n Result := FOutline.FBitMapWidth;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetSelectedItem : LongInt;\nbegin\n Result := FOutline.Selected.AbsoluteIndex;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetSelectedZipItem : TAbZipItem;\nbegin\n {returns nil if the currently selected item of the outline is a folder or\n a zip attribute}\n if FOutline.Items.Count > 0 then\n Result := FOutline.Selected.Data\n else\n Result := nil;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetStatus : TAbArchiveStatus;\nbegin\n if Assigned(FArchive) then\n Result := FArchive.Status\n else\n Result := asInvalid;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetTextItem(const Value: string): LongInt;\nvar\n oNode : TTreeNode;\n oHold : TTreeNode;\nbegin\n Result := -1;\n if FOutline.Items.Count <= 0 then\n exit;\n\n oNode := FOutline.Items[0];\n while oNode <> nil do begin\n if oNode.Text = Value then\n break;\n oHold := oNode;\n oNode := nil;\n if oHold.HasChildren then\n oNode := oHold.getFirstChild;\n if oNode = nil then\n oNode := oHold.GetNextChild( oHold );\n if oNode = nil then\n oNode := oHold.GetNext;\n end;\n if oNode <> nil then\n Result := oNode.AbsoluteIndex\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetOutLineItem(X, Y : Integer): LongInt;\nvar\n oNode : TTreeNode;\nbegin\n oNode := FOutLine.GetNodeAt(X, X);\n if oNode <> nil then\n Result := oNode.AbsoluteIndex\n else\n Result := -1;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetVersion : string;\nbegin\n Result := AbVersionS;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbCustomZipOutline.GetZipfileComment : AnsiString;\nbegin\n if Assigned(FArchive) then\n Result := TAbZipArchive(FArchive).ZipfileComment\n else\n Result := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.InitArchive;\nbegin\n if Assigned(FArchive) then begin\n {properties}\n FArchive.AutoSave := FAutoSave;\n FArchive.CompressionMethodToUse := FCompressionMethodToUse;\n SetBaseDirectory(FBaseDirectory);\n FArchive.DeflationOption := FDeflationOption;\n{$IFDEF MSWINDOWS}\n FArchive.DOSMode := FDOSMode;\n{$ENDIF}\n FArchive.ExtractOptions := FExtractOptions;\n FArchive.LogFile := FLogFile;\n FArchive.Logging := FLogging;\n FArchive.Password := FPassword;\n FArchive.PasswordRetries := FPasswordRetries;\n FArchive.StoreOptions := FStoreOptions;\n FArchive.TempDirectory := FTempDirectory;\n FArchive.SpanningThreshold := FSpanningThreshold;\n {events}\n TAbZipArchiveFriend(FArchive).ExtractHelper := UnzipProc;\n TAbZipArchiveFriend(FArchive).ExtractToStreamHelper := UnzipToStreamProc;\n TAbZipArchiveFriend(FArchive).InsertHelper := ZipProc;\n TAbZipArchiveFriend(FArchive).InsertFromStreamHelper := ZipFromStreamProc;\n FArchive.OnProcessItemFailure := DoProcessItemFailure;\n FArchive.OnArchiveItemProgress := DoArchiveItemProgress;\n FArchive.OnArchiveProgress := DoArchiveProgress;\n FArchive.OnConfirmProcessItem := DoConfirmProcessItem;\n FArchive.OnConfirmOverwrite := DoConfirmOverwrite;\n FArchive.OnConfirmSave := DoConfirmSave;\n FArchive.OnLoad := DoLoad;\n FArchive.OnSave := DoSave;\n FArchive.OnRequestImage := FOnRequestImage;\n FArchive.OnNeedPassword := DoNeedPassword;\n FArchive.OnRequestBlankDisk := FOnRequestBlankDisk;\n FArchive.OnRequestLastDisk := FOnRequestLastDisk;\n FArchive.OnRequestNthDisk := FOnRequestNthDisk;\n TAbZipArchiveFriend(FArchive).TestHelper := TestItemProc;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.Loaded;\nbegin\n inherited Loaded;\n FOutline.OnClick := DoClick;\n FOutline.OnCollapsed := DoCollapse;\n FOutline.OnDblClick := DoDblClick;\n FOutline.OnDragDrop := DoDragDrop;\n FOutline.OnDragOver := DoDragOver;\n FOutline.OnEndDrag := DoOnEndDrag;\n FOutline.OnEnter := DoOnEnter;\n FOutline.OnExit := DoOnExit;\n FOutline.OnExpanded := DoExpand;\n FOutline.OnKeyDown := DoKeyDown;\n FOutline.OnKeyPress := DoKeyPress;\n FOutline.OnKeyUp := DoKeyUp;\n FOutline.OnMouseDown := DoMouseDown;\n FOutline.OnMouseMove := DoMouseMove;\n FOutline.OnMouseUp := DoMouseUp;\n{$IFDEF MSWINDOWS}\n FOutline.OnStartDrag := DoOnStartDrag;\n{$ENDIF MSWINDOWS}\n if Assigned(FOnWindowsDrop) then\n FOutline.OnWindowsDrop := DoWindowsDrop\n else\n FOutline.OnWindowsDrop := nil;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.Move(aItem : TAbArchiveItem; NewStoredPath : string);\nbegin\n if Assigned(FArchive) then\n FArchive.Move(aItem, NewStoredPath)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.Notification(Component: TComponent;\n Operation: TOperation);\nbegin\n inherited Notification(Component, Operation);\n if (Operation = opRemove) then begin\n if Assigned(ItemProgressMeter) and Component.IsImplementorOf(ItemProgressMeter) then\n ItemProgressMeter := nil;\n if Assigned(ArchiveProgressMeter) and Component.IsImplementorOf(ArchiveProgressMeter) then\n ArchiveProgressMeter := nil;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.PutItem(Index : Integer; Value : TAbZipItem);\nbegin\n if Assigned(FArchive) then\n FArchive.ItemList[Index] := Value\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.Replace(aItem : TAbArchiveItem);\n {replace the item}\nbegin\n if Assigned( FArchive ) then\n FArchive.Replace( aItem )\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.Save;\nbegin\n if Assigned(FArchive) then begin\n FArchive.Save;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetArchiveProgressMeter(const Value: IAbProgressMeter);\nbegin\n ReferenceInterface(FArchiveProgressMeter, opRemove);\n FArchiveProgressMeter := Value;\n ReferenceInterface(FArchiveProgressMeter, opInsert);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetAttributes(Value : TAbZipAttributes);\nbegin\n FAttributes := Value;\n UpdateOutline;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetAutoSave(Value : Boolean);\nbegin\n FAutoSave := Value;\n if Assigned(FArchive) then\n FArchive.AutoSave := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetBaseDirectory(Value : string);\nbegin\n if Assigned(FArchive) then begin\n FArchive.BaseDirectory := Value;\n FBaseDirectory := FArchive.BaseDirectory;\n end\n else\n FBaseDirectory := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetBorderStyle(Value : TBorderStyle);\nbegin\n FOutline.BorderStyle := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetCompressionMethodToUse(\n Value : TAbZipSupportedMethod);\nbegin\n FCompressionMethodToUse := Value;\n if Assigned(FArchive) then\n FArchive.CompressionMethodToUse := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetCursor(Value : TCursor);\nbegin\n FOutline.Cursor := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetDeflationOption(Value : TAbZipDeflationOption);\nbegin\n FDeflationOption := Value;\n if Assigned(FArchive) then\n FArchive.DeflationOption := Value;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF MSWINDOWS}\nprocedure TAbCustomZipOutline.SetDOSMode(Value : Boolean);\nbegin\n FDOSMode := Value;\n if Assigned(FArchive) then\n FArchive.DOSMode := Value;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\n{$IFNDEF UsingCLX}\nprocedure TAbCustomZipOutline.SetDragCursor(Value : TCursor);\nbegin\n FOutline.DragCursor := Value;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\n{$IFNDEF UsingCLX}\nprocedure TAbCustomZipOutline.SetDragMode(Value : TDragMode);\nbegin\n {$IFDEF MSWINDOWS}\n inherited SetDragMode(Value);\n {$ENDIF}\n FOutline.DragMode := Value;\nend;\n{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetExtractOptions(Value : TAbExtractOptions);\nbegin\n FExtractOptions := Value;\n if Assigned(FArchive) then\n FArchive.ExtractOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetFileName(const aFileName : string);\nbegin\n if Assigned(FArchive) and (Status = asBusy) then\n raise EAbArchiveBusy.Create;\n FFileName := aFileName;\n try\n if Assigned(FArchive) then\n FArchive.Save;\n except\n end;\n FArchive.Free;\n FArchive := nil;\n if FileName <> '' then\n if FileExists(FileName) then begin\n if csDesigning in ComponentState then\n FArchive := TAbZipArchive.Create(FileName,\n fmOpenRead or\n fmShareDenyNone)\n else begin\n try\n FArchive := TAbZipArchive.Create(FileName,\n fmOpenReadWrite or\n fmShareDenyWrite);\n except\n {deals with read-only files}\n FArchive := TAbZipArchive.Create(FileName,\n fmOpenRead or\n fmShareDenyWrite);\n end;\n InitArchive;\n end;\n FArchive.Load;\n end\n else begin\n FArchive := TAbZipArchive.Create(FileName,\n fmCreate or fmShareDenyNone);\n InitArchive;\n try\n FArchive.Load;\n except\n end;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetHierarchy(Value : Boolean);\nbegin\n FHierarchy := Value;\n UpdateOutline;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetItemProgressMeter(const Value: IAbProgressMeter);\nbegin\n ReferenceInterface(FItemProgressMeter, opRemove);\n FItemProgressMeter := Value;\n ReferenceInterface(FItemProgressMeter, opInsert);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetLogFile(Value : string);\nbegin\n FLogFile := Value;\n if (csDesigning in ComponentState) then\n Exit;\n if Assigned(FArchive) then\n FArchive.LogFile := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetLogging(Value : Boolean);\nbegin\n FLogging := Value;\n if (csDesigning in ComponentState) then\n Exit;\n if Assigned(FArchive) then\n FArchive.Logging:= Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetOnRequestImage(Value : TAbRequestImageEvent);\nbegin\n FOnRequestImage := Value;\n if Assigned(FArchive) then\n FArchive.OnRequestImage := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetOnRequestLastDisk(Value : TAbRequestDiskEvent);\nbegin\n FOnRequestLastDisk := Value;\n if Assigned(FArchive) then\n FArchive.OnRequestLastDisk := FOnRequestLastDisk;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetOnRequestNthDisk(Value : TAbRequestNthDiskEvent);\nbegin\n FOnRequestNthDisk := Value;\n if Assigned(FArchive) then\n FArchive.OnRequestNthDisk := FOnRequestNthDisk;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetOnRequestBlankDisk(Value : TAbRequestDiskEvent);\nbegin\n FOnRequestBlankDisk := Value;\n if Assigned(FArchive) then\n FArchive.OnRequestBlankDisk := FOnRequestBlankDisk;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetOnWindowsDrop(Value : TWindowsDropEvent);\nbegin\n FOnWindowsDrop := Value;\n if csLoading in ComponentState then\n Exit;\n if csDestroying in ComponentState then\n Exit;\n if Assigned(Value) then\n FOutline.OnWindowsDrop := DoWindowsDrop\n else\n FOutline.OnWindowsDrop := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPassword(Value : AnsiString);\nbegin\n FPassword := Value;\n if Assigned(FArchive) then\n FArchive.Password := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPasswordRetries(Value : Byte);\nbegin\n FPasswordRetries := Value;\n if Assigned(FArchive) then\n FArchive.PasswordRetries := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureDirectory(Value : TBitmap);\nbegin\n if Value <> nil then begin\n if (Value.Height = FOutline.FBitMapHeight) and\n (Value.Width = FOutline.FBitMapWidth) then\n FOutline.zdPictureDirectory := Value;\n end else\n FOutline.zdPictureDirectory := nil;\n\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureFile(Value : TBitmap);\nbegin\n if Value <> nil then begin\n if (Value.Height = FOutline.FBitMapHeight) and\n (Value.Width = FOutline.FBitMapWidth) then\n FOutline.zdPictureFile := Value;\n end else\n FOutline.zdPictureFile := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureZipAttribute(Value : TBitmap);\nbegin\n if Value <> nil then begin\n if (Value.Height = FOutline.FBitMapHeight) and\n (Value.Width = FOutline.FBitMapWidth) then\n FOutline.zdPictureZipAttribute := Value;\n end else\n FOutline.zdPictureZipAttribute := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureDirectorySelected(Value : TBitmap);\nbegin\n if Value <> nil then begin\n if (Value.Height = FOutline.FBitMapHeight) and\n (Value.Width = FOutline.FBitMapWidth) then\n FOutline.zdPictureDirectorySelected := Value;\n end else\n FOutline.zdPictureDirectorySelected := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureFileSelected(Value : TBitmap);\nbegin\n if Value <> nil then begin\n if (Value.Height = FOutline.FBitMapHeight) and\n (Value.Width = FOutline.FBitMapWidth) then\n FOutline.zdPictureFileSelected := Value;\n end else\n FOutline.zdPictureFileSelected := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureZipAttributeSelected(Value : TBitmap);\nbegin\n if Value <> nil then begin\n if (Value.Height = FOutline.FBitMapHeight) and\n (Value.Width = FOutline.FBitMapWidth) then\n FOutline.zdPictureZipAttributeSelected := Value;\n end else\n FOutline.zdPictureZipAttributeSelected := nil;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureHeight(Value : Integer);\nbegin\n FOutline.FBitMapHeight := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetPictureWidth(Value : Integer);\nbegin\n FOutline.FBitMapWidth := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetSelectedItem(Value : LongInt);\nbegin\n if ( Value >= 0 ) and ( Value <= pred( FOutline.Items.Count )) then\n FOutline.Selected := FOutline.Items[ Value ];\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetStoreOptions(Value : TAbStoreOptions);\nbegin\n FStoreOptions := Value;\n if Assigned(FArchive) then\n FArchive.StoreOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetTempDirectory(Value : string);\nbegin\n FTempDirectory := Value;\n if Assigned(FArchive) then\n FArchive.TempDirectory := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetSpanningThreshold(Value : Longint);\nbegin\n FSpanningThreshold := Value;\n if Assigned(FArchive) then\n FArchive.SpanningThreshold := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetVersion(Value : string);\nbegin\n {NOP}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.SetZipfileComment(Value : AnsiString);\nbegin\n if Assigned(FArchive) then\n TAbZipArchive(FArchive).ZipfileComment := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.TagItems(const FileMask : string);\n {tag all items that match the mask}\nbegin\n if Assigned(FArchive) then\n FArchive.TagItems(FileMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.UnTagItems(const FileMask : string);\n {clear tags for all items that match the mask}\nbegin\n if Assigned(FArchive) then\n FArchive.UnTagItems(FileMask)\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.UnzipProc(Sender : TObject;\n Item : TAbArchiveItem;\n const NewName : string);\nbegin\n AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.UnzipToStreamProc(Sender : TObject;\n Item : TAbArchiveItem;\n OutStream : TStream);\nbegin\n if Assigned(OutStream) then\n AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.UpdateOutline;\nvar\n Found : Boolean;\n i : Integer;\n CurRoot : TTreeNode;\n CurParent : TTreeNode;\n CurChild : TTreeNode;\n RootNode : TTreeNode;\n oNode : TTreeNode;\n SubDir : string;\n ItemString : string;\n\n function GetSubDir(var ItemString : string) : string;\n var\n i : Integer;\n begin\n i := Pos(AbPathDelim, ItemString);\n Result := '';\n if i > 0 then begin\n Result := Copy(ItemString, 1, pred(i));\n System.Delete(ItemString, 1, i);\n end;\n end;\nbegin\n RootNode := nil;\n CurRoot := nil;\n FOutline.Items.Clear;\n if not Assigned(FArchive) then\n Exit;\n if FArchive.Count = 0 then\n Exit;\n\n FOutline.IndexBitmaps;\n\n if Hierarchy then begin\n for i := 0 to pred(FArchive.Count) do begin\n {do not display deleted items...}\n if FArchive.ItemList[i].Action = aaDelete then\n continue;\n\n ItemString := FArchive.ItemList[i].FileName;\n AbUnfixName(ItemString);\n\n if ItemString[ Length( ItemString )] = AbPathDelim then\n Continue;\n\n if ( FOutline.Items.Count <> 0 ) and ( CurRoot <> nil ) then begin\n SubDir := GetSubDir(ItemString);\n\n if RootNode = nil then\n RootNode := FOutline.TopItem;\n\n CurParent := RootNode;\n while CurParent <> nil do begin\n if CurParent.Text = SubDir then begin\n CurRoot := CurParent;\n break;\n end else begin\n CurParent := CurParent.getNextSibling;\n end;\n end;\n if CurParent = nil then begin\n ItemString := FArchive.ItemList[i].FileName;\n AbUnfixName(ItemString);\n end;\n end else\n CurParent := nil;\n\n SubDir := GetSubDir(ItemString);\n while SubDir <> '' do begin\n if CurParent <> nil then begin\n Found := False;\n CurChild := CurParent.GetFirstChild;\n while CurChild <> nil do begin\n if CurChild.Text <> SubDir then\n CurChild := CurParent.GetNextChild( CurChild )\n else begin\n Found := True;\n break;\n end;\n end;\n if Found then\n CurParent := CurChild\n else begin\n if ItemString <> '' then begin\n CurParent := FOutline.Items.AddChild( CurParent, SubDir );\n CurParent.ImageIndex := FOutline.FDirectoryIndex;\n CurParent.SelectedIndex := FOutline.FDirSelectedIndex;\n end;\n end;\n end else begin\n if ItemString <> '' then begin\n CurRoot := FOutline.Items.Add( nil, SubDir );\n if FOutline.Items.Count = 1 then\n RootNode := CurRoot;\n CurRoot.ImageIndex := FOutline.FDirectoryIndex;\n CurRoot.SelectedIndex := FOutline.FDirSelectedIndex;\n CurParent := CurRoot\n end;\n end;\n SubDir := GetSubDir(ItemString);\n end;\n if ItemString <> '' then begin\n oNode := FOutline.Items.AddChildObject(CurParent, ItemString,\n FArchive.ItemList[i]);\n\n if FOutline.Items.Count = 1 then\n RootNode := oNode;\n oNode.ImageIndex := FOutline.FFileIndex;\n oNode.SelectedIndex := FOutline.FFileSelectedIndex;\n AddAttributeNodes(TAbZipItem(FArchive.ItemList[i]), oNode);\n end;\n end;\n end\n else begin\n for i := 0 to pred(FArchive.Count) do begin\n ItemString := FArchive.ItemList[i].FileName;\n AbUnfixName(ItemString);\n oNode := FOutline.Items.AddObject(FOutline.Selected, ItemString,\n FArchive.ItemList[i]);\n\n oNode.ImageIndex := FOutline.FFileIndex;\n oNode.SelectedIndex := FOutline.FFileSelectedIndex;\n AddAttributeNodes(TAbZipItem(FArchive.ItemList[i]), oNode);\n end;\n end;\n FullExpand;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.TestItemProc(Sender : TObject; Item : TAbArchiveItem);\nbegin\n AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item));\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.TestTaggedItems;\n {Test specified items}\nbegin\n if Assigned(FArchive) then\n FArchive.TestTaggedItems\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ZipProc(Sender : TObject;\n Item : TAbArchiveItem;\n OutStream : TStream);\nbegin\n AbZip(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.ZipFromStreamProc(Sender : TObject;\n Item : TAbArchiveItem;\n OutStream, InStream : TStream);\nbegin\n if Assigned(InStream) then\n AbZipFromStream(TAbZipArchive(Sender), TAbZipItem(Item),\n OutStream, InStream)\n else\n raise EAbZipNoInsertion.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.CloseArchive;\n {closes the archive by setting FileName to ''}\nbegin\n if FFileName <> '' then\n FileName := '';\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipOutline.OpenArchive(const aFileName : String);\n {opens the archive}\nbegin\n FileName := AFileName;\nend;\n{ -------------------------------------------------------------------------- }\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbZipPrc.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZipPrc.pas *}\n{*********************************************************}\n{* ABBREVIA: TABZipHelper class *}\n{*********************************************************}\n\nunit AbZipPrc;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbZipTyp;\n\n procedure AbZip( Sender : TAbZipArchive; Item : TAbZipItem;\n OutStream : TStream );\n\n procedure AbZipFromStream(Sender : TAbZipArchive; Item : TAbZipItem;\n OutStream, InStream : TStream);\n\n procedure DeflateStream( UncompressedStream, CompressedStream : TStream );\n {-Deflates everything in UncompressedStream to CompressedStream\n no encryption is tried, no check on CRC is done, uses the whole\n compressedstream - no Progress events - no Frills! }\n\nimplementation\n\nuses\n{$IFDEF MSWINDOWS}\n Windows,\n{$ENDIF}\n{$IFDEF LibcAPI}\n Libc,\n{$ENDIF}\n SysUtils,\n AbArcTyp,\n AbExcept,\n AbUtils,\n AbDfCryS,\n AbVMStrm,\n AbDfBase,\n AbDfEnc,\n AbSpanSt;\n\n\n{ ========================================================================== }\nprocedure DoDeflate(Archive : TAbZipArchive; Item : TAbZipItem; OutStream, InStream : TStream);\nconst\n DEFLATE_NORMAL_MASK = $00;\n DEFLATE_MAXIMUM_MASK = $02;\n DEFLATE_FAST_MASK = $04;\n DEFLATE_SUPERFAST_MASK = $06;\nvar\n Hlpr : TAbDeflateHelper;\nbegin\n Item.CompressionMethod := cmDeflated;\n\n Hlpr := TAbDeflateHelper.Create;\n\n {anything dealing with store options, etc. should already be done.}\n\n try {Hlpr}\n Hlpr.StreamSize := InStream.Size;\n\n { set deflation level desired }\n Hlpr.PKZipOption := '0';\n\n case Archive.DeflationOption of\n doNormal : begin\n Hlpr.PKZipOption := 'n';\n Item.GeneralPurposeBitFlag :=\n Item.GeneralPurposeBitFlag or DEFLATE_NORMAL_MASK;\n end;\n\n doMaximum : begin\n Hlpr.PKZipOption := 'x';\n Item.GeneralPurposeBitFlag :=\n Item.GeneralPurposeBitFlag or DEFLATE_MAXIMUM_MASK;\n end;\n\n doFast : begin\n Hlpr.PKZipOption := 'f';\n Item.GeneralPurposeBitFlag :=\n Item.GeneralPurposeBitFlag or DEFLATE_FAST_MASK;\n end;\n\n doSuperFast : begin\n Hlpr.PKZipOption := 's';\n Item.GeneralPurposeBitFlag :=\n Item.GeneralPurposeBitFlag or DEFLATE_SUPERFAST_MASK;\n end;\n end;\n\n { attach progress notification method }\n Hlpr.OnProgressStep := Archive.DoInflateProgress;\n\n { provide encryption check value }\n Item.CRC32 := Deflate(InStream, OutStream, Hlpr);\n\n finally {Hlpr}\n Hlpr.Free;\n end; {Hlpr}\nend;\n{ ========================================================================== }\nprocedure DoStore(Archive : TAbZipArchive; Item : TAbZipItem; OutStream, InStream : TStream);\nvar\n CRC32 : LongInt;\n Percent : LongInt;\n LastPercent : LongInt;\n InSize : Int64;\n DataRead : Int64;\n Total : Int64;\n Abort : Boolean;\n Buffer : array [0..8191] of byte;\nbegin\n { setup }\n Item.CompressionMethod := cmStored;\n Abort := False;\n CRC32 := -1;\n Total := 0;\n Percent := 0;\n LastPercent := 0;\n InSize := InStream.Size;\n\n { get first bufferful }\n DataRead := InStream.Read(Buffer, SizeOf(Buffer));\n { while more data has been read and we're not told to bail }\n while (DataRead <> 0) and not Abort do begin\n {report the progress}\n if Assigned(Archive.OnProgress) then begin\n Total := Total + DataRead;\n Percent := Round((100.0 * Total) / InSize);\n if (LastPercent <> Percent) then\n Archive.OnProgress(Percent, Abort);\n LastPercent := Percent;\n end;\n\n { update CRC}\n AbUpdateCRCBuffer(CRC32, Buffer, DataRead);\n\n { write data (encrypting if needed) }\n OutStream.WriteBuffer(Buffer, DataRead);\n\n { get next bufferful }\n DataRead := InStream.Read(Buffer, SizeOf(Buffer));\n end;\n\n { finish CRC calculation }\n Item.CRC32 := not CRC32;\n\n { show final progress increment }\n if (Percent < 100) and Assigned(Archive.OnProgress) then\n Archive.OnProgress(100, Abort);\n\n { User wants to bail }\n if Abort then begin\n raise EAbUserAbort.Create;\n end;\n\nend;\n{ ========================================================================== }\nprocedure DoZipFromStream(Sender : TAbZipArchive; Item : TAbZipItem;\n OutStream, InStream : TStream);\nvar\n ZipArchive : TAbZipArchive;\n InStartPos : LongInt;\n TempOut : TAbVirtualMemoryStream;\n DestStrm : TStream;\nbegin\n ZipArchive := TAbZipArchive(Sender);\n\n { configure Item }\n Item.UncompressedSize := InStream.Size;\n Item.GeneralPurposeBitFlag := Item.GeneralPurposeBitFlag and AbLanguageEncodingFlag;\n\n if ZipArchive.Password <> '' then { encrypt the stream }\n DestStrm := TAbDfEncryptStream.Create(OutStream,\n LongInt(Item.LastModFileTime shl $10),\n ZipArchive.Password)\n else\n DestStrm := OutStream;\n try\n if InStream.Size > 0 then begin\n\n { determine how to store Item based on specified CompressionMethodToUse }\n case ZipArchive.CompressionMethodToUse of\n smDeflated : begin\n { Item is to be deflated regarless }\n { deflate item }\n DoDeflate(ZipArchive, Item, DestStrm, InStream);\n end;\n\n smStored : begin\n { Item is to be stored regardless }\n { store item }\n DoStore(ZipArchive, Item, DestStrm, InStream);\n end;\n\n smBestMethod : begin\n { Item is to be archived using method producing best compression }\n TempOut := TAbVirtualMemoryStream.Create;\n try\n TempOut.SwapFileDirectory := Sender.TempDirectory;\n\n { save starting points }\n InStartPos := InStream.Position;\n\n { try deflating item }\n DoDeflate(ZipArchive, Item, TempOut, InStream);\n { if deflated size > input size then got negative compression }\n { so storing the item is more efficient }\n\n if TempOut.Size > InStream.Size then begin { store item instead }\n { reset streams to original positions }\n InStream.Position := InStartPos;\n TempOut.Free;\n TempOut := TAbVirtualMemoryStream.Create;\n TempOut.SwapFileDirectory := Sender.TempDirectory;\n\n { store item }\n DoStore(ZipArchive, Item, TempOut, InStream);\n end {if};\n\n TempOut.Seek(0, soBeginning);\n DestStrm.CopyFrom(TempOut, TempOut.Size);\n finally\n TempOut.Free;\n end;\n end;\n end; { case }\n\n end\n else begin\n { InStream is zero length}\n Item.CRC32 := 0;\n { ignore any storage indicator and treat as stored }\n DoStore(ZipArchive, Item, DestStrm, InStream);\n end;\n finally\n if DestStrm <> OutStream then\n DestStrm.Free;\n end;\n\n { update item }\n Item.CompressedSize := OutStream.Size;\n Item.InternalFileAttributes := 0; { don't care }\n if (ZipArchive.Password <> '') then\n Item.GeneralPurposeBitFlag := Item.GeneralPurposeBitFlag\n or AbFileIsEncryptedFlag or AbHasDataDescriptorFlag;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbZipFromStream(Sender : TAbZipArchive; Item : TAbZipItem;\n OutStream, InStream : TStream);\nvar\n FileTimeStamp : LongInt;\nbegin\n // Set item properties for non-file streams\n Item.ExternalFileAttributes := 0;\n FileTimeStamp := DateTimeToFileDate(SysUtils.Now);\n Item.LastModFileTime := LongRec(FileTimeStamp).Lo;\n Item.LastModFileDate := LongRec(FileTimeStamp).Hi;\n\n DoZipFromStream(Sender, Item, OutStream, InStream);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure AbZip( Sender : TAbZipArchive; Item : TAbZipItem;\n OutStream : TStream );\nvar\n UncompressedStream : TStream;\n SaveDir : string;\n AttrEx : TAbAttrExRec;\nbegin\n UncompressedStream := nil;\n GetDir(0, SaveDir);\n try {SaveDir}\n if (Sender.BaseDirectory <> '') then\n ChDir(Sender.BaseDirectory);\n if not AbFileGetAttrEx(Item.DiskFileName, AttrEx) then\n raise EAbFileNotFound.Create;\n if ((AttrEx.Attr and faDirectory) <> 0) then\n UncompressedStream := TMemoryStream.Create\n else\n UncompressedStream :=\n TFileStream.Create(Item.DiskFileName, fmOpenRead or fmShareDenyWrite);\n finally {SaveDir}\n ChDir( SaveDir );\n end; {SaveDir}\n try {UncompressedStream}\n {$IFDEF UNIX}\n Item.ExternalFileAttributes := LongWord(AttrEx.Mode) shl 16 + LongWord(AttrEx.Attr);\n {$ELSE}\n Item.ExternalFileAttributes := AttrEx.Attr;\n {$ENDIF}\n Item.LastModTimeAsDateTime := AttrEx.Time;\n DoZipFromStream(Sender, Item, OutStream, UncompressedStream);\n finally {UncompressedStream}\n UncompressedStream.Free;\n end; {UncompressedStream}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure DeflateStream( UncompressedStream, CompressedStream : TStream );\n {-Deflates everything in CompressedStream to UncompressedStream\n no encryption is tried, no check on CRC is done, uses the whole\n Uncompressedstream - no Progress events - no Frills!\n }\nbegin\n Deflate(UncompressedStream, CompressedStream, nil);\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/AbZipTyp.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n * Craig Peterson \n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZipTyp.pas *}\n{*********************************************************}\n{* ABBREVIA: PKZip types *}\n{* Based on information from Appnote.txt, shipped with *}\n{* PKWare's PKZip for Windows 2.5 *}\n{*********************************************************}\n\nunit AbZipTyp;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes, AbArcTyp, AbUtils, AbSpanSt;\n\nconst\n { note #$50 = 'P', #$4B = 'K'}\n Ab_ZipVersion = 63;\n Ab_ZipLocalFileHeaderSignature : Longint = $04034B50;\n Ab_ZipDataDescriptorSignature : Longint = $08074B50;\n Ab_ZipCentralDirectoryFileHeaderSignature : Longint = $02014B50;\n Ab_Zip64EndCentralDirectorySignature : Longint = $06064B50;\n Ab_Zip64EndCentralDirectoryLocatorSignature:Longint = $07064B50;\n Ab_ZipEndCentralDirectorySignature : Longint = $06054B50;\n Ab_ZipSpannedSetSignature : Longint = $08074B50;\n Ab_ZipPossiblySpannedSignature : Longint = $30304B50;\n Ab_GeneralZipSignature : Word = $4B50;\n\n Ab_ArchiveExtraDataRecord : Longint = $08064B50;\n Ab_DigitalSignature : Longint = $05054B50;\n\n Ab_WindowsExeSignature : Word = $5A4D;\n Ab_LinuxExeSignature : Longint = $464C457F;\n\n AbDefZipSpanningThreshold = 0;\n AbDefPasswordRetries = 3;\n AbFileIsEncryptedFlag = $0001;\n AbHasDataDescriptorFlag = $0008;\n AbLanguageEncodingFlag = $0800;\n\n Ab_Zip64SubfieldID : Word = $0001;\n Ab_InfoZipUnicodePathSubfieldID : Word = $7075;\n Ab_XceedUnicodePathSubfieldID : Word = $554E;\n Ab_XceedUnicodePathSignature : LongWord= $5843554E;\n\ntype\n PAbByteArray4K = ^TAbByteArray4K;\n TAbByteArray4K = array[1..4096] of Byte;\n PAbByteArray8K = ^TAbByteArray8K;\n TAbByteArray8K = array[0..8192] of Byte;\n PAbIntArray8K = ^TAbIntArray8K;\n TAbIntArray8K = array[0..8192] of SmallInt;\n\n PAbWordArray = ^TAbWordArray;\n TAbWordArray = array[0..65535 div SizeOf(Word)-1] of Word;\n PAbByteArray = ^TAbByteArray;\n TAbByteArray = array[0..65535-1] of Byte;\n PAbSmallIntArray = ^TAbSmallIntArray;\n TAbSmallIntArray = array[0..65535 div SizeOf(SmallInt)-1] of SmallInt;\n\n PAbIntegerArray = ^TAbIntegerArray;\n TAbIntegerArray = array[0..65535 div sizeof(integer)-1] of integer;\n\n TAbZip64EndOfCentralDirectoryRecord = packed record\n Signature : Longint;\n RecordSize : Int64;\n VersionMadeBy : Word;\n VersionNeededToExtract : Word;\n DiskNumber : LongWord;\n StartDiskNumber : LongWord;\n EntriesOnDisk : Int64;\n TotalEntries : Int64;\n DirectorySize : Int64;\n DirectoryOffset : Int64;\n end;\n\n TAbZip64EndOfCentralDirectoryLocator = packed record\n Signature : Longint;\n StartDiskNumber : Longint;\n RelativeOffset : Int64;\n TotalDisks : Longint;\n end;\n\n TAbZipEndOfCentralDirectoryRecord = packed record\n Signature : Longint;\n DiskNumber : Word;\n StartDiskNumber : Word;\n EntriesOnDisk : Word;\n TotalEntries : Word;\n DirectorySize : LongWord;\n DirectoryOffset : LongWord;\n CommentLength : Word;\n end;\n\n TAbFollower = {used to expand reduced files}\n packed record\n Size : Byte; {size of follower set}\n FSet : array[0..31] of Byte; {follower set}\n end;\n PAbFollowerSets = ^TAbFollowerSets;\n TAbFollowerSets = array[0..255] of TAbFollower;\n\n\n PAbSfEntry = ^TAbSfEntry;\n TAbSfEntry = {entry in a Shannon-Fano tree}\n packed record\n case Byte of\n 0 : (Code : Word; Value, BitLength : Byte);\n 1 : (L : Longint);\n end;\n PAbSfTree = ^TAbSfTree;\n TAbSfTree =\n packed record {a Shannon-Fano tree}\n Entries : SmallInt;\n MaxLength : SmallInt;\n Entry : array[0..256] of TAbSfEntry;\n end;\n\n PInfoZipUnicodePathRec = ^TInfoZipUnicodePathRec;\n TInfoZipUnicodePathRec = packed record\n Version: Byte;\n NameCRC32: LongInt;\n UnicodeName: array[0..0] of AnsiChar;\n end;\n\n PXceedUnicodePathRec = ^TXceedUnicodePathRec;\n TXceedUnicodePathRec = packed record\n Signature: LongWord;\n Length: Integer;\n UnicodeName: array[0..0] of WideChar;\n end;\n\n PZip64LocalHeaderRec = ^TZip64LocalHeaderRec;\n TZip64LocalHeaderRec = packed record\n UncompressedSize: Int64;\n CompressedSize: Int64;\n end;\n\ntype\n TAbZipCompressionMethod =\n (cmStored, cmShrunk, cmReduced1, cmReduced2, cmReduced3,\n cmReduced4, cmImploded, cmTokenized, cmDeflated,\n cmEnhancedDeflated, cmDCLImploded, cmBzip2 = 12, cmLZMA = 14,\n cmIBMTerse = 18, cmLZ77, cmJPEG = 96, cmWavPack = 97, cmPPMd);\n\n TAbZipSupportedMethod =\n (smStored, smDeflated, smBestMethod);\n\n {ExternalFileAttributes compatibility; aliases are Info-ZIP/PKZIP overlaps}\n TAbZipHostOS =\n (hosDOS, hosAmiga, hosVAX, hosUnix, hosVMCMS, hosAtari,\n hosOS2, hosMacintosh, hosZSystem, hosCPM, hosNTFS, hosTOPS20 = hosNTFS,\n hosMVS, hosWinNT = hosMVS, hosVSE, hosQDOS = hosVSE, hosRISC,\n hosVFAT, hosAltMVS, hosBeOS, hosTandem, hosOS400, hosTHEOS = hosOS400,\n hosDarwin, hosAtheOS = 30);\n\n {for method 6 - imploding}\n TAbZipDictionarySize =\n (dsInvalid, ds4K, ds8K);\n\n {for method 8 - deflating}\n TAbZipDeflationOption =\n (doInvalid, doNormal, doMaximum, doFast, doSuperFast );\n\ntype\n TAbNeedPasswordEvent = procedure(Sender : TObject;\n var NewPassword : AnsiString) of object;\n\nconst\n AbDefCompressionMethodToUse = smBestMethod;\n AbDefDeflationOption = doNormal;\n\n\ntype\n TAbZipDataDescriptor = class( TObject )\n protected {private}\n FCRC32 : Longint;\n FCompressedSize : Int64;\n FUncompressedSize : Int64;\n public {methods}\n procedure SaveToStream( Stream : TStream );\n public {properties}\n property CRC32 : Longint\n read FCRC32 write FCRC32;\n property CompressedSize : Int64\n read FCompressedSize write FCompressedSize;\n property UncompressedSize : Int64\n read FUncompressedSize write FUncompressedSize;\n end;\n\ntype\n{ TAbZipFileHeader interface =============================================== }\n {ancestor class for ZipLocalFileHeader and DirectoryFileHeader}\n TAbZipFileHeader = class( TObject )\n protected {private}\n FValidSignature : Longint;\n FSignature : Longint;\n FVersionNeededToExtract : Word;\n FGeneralPurposeBitFlag : Word;\n FCompressionMethod : Word;\n FLastModFileTime : Word;\n FLastModFileDate : Word;\n FCRC32 : Longint;\n FCompressedSize : LongWord;\n FUncompressedSize : LongWord;\n FFileName : AnsiString;\n FExtraField : TAbExtraField;\n protected {methods}\n function GetCompressionMethod : TAbZipCompressionMethod;\n function GetCompressionRatio : Double;\n function GetDataDescriptor : Boolean;\n function GetDeflationOption : TAbZipDeflationOption;\n function GetDictionarySize : TAbZipDictionarySize;\n function GetEncrypted : Boolean;\n function GetIsUTF8 : Boolean;\n function GetShannonFanoTreeCount : Byte;\n function GetValid : Boolean;\n procedure SetCompressionMethod( Value : TAbZipCompressionMethod );\n procedure SetIsUTF8( Value : Boolean );\n public {methods}\n constructor Create;\n destructor Destroy; override;\n public {properties}\n property Signature : Longint\n read FSignature write FSignature;\n property VersionNeededToExtract : Word\n read FVersionNeededToExtract write FVersionNeededToExtract;\n property GeneralPurposeBitFlag : Word\n read FGeneralPurposeBitFlag write FGeneralPurposeBitFlag;\n property CompressionMethod : TAbZipCompressionMethod\n read GetCompressionMethod write SetCompressionMethod;\n property LastModFileTime : Word\n read FLastModFileTime write FLastModFileTime;\n property LastModFileDate : Word\n read FLastModFileDate write FLastModFileDate;\n property CRC32 : Longint\n read FCRC32 write FCRC32;\n property CompressedSize : LongWord\n read FCompressedSize write FCompressedSize;\n property UncompressedSize : LongWord\n read FUncompressedSize write FUncompressedSize;\n property FileName : AnsiString\n read FFileName write FFileName;\n property ExtraField : TAbExtraField\n read FExtraField;\n\n property CompressionRatio : Double\n read GetCompressionRatio;\n property DeflationOption : TAbZipDeflationOption\n read GetDeflationOption;\n property DictionarySize : TAbZipDictionarySize\n read GetDictionarySize;\n property HasDataDescriptor : Boolean\n read GetDataDescriptor;\n property IsValid : Boolean\n read GetValid;\n property IsEncrypted : Boolean\n read GetEncrypted;\n property IsUTF8 : Boolean\n read GetIsUTF8 write SetIsUTF8;\n property ShannonFanoTreeCount : Byte\n read GetShannonFanoTreeCount;\n end;\n\n{ TAbZipLocalFileHeader interface ========================================== }\n TAbZipLocalFileHeader = class( TAbZipFileHeader )\n public {methods}\n constructor Create;\n destructor Destroy; override;\n procedure LoadFromStream( Stream : TStream );\n procedure SaveToStream( Stream : TStream );\n end;\n\n{ TAbZipDirectoryFileHeader interface ====================================== }\n TAbZipDirectoryFileHeader = class( TAbZipFileHeader )\n protected {private}\n FVersionMadeBy : Word;\n FDiskNumberStart : Word;\n FInternalFileAttributes : Word;\n FExternalFileAttributes : LongWord;\n FRelativeOffset : LongWord;\n FFileComment : AnsiString;\n public {methods}\n constructor Create;\n destructor Destroy; override;\n procedure LoadFromStream( Stream : TStream );\n procedure SaveToStream( Stream : TStream );\n public {properties}\n property VersionMadeBy : Word\n read FVersionMadeBy write FVersionMadeBy;\n property DiskNumberStart : Word\n read FDiskNumberStart write FDiskNumberStart;\n property InternalFileAttributes : Word\n read FInternalFileAttributes write FInternalFileAttributes;\n property ExternalFileAttributes : LongWord\n read FExternalFileAttributes write FExternalFileAttributes;\n property RelativeOffset : LongWord\n read FRelativeOffset write FRelativeOffset;\n property FileComment : AnsiString\n read FFileComment write FFileComment;\n end;\n\n{ TAbZipDirectoryFileFooter interface ====================================== }\n TAbZipDirectoryFileFooter = class( TObject )\n protected {private}\n FDiskNumber : LongWord;\n FStartDiskNumber : LongWord;\n FEntriesOnDisk : Int64;\n FTotalEntries : Int64;\n FDirectorySize : Int64;\n FDirectoryOffset : Int64;\n FZipfileComment : AnsiString;\n function GetIsZip64: Boolean;\n public {methods}\n procedure LoadFromStream( Stream : TStream );\n procedure LoadZip64FromStream( Stream : TStream );\n procedure SaveToStream( Stream : TStream; aZip64TailOffset : Int64 = -1 );\n public {properties}\n property DiskNumber : LongWord\n read FDiskNumber write FDiskNumber;\n property EntriesOnDisk : Int64\n read FEntriesOnDisk write FEntriesOnDisk;\n property TotalEntries : Int64\n read FTotalEntries write FTotalEntries;\n property DirectorySize : Int64\n read FDirectorySize write FDirectorySize;\n property DirectoryOffset : Int64\n read FDirectoryOffset write FDirectoryOffset;\n property StartDiskNumber : LongWord\n read FStartDiskNumber write FStartDiskNumber;\n property ZipfileComment : AnsiString\n read FZipfileComment write FZipfileComment;\n property IsZip64: Boolean\n read GetIsZip64;\n end;\n\n{ TAbZipItem interface ===================================================== }\n TAbZipItem = class( TAbArchiveItem )\n protected {private}\n FItemInfo : TAbZipDirectoryFileHeader;\n FDiskNumberStart : LongWord;\n FLFHExtraField : TAbExtraField;\n FRelativeOffset : Int64;\n\n protected {methods}\n function GetCompressionMethod : TAbZipCompressionMethod;\n function GetCompressionRatio : Double;\n function GetDeflationOption : TAbZipDeflationOption;\n function GetDictionarySize : TAbZipDictionarySize;\n function GetExtraField : TAbExtraField;\n function GetFileComment : AnsiString;\n function GetGeneralPurposeBitFlag : Word;\n function GetHostOS: TAbZipHostOS;\n function GetInternalFileAttributes : Word;\n function GetRawFileName : AnsiString;\n function GetShannonFanoTreeCount : Byte;\n function GetVersionMadeBy : Word;\n function GetVersionNeededToExtract : Word;\n procedure SaveCDHToStream( Stream : TStream );\n procedure SaveDDToStream( Stream : TStream );\n procedure SaveLFHToStream( Stream : TStream );\n procedure SetCompressionMethod( Value : TAbZipCompressionMethod );\n procedure SetDiskNumberStart( Value : LongWord );\n procedure SetFileComment(const Value : AnsiString );\n procedure SetGeneralPurposeBitFlag( Value : Word );\n procedure SetHostOS( Value : TAbZipHostOS );\n procedure SetInternalFileAttributes( Value : Word );\n procedure SetRelativeOffset( Value : Int64 );\n procedure SetVersionMadeBy( Value : Word );\n procedure SetVersionNeededToExtract( Value : Word );\n procedure UpdateVersionNeededToExtract;\n procedure UpdateZip64ExtraHeader;\n\n protected {redefined property methods}\n function GetCRC32 : Longint; override;\n function GetExternalFileAttributes : LongWord; override;\n function GetIsDirectory: Boolean; override;\n function GetIsEncrypted : Boolean; override;\n function GetLastModFileDate : Word; override;\n function GetLastModFileTime : Word; override;\n function GetNativeFileAttributes : LongInt; override;\n procedure SetCompressedSize( const Value : Int64 ); override;\n procedure SetCRC32( const Value : Longint ); override;\n procedure SetExternalFileAttributes( Value : LongWord ); override;\n procedure SetFileName(const Value : string ); override;\n procedure SetLastModFileDate(const Value : Word ); override;\n procedure SetLastModFileTime(const Value : Word ); override;\n procedure SetUncompressedSize( const Value : Int64 ); override;\n\n public {methods}\n constructor Create;\n destructor Destroy; override;\n procedure LoadFromStream( Stream : TStream );\n\n public {properties}\n property CompressionMethod : TAbZipCompressionMethod\n read GetCompressionMethod\n write SetCompressionMethod;\n property CompressionRatio : Double\n read GetCompressionRatio;\n property DeflationOption : TAbZipDeflationOption\n read GetDeflationOption;\n property DictionarySize : TAbZipDictionarySize\n read GetDictionarySize;\n property DiskNumberStart : LongWord\n read FDiskNumberStart\n write SetDiskNumberStart;\n property ExtraField : TAbExtraField\n read GetExtraField;\n property FileComment : AnsiString\n read GetFileComment\n write SetFileComment;\n property HostOS: TAbZipHostOS\n read GetHostOS\n write SetHostOS;\n property InternalFileAttributes : Word\n read GetInternalFileAttributes\n write SetInternalFileAttributes;\n property GeneralPurposeBitFlag : Word\n read GetGeneralPurposeBitFlag\n write SetGeneralPurposeBitFlag;\n property LFHExtraField : TAbExtraField\n read FLFHExtraField;\n property RawFileName : AnsiString\n read GetRawFileName;\n property RelativeOffset : Int64\n read FRelativeOffset\n write SetRelativeOffset;\n property ShannonFanoTreeCount : Byte\n read GetShannonFanoTreeCount;\n property VersionMadeBy : Word\n read GetVersionMadeBy\n write SetVersionMadeBy;\n property VersionNeededToExtract : Word\n read GetVersionNeededToExtract\n write SetVersionNeededToExtract;\n end;\n\n{ TAbZipArchive interface ================================================== }\n TAbZipArchive = class( TAbArchive )\n protected {private}\n FCompressionMethodToUse : TAbZipSupportedMethod;\n FDeflationOption : TAbZipDeflationOption;\n FInfo : TAbZipDirectoryFileFooter;\n FIsExecutable : Boolean;\n FPassword : AnsiString;\n FPasswordRetries : Byte;\n FStubSize : LongWord;\n\n FExtractHelper : TAbArchiveItemExtractEvent;\n FExtractToStreamHelper : TAbArchiveItemExtractToStreamEvent;\n FTestHelper : TAbArchiveItemTestEvent;\n FInsertHelper : TAbArchiveItemInsertEvent;\n FInsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent;\n FOnNeedPassword : TAbNeedPasswordEvent;\n FOnRequestLastDisk : TAbRequestDiskEvent;\n FOnRequestNthDisk : TAbRequestNthDiskEvent;\n FOnRequestBlankDisk : TAbRequestDiskEvent;\n\n protected {methods}\n procedure DoExtractHelper(Index : Integer; const NewName : string);\n procedure DoExtractToStreamHelper(Index : Integer; aStream : TStream);\n procedure DoTestHelper(Index : Integer);\n procedure DoInsertHelper(Index : Integer; OutStream : TStream);\n procedure DoInsertFromStreamHelper(Index : Integer; OutStream : TStream);\n function GetItem( Index : Integer ) : TAbZipItem;\n function GetZipfileComment : AnsiString;\n procedure PutItem( Index : Integer; Value : TAbZipItem );\n procedure DoRequestDisk(const AMessage: string; var Abort : Boolean);\n procedure DoRequestLastDisk( var Abort : Boolean );\n virtual;\n procedure DoRequestNthDisk(Sender: TObject; DiskNumber : Byte; var Abort : Boolean );\n virtual;\n procedure DoRequestBlankDisk(Sender: TObject; var Abort : Boolean );\n virtual;\n procedure ExtractItemAt(Index : Integer; const UseName : string);\n override;\n procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);\n override;\n procedure TestItemAt(Index : Integer);\n override;\n function FixName(const Value : string ) : string;\n override;\n function GetSupportsEmptyFolders: Boolean;\n override;\n procedure LoadArchive;\n override;\n procedure SaveArchive;\n override;\n procedure SetZipfileComment(const Value : AnsiString );\n\n protected {properties}\n property IsExecutable : Boolean\n read FIsExecutable write FIsExecutable;\n\n public {protected}\n procedure DoRequestImage(Sender: TObject; ImageNumber: Integer;\n var ImageName: string; var Abort: Boolean);\n\n public {methods}\n constructor CreateFromStream( aStream : TStream; const ArchiveName : string );\n override;\n destructor Destroy;\n override;\n function CreateItem(const FileName : string): TAbArchiveItem;\n override;\n\n public {properties}\n property CompressionMethodToUse : TAbZipSupportedMethod\n read FCompressionMethodToUse\n write FCompressionMethodToUse;\n property DeflationOption : TAbZipDeflationOption\n read FDeflationOption\n write FDeflationOption;\n property ExtractHelper : TAbArchiveItemExtractEvent\n read FExtractHelper\n write FExtractHelper;\n property ExtractToStreamHelper : TAbArchiveItemExtractToStreamEvent\n read FExtractToStreamHelper\n write FExtractToStreamHelper;\n property TestHelper : TAbArchiveItemTestEvent\n read FTestHelper\n write FTestHelper;\n property InsertHelper : TAbArchiveItemInsertEvent\n read FInsertHelper\n write FInsertHelper;\n property InsertFromStreamHelper : TAbArchiveItemInsertFromStreamEvent\n read FInsertFromStreamHelper\n write FInsertFromStreamHelper;\n property Password : AnsiString\n read FPassword\n write FPassword;\n property PasswordRetries : Byte\n read FPasswordRetries\n write FPasswordRetries\n default AbDefPasswordRetries;\n property StubSize : LongWord\n read FStubSize;\n property ZipfileComment : AnsiString\n read GetZipfileComment\n write SetZipfileComment;\n\n property Items[Index : Integer] : TAbZipItem\n read GetItem\n write PutItem; default;\n\n public {events}\n property OnNeedPassword : TAbNeedPasswordEvent\n read FOnNeedPassword write FOnNeedPassword;\n property OnRequestLastDisk : TAbRequestDiskEvent\n read FOnRequestLastDisk write FOnRequestLastDisk;\n property OnRequestNthDisk : TAbRequestNthDiskEvent\n read FOnRequestNthDisk write FOnRequestNthDisk;\n property OnRequestBlankDisk : TAbRequestDiskEvent\n read FOnRequestBlankDisk write FOnRequestBlankDisk;\n end;\n\n{============================================================================}\nprocedure MakeSelfExtracting( StubStream, ZipStream,\n SelfExtractingStream : TStream );\n {-takes an executable stub, and a .zip format stream, and creates\n a SelfExtracting stream. The stub should create a TAbZipArchive\n passing itself as the file, using a read-only open mode. It should\n then perform operations as needed - like ExtractFiles( '*.*' ).\n This routine updates the RelativeOffset of each item in the archive}\n\nfunction FindCentralDirectoryTail(aStream : TStream) : Int64;\n\nfunction VerifyZip(Strm : TStream) : TAbArchiveType;\n\nfunction VerifySelfExtracting(Strm : TStream) : TAbArchiveType;\n\nfunction ZipCompressionMethodToString(aMethod: TAbZipCompressionMethod): string;\n\nimplementation\n\nuses\n {$IFDEF MSWINDOWS}\n Windows,\n {$ENDIF}\n {$IFDEF LibcAPI}\n Libc,\n {$ENDIF}\n {$IFDEF UnixDialogs}\n {$IFDEF KYLIX}\n QControls,\n QDialogs,\n {$ENDIF}\n {$IFDEF LCL}\n Controls,\n Dialogs,\n {$ENDIF}\n {$ENDIF}\n Math,\n AbCharset,\n AbResString,\n AbExcept,\n AbVMStrm,\n SysUtils;\n\nfunction VerifyZip(Strm : TStream) : TAbArchiveType;\n{ determine if stream appears to be in PkZip format }\nvar\n Footer : TAbZipEndOfCentralDirectoryRecord;\n Sig : LongInt;\n TailPosition : int64;\n StartPos : int64;\nbegin\n StartPos := Strm.Position;\n Result := atUnknown;\n try\n Strm.Position := 0;\n Strm.Read(Sig, SizeOf(Sig));\n if (Sig = Ab_ZipSpannedSetSignature) then\n Result := atSpannedZip\n else begin\n { attempt to find Central Directory Tail }\n TailPosition := FindCentralDirectoryTail( Strm );\n if TailPosition <> -1 then begin\n { check Central Directory Signature }\n Strm.ReadBuffer(Footer, SizeOf(Footer));\n if Footer.Signature = Ab_ZipEndCentralDirectorySignature then\n if Footer.DiskNumber = 0 then\n Result := atZip\n else\n Result := atSpannedZip;\n end;\n end;\n except\n on EReadError do\n Result := atUnknown;\n end;\n Strm.Position := StartPos;\nend;\n\nfunction VerifySelfExtracting(Strm : TStream) : TAbArchiveType;\n{ determine if stream appears to be an executable with appended PkZip data }\nvar\n FileSignature : Longint;\n StartPos : Int64;\n IsWinExe, IsLinuxExe : Boolean;\nbegin\n StartPos := Strm.Position;\n { verify presence of executable stub }\n {check file type of stub stream}\n Strm.Position := 0;\n Strm.Read( FileSignature, sizeof( FileSignature ) );\n\n Result := atSelfExtZip;\n\n { detect executable type }\n IsLinuxExe := FileSignature = Ab_LinuxExeSignature;\n IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature;\n if not (IsWinExe or IsLinuxExe) then\n Result := atUnknown;\n\n { Check for central directory tail }\n if VerifyZip(Strm) <> atZip then\n Result := atUnknown;\n\n Strm.Position := StartPos;\nend;\n{============================================================================}\nfunction ZipCompressionMethodToString(aMethod: TAbZipCompressionMethod): string;\nbegin\n case aMethod of\n cmStored:\n Result := AbZipStored;\n cmShrunk:\n Result := AbZipShrunk;\n cmReduced1..cmReduced4:\n Result := AbZipReduced;\n cmImploded:\n Result := AbZipImploded;\n cmTokenized:\n Result := AbZipTokenized;\n cmDeflated:\n Result := AbZipDeflated;\n cmEnhancedDeflated:\n Result := AbZipDeflate64;\n cmDCLImploded:\n Result := AbZipDCLImploded;\n cmBzip2:\n Result := AbZipBzip2;\n cmLZMA:\n Result := AbZipLZMA;\n cmIBMTerse:\n Result := AbZipIBMTerse;\n cmLZ77:\n Result := AbZipLZ77;\n cmJPEG:\n Result := AbZipJPEG;\n cmWavPack:\n Result := AbZipWavPack;\n cmPPMd:\n Result := AbZipPPMd;\n else\n Result := Format(AbZipUnknown, [Ord(aMethod)]);\n end;\nend;\n{============================================================================}\nfunction FindCentralDirectoryTail(aStream : TStream) : Int64;\n{ search end of aStream looking for ZIP Central Directory structure\n returns position in stream if found (otherwise returns -1),\n leaves stream positioned at start of structure or at original\n position if not found }\nconst\n StartBufSize = 512;\n MaxBufSize = 64 * 1024;\nvar\n StartPos : Int64;\n TailRec : TAbZipEndOfCentralDirectoryRecord;\n Buffer : PAnsiChar;\n Offset : Int64;\n TestPos : PAnsiChar;\n Done : boolean;\n BytesRead : Int64;\n BufSize : Int64;\n CommentLen: integer;\nbegin\n {save the starting position}\n StartPos := aStream.Seek(0, soCurrent);\n\n {start off with the majority case: no zip file comment, so the\n central directory tail is the last thing in the stream and it's a\n fixed size and doesn't indicate a zip file comment}\n Result := aStream.Seek(-sizeof(TailRec), soEnd);\n if (Result >= 0) then begin\n aStream.ReadBuffer(TailRec, sizeof(TailRec));\n if (TailRec.Signature = Ab_ZipEndCentralDirectorySignature) and\n (TailRec.CommentLength = 0) then begin\n aStream.Seek(Result, soBeginning);\n Exit;\n end;\n end;\n\n {the zip stream seems to have a comment, or it has null padding\n bytes from some flaky program, or it's not even a zip formatted\n stream; we need to search for the tail signature}\n\n {get a buffer}\n BufSize := StartBufSize;\n GetMem(Buffer, BufSize);\n try\n\n {start out searching backwards}\n Offset := -BufSize;\n\n {while there is still data to search ...}\n Done := false;\n while not Done do begin\n\n {seek to the search position}\n Result := aStream.Seek(Offset, soEnd);\n if (Result <= 0) then begin\n Result := aStream.Seek(0, soBeginning);\n Done := true;\n end;\n\n {read a buffer full}\n BytesRead := aStream.Read(Buffer^, BufSize);\n\n if BytesRead < sizeOf(TailRec) then begin\n Result := -1;\n Exit;\n end;\n\n {search backwards through the buffer looking for the signature}\n TestPos := Buffer + BytesRead - sizeof(TailRec);\n while (TestPos <> Buffer) and\n (PLongint(TestPos)^ <> Ab_ZipEndCentralDirectorySignature) do\n dec(TestPos);\n\n {if we found the signature...}\n if (PLongint(TestPos)^ = Ab_ZipEndCentralDirectorySignature) then begin\n\n {get the tail record at this position}\n Move(TestPos^, TailRec, sizeof(TailRec));\n\n {if it's as valid a tail as we can check here...}\n CommentLen := -Offset - (TestPos - Buffer + sizeof(TailRec));\n if (TailRec.CommentLength <= CommentLen) then begin\n\n {calculate its position and exit}\n Result := Result + (TestPos - Buffer);\n aStream.Seek(Result, soBeginning);\n Exit;\n end;\n end;\n\n {otherwise move back one step, doubling the buffer}\n if (BufSize < MaxBufSize) then begin\n FreeMem(Buffer);\n BufSize := BufSize * 2;\n if BufSize > MaxBufSize then\n BufSize := MaxBufSize;\n GetMem(Buffer, BufSize);\n end;\n dec(Offset, BufSize - SizeOf(TailRec));\n end;\n\n {if we reach this point, the CD tail is not present}\n Result := -1;\n aStream.Seek(StartPos, soBeginning);\n finally\n FreeMem(Buffer);\n end;\nend;\n{============================================================================}\nprocedure MakeSelfExtracting( StubStream, ZipStream,\n SelfExtractingStream : TStream );\n {-takes an executable stub, and a .zip format stream, and creates\n a SelfExtracting stream. The stub should create a TAbZipArchive\n passing itself as the file, using a read-only open mode. It should\n then perform operations as needed - like ExtractFiles( '*.*' ).\n This routine updates the RelativeOffset of each item in the archive}\nvar\n DirectoryStart : Int64;\n FileSignature : Longint;\n StubSize : LongWord;\n TailPosition : Int64;\n ZDFF : TAbZipDirectoryFileFooter;\n ZipItem : TAbZipItem;\n IsWinExe, IsLinuxExe : Boolean;\nbegin\n {check file type of stub stream}\n StubStream.Position := 0;\n StubStream.Read(FileSignature, SizeOf(FileSignature));\n\n {detect executable type }\n IsLinuxExe := FileSignature = Ab_LinuxExeSignature;\n IsWinExe := LongRec(FileSignature).Lo = Ab_WindowsExeSignature;\n\n if not (IsWinExe or IsLinuxExe) then\n raise EAbZipInvalidStub.Create;\n\n StubStream.Position := 0;\n StubSize := StubStream.Size;\n\n ZipStream.Position := 0;\n ZipStream.Read( FileSignature, sizeof( FileSignature ) );\n if LongRec(FileSignature).Lo <> Ab_GeneralZipSignature then\n raise EAbZipInvalid.Create;\n ZipStream.Position := 0;\n\n {copy the stub into the selfex stream}\n SelfExtractingStream.Position := 0;\n SelfExtractingStream.CopyFrom( StubStream, 0 );\n\n TailPosition := FindCentralDirectoryTail( ZipStream );\n if TailPosition = -1 then\n raise EAbZipInvalid.Create;\n {load the ZipDirectoryFileFooter}\n ZDFF := TAbZipDirectoryFileFooter.Create;\n try\n ZDFF.LoadFromStream( ZipStream );\n DirectoryStart := ZDFF.DirectoryOffset;\n finally\n ZDFF.Free;\n end;\n {copy everything up to the CDH into the SelfExtractingStream}\n ZipStream.Position := 0;\n SelfExtractingStream.CopyFrom( ZipStream, DirectoryStart );\n ZipStream.Position := DirectoryStart;\n repeat\n ZipItem := TAbZipItem.Create;\n try\n ZipItem.LoadFromStream( ZipStream );\n ZipItem.RelativeOffset := ZipItem.RelativeOffset + StubSize;\n {save the modified entry into the Self Extracting Stream}\n ZipItem.SaveCDHToStream( SelfExtractingStream );\n finally\n ZipItem.Free;\n end;\n until ZipStream.Position = TailPosition;\n\n {save the CDH Footer.}\n ZDFF := TAbZipDirectoryFileFooter.Create;\n try\n ZDFF.LoadFromStream( ZipStream );\n ZDFF.DirectoryOffset := ZDFF.DirectoryOffset + StubSize;\n ZDFF.SaveToStream( SelfExtractingStream );\n finally\n ZDFF.Free;\n end;\nend; \n{============================================================================}\n{ TAbZipDataDescriptor implementation ====================================== }\nprocedure TAbZipDataDescriptor.SaveToStream( Stream : TStream );\nbegin\n Stream.Write( Ab_ZipDataDescriptorSignature, sizeof( Ab_ZipDataDescriptorSignature ) );\n Stream.Write( FCRC32, sizeof( FCRC32 ) );\n if (FCompressedSize >= $FFFFFFFF) or (FUncompressedSize >= $FFFFFFFF) then begin\n Stream.Write( FCompressedSize, sizeof( FCompressedSize ) );\n Stream.Write( FUncompressedSize, sizeof( FUncompressedSize ) );\n end\n else begin\n Stream.Write( FCompressedSize, sizeof( LongWord ) );\n Stream.Write( FUncompressedSize, sizeof( LongWord ) );\n end;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbZipFileHeader implementation ========================================== }\nconstructor TAbZipFileHeader.Create;\nbegin\n inherited Create;\n FExtraField := TAbExtraField.Create;\n FValidSignature := $0;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbZipFileHeader.Destroy;\nbegin\n FreeAndNil(FExtraField);\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetCompressionMethod : TAbZipCompressionMethod;\nbegin\n Result := TAbZipCompressionMethod( FCompressionMethod );\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetDataDescriptor : Boolean;\nbegin\n Result := ( CompressionMethod = cmDeflated ) and\n ( ( FGeneralPurposeBitFlag and AbHasDataDescriptorFlag ) <> 0 );\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetCompressionRatio : Double;\nvar\n CompSize : Int64;\nbegin\n {adjust for encrypted headers - ensures we never get negative compression\n ratios for stored, encrypted files - no guarantees about negative\n compression ratios in other cases}\n if isEncrypted then\n CompSize := CompressedSize - 12\n else\n CompSize := CompressedSize;\n if UncompressedSize > 0 then\n Result := 100.0 * ( 1 - ( ( 1.0 * CompSize ) / UncompressedSize ) )\n else\n Result := 0.0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetDeflationOption : TAbZipDeflationOption;\nbegin\n if CompressionMethod = cmDeflated then\n if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then\n if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then\n Result := doSuperFast\n else\n Result := doMaximum\n else\n if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then\n Result := doFast\n else\n Result := doNormal\n else\n Result := doInvalid;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetDictionarySize : TAbZipDictionarySize;\nbegin\n if CompressionMethod = cmImploded then\n if ( ( FGeneralPurposeBitFlag and $02 ) <> 0 ) then\n Result := ds8K\n else\n Result := ds4K\n else\n Result := dsInvalid;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetEncrypted : Boolean;\nbegin\n {bit 0 of the GeneralPurposeBitFlag}\n Result := ( ( FGeneralPurposeBitFlag and AbFileIsEncryptedFlag ) <> 0 );\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetIsUTF8 : Boolean;\nbegin\n Result := ( ( GeneralPurposeBitFlag and AbLanguageEncodingFlag ) <> 0 );\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetShannonFanoTreeCount : Byte;\nbegin\n if CompressionMethod = cmImploded then\n if ( ( FGeneralPurposeBitFlag and $04 ) <> 0 ) then\n Result := 3\n else\n Result := 2\n else\n Result := 0;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipFileHeader.GetValid : Boolean;\nbegin\n Result := ( FValidSignature = FSignature );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipFileHeader.SetCompressionMethod( Value :\n TAbZipCompressionMethod );\nbegin\n FCompressionMethod := Ord( Value );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipFileHeader.SetIsUTF8( Value : Boolean );\nbegin\n if Value then\n GeneralPurposeBitFlag := GeneralPurposeBitFlag or AbLanguageEncodingFlag\n else\n GeneralPurposeBitFlag := GeneralPurposeBitFlag and not AbLanguageEncodingFlag;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbZipLocalFileHeader implementation ===================================== }\nconstructor TAbZipLocalFileHeader.Create;\nbegin\n inherited Create;\n FValidSignature := Ab_ZipLocalFileHeaderSignature;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbZipLocalFileHeader.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipLocalFileHeader.LoadFromStream( Stream : TStream );\nvar\n ExtraFieldLength, FileNameLength : Word;\nbegin\n with Stream do begin\n Read( FSignature, sizeof( FSignature ) );\n Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );\n Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );\n Read( FCompressionMethod, sizeof( FCompressionMethod ) );\n Read( FLastModFileTime, sizeof( FLastModFileTime ) );\n Read( FLastModFileDate, sizeof( FLastModFileDate ) );\n Read( FCRC32, sizeof( FCRC32 ) );\n Read( FCompressedSize, sizeof( FCompressedSize ) );\n Read( FUncompressedSize, sizeof( FUncompressedSize ) );\n Read( FileNameLength, sizeof( FileNameLength ) );\n Read( ExtraFieldLength, sizeof( ExtraFieldLength ) );\n\n SetLength( FFileName, FileNameLength );\n if FileNameLength > 0 then\n Read( FFileName[1], FileNameLength );\n\n FExtraField.LoadFromStream( Stream, ExtraFieldLength );\n end;\n if not IsValid then\n raise EAbZipInvalid.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipLocalFileHeader.SaveToStream( Stream : TStream );\nvar\n ExtraFieldLength, FileNameLength: Word;\nbegin\n with Stream do begin\n {write the valid signature from the constant}\n Write( FValidSignature, sizeof( FValidSignature ) );\n Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );\n Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );\n Write( FCompressionMethod, sizeof( FCompressionMethod ) );\n Write( FLastModFileTime, sizeof( FLastModFileTime ) );\n Write( FLastModFileDate, sizeof( FLastModFileDate ) );\n Write( FCRC32, sizeof( FCRC32 ) );\n Write( FCompressedSize, sizeof( FCompressedSize ) );\n Write( FUncompressedSize, sizeof( FUncompressedSize ) );\n FileNameLength := Word( Length( FFileName ) );\n Write( FileNameLength, sizeof( FileNameLength ) );\n ExtraFieldLength := Length(FExtraField.Buffer);\n Write( ExtraFieldLength, sizeof( ExtraFieldLength ) );\n if FileNameLength > 0 then\n Write( FFileName[1], FileNameLength );\n if ExtraFieldLength > 0 then\n Write(FExtraField.Buffer[0], ExtraFieldLength);\n end;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbZipDirectoryFileHeader implementation ================================= }\nconstructor TAbZipDirectoryFileHeader.Create;\nbegin\n inherited Create;\n FValidSignature := Ab_ZipCentralDirectoryFileHeaderSignature;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbZipDirectoryFileHeader.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDirectoryFileHeader.LoadFromStream( Stream : TStream );\nvar\n ExtraFieldLength, FileCommentLength, FileNameLength : Word;\nbegin\n with Stream do begin\n Read( FSignature, sizeof( FSignature ) );\n Read( FVersionMadeBy, sizeof( FVersionMadeBy ) );\n Read( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );\n Read( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );\n Read( FCompressionMethod, sizeof( FCompressionMethod ) );\n Read( FLastModFileTime, sizeof( FLastModFileTime ) );\n Read( FLastModFileDate, sizeof( FLastModFileDate ) );\n Read( FCRC32, sizeof( FCRC32 ) );\n Read( FCompressedSize, sizeof( FCompressedSize ) );\n Read( FUncompressedSize, sizeof( FUncompressedSize ) );\n Read( FileNameLength, sizeof( FileNameLength ) );\n Read( ExtraFieldLength, sizeof( ExtraFieldLength ) );\n Read( FileCommentLength, sizeof( FileCommentLength ) );\n Read( FDiskNumberStart, sizeof( FDiskNumberStart ) );\n Read( FInternalFileAttributes, sizeof( FInternalFileAttributes ) );\n Read( FExternalFileAttributes, sizeof( FExternalFileAttributes ) );\n Read( FRelativeOffset, sizeof( FRelativeOffset ) );\n\n SetLength( FFileName, FileNameLength );\n if FileNameLength > 0 then\n Read( FFileName[1], FileNameLength );\n\n FExtraField.LoadFromStream( Stream, ExtraFieldLength );\n\n SetLength( FFileComment, FileCommentLength );\n if FileCommentLength > 0 then\n Read( FFileComment[1], FileCommentLength );\n end;\n if not IsValid then\n raise EAbZipInvalid.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDirectoryFileHeader.SaveToStream( Stream : TStream );\nvar\n ExtraFieldLength, FileCommentLength, FileNameLength : Word;\nbegin\n with Stream do begin\n {write the valid signature from the constant}\n Write( FValidSignature, sizeof( FValidSignature ) );\n Write( FVersionMadeBy, sizeof( FVersionMadeBy ) );\n Write( FVersionNeededToExtract, sizeof( FVersionNeededToExtract ) );\n Write( FGeneralPurposeBitFlag, sizeof( FGeneralPurposeBitFlag ) );\n Write( FCompressionMethod, sizeof( FCompressionMethod ) );\n Write( FLastModFileTime, sizeof( FLastModFileTime ) );\n Write( FLastModFileDate, sizeof( FLastModFileDate ) );\n Write( FCRC32, sizeof( FCRC32 ) );\n Write( FCompressedSize, sizeof( FCompressedSize ) );\n Write( FUncompressedSize, sizeof( FUncompressedSize ) );\n FileNameLength := Word( Length( FFileName ) );\n Write( FileNameLength, sizeof( FileNameLength ) );\n ExtraFieldLength := Length(FExtraField.Buffer);\n Write( ExtraFieldLength, sizeof( ExtraFieldLength ) );\n FileCommentLength := Word( Length( FFileComment ) );\n Write( FileCommentLength, sizeof( FileCommentLength ) );\n Write( FDiskNumberStart, sizeof( FDiskNumberStart ) );\n Write( FInternalFileAttributes, sizeof( FInternalFileAttributes ) );\n Write( FExternalFileAttributes, sizeof( FExternalFileAttributes ) );\n Write( FRelativeOffset, sizeof( FRelativeOffset ) );\n if FileNameLength > 0 then\n Write( FFileName[1], FileNameLength );\n if ExtraFieldLength > 0 then\n Write( FExtraField.Buffer[0], ExtraFieldLength );\n if FileCommentLength > 0 then\n Write( FFileComment[1], FileCommentLength );\n end;\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbZipDirectoryFileFooter implementation ================================= }\nfunction TAbZipDirectoryFileFooter.GetIsZip64: Boolean;\nbegin\n Result := (DiskNumber >= $FFFF) or\n (StartDiskNumber >= $FFFF) or\n (EntriesOnDisk >= $FFFF) or\n (TotalEntries >= $FFFF) or\n (DirectorySize >= $FFFFFFFF) or\n (DirectoryOffset >= $FFFFFFFF);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDirectoryFileFooter.LoadFromStream( Stream : TStream );\nvar\n Footer: TAbZipEndOfCentralDirectoryRecord;\nbegin\n Stream.ReadBuffer( Footer, SizeOf(Footer) );\n if Footer.Signature <> Ab_ZipEndCentralDirectorySignature then\n raise EAbZipInvalid.Create;\n FDiskNumber := Footer.DiskNumber;\n FStartDiskNumber := Footer.StartDiskNumber;\n FEntriesOnDisk := Footer.EntriesOnDisk;\n FTotalEntries := Footer.TotalEntries;\n FDirectorySize := Footer.DirectorySize;\n FDirectoryOffset := Footer.DirectoryOffset;\n SetLength( FZipfileComment, Footer.CommentLength );\n if Footer.CommentLength > 0 then\n Stream.ReadBuffer( FZipfileComment[1], Footer.CommentLength );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDirectoryFileFooter.LoadZip64FromStream( Stream : TStream );\n {load the ZIP64 end of central directory record.\n LoadFromStream() must be called first to load the standard record}\nvar\n Footer: TAbZip64EndOfCentralDirectoryRecord;\nbegin\n Stream.ReadBuffer( Footer, SizeOf(Footer) );\n if Footer.Signature <> Ab_Zip64EndCentralDirectorySignature then\n raise EAbZipInvalid.Create;\n if FDiskNumber = $FFFF then\n FDiskNumber := Footer.DiskNumber;\n if FStartDiskNumber = $FFFF then\n FStartDiskNumber := Footer.StartDiskNumber;\n if FEntriesOnDisk = $FFFF then\n FEntriesOnDisk := Footer.EntriesOnDisk;\n if FTotalEntries = $FFFF then\n FTotalEntries := Footer.TotalEntries;\n if FDirectorySize = $FFFFFFFF then\n FDirectorySize := Footer.DirectorySize;\n if FDirectoryOffset = $FFFFFFFF then\n FDirectoryOffset := Footer.DirectoryOffset;\n {RecordSize, VersionMadeBy, and VersionNeededToExtract are currently ignored}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipDirectoryFileFooter.SaveToStream( Stream : TStream;\n aZip64TailOffset: Int64 = -1);\n {write end of central directory record, along with Zip64 records if necessary.\n aZip64TailOffset is the value to use for the Zip64 locator's directory\n offset, and is only necessary when writing to an intermediate stream}\nvar\n Footer: TAbZipEndOfCentralDirectoryRecord;\n Zip64Footer: TAbZip64EndOfCentralDirectoryRecord;\n Zip64Locator: TAbZip64EndOfCentralDirectoryLocator;\nbegin\n if IsZip64 then begin\n {setup Zip64 end of central directory record}\n Zip64Footer.Signature := Ab_Zip64EndCentralDirectorySignature;\n Zip64Footer.RecordSize := SizeOf(Zip64Footer) -\n SizeOf(Zip64Footer.Signature) - SizeOf(Zip64Footer.RecordSize);\n Zip64Footer.VersionMadeBy := 45;\n Zip64Footer.VersionNeededToExtract := 45;\n Zip64Footer.DiskNumber := DiskNumber;\n Zip64Footer.StartDiskNumber := StartDiskNumber;\n Zip64Footer.EntriesOnDisk := EntriesOnDisk;\n Zip64Footer.TotalEntries := TotalEntries;\n Zip64Footer.DirectorySize := DirectorySize;\n Zip64Footer.DirectoryOffset := DirectoryOffset;\n {setup Zip64 end of central directory locator}\n Zip64Locator.Signature := Ab_Zip64EndCentralDirectoryLocatorSignature;\n Zip64Locator.StartDiskNumber := DiskNumber;\n if aZip64TailOffset = -1 then\n Zip64Locator.RelativeOffset := Stream.Position\n else\n Zip64Locator.RelativeOffset := aZip64TailOffset;\n Zip64Locator.TotalDisks := DiskNumber + 1;\n {write Zip64 records}\n Stream.WriteBuffer(Zip64Footer, SizeOf(Zip64Footer));\n Stream.WriteBuffer(Zip64Locator, SizeOf(Zip64Locator));\n end;\n Footer.Signature := Ab_ZipEndCentralDirectorySignature;\n Footer.DiskNumber := Min(FDiskNumber, $FFFF);\n Footer.StartDiskNumber := Min(FStartDiskNumber, $FFFF);\n Footer.EntriesOnDisk := Min(FEntriesOnDisk, $FFFF);\n Footer.TotalEntries := Min(FTotalEntries, $FFFF);\n Footer.DirectorySize := Min(FDirectorySize, $FFFFFFFF);\n Footer.DirectoryOffset := Min(FDirectoryOffset, $FFFFFFFF);\n Footer.CommentLength := Length( FZipfileComment );\n Stream.WriteBuffer( Footer, SizeOf(Footer) );\n if FZipfileComment <> '' then\n Stream.Write( FZipfileComment[1], Length(FZipfileComment) );\nend;\n{ -------------------------------------------------------------------------- }\n\n{ TAbZipItem implementation ================================================ }\nconstructor TAbZipItem.Create;\nbegin\n inherited Create;\n FItemInfo := TAbZipDirectoryFileHeader.Create;\n FLFHExtraField := TAbExtraField.Create;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbZipItem.Destroy;\nbegin\n FLFHExtraField.Free;\n FItemInfo.Free;\n FItemInfo := nil;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetCompressionMethod : TAbZipCompressionMethod;\nbegin\n Result := FItemInfo.CompressionMethod;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetCompressionRatio : Double;\nbegin\n Result := FItemInfo.CompressionRatio;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetCRC32 : Longint;\nbegin\n Result := FItemInfo.CRC32;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetDeflationOption : TAbZipDeflationOption;\nbegin\n Result := FItemInfo.DeflationOption;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetDictionarySize : TAbZipDictionarySize;\nbegin\n Result := FItemInfo.DictionarySize;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetGeneralPurposeBitFlag : Word;\nbegin\n Result := FItemInfo.GeneralPurposeBitFlag;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetHostOS: TAbZipHostOS;\nbegin\n Result := TAbZipHostOS(Hi(VersionMadeBy));\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetExternalFileAttributes : LongWord;\nbegin\n Result := FItemInfo.ExternalFileAttributes;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetExtraField : TAbExtraField;\nbegin\n Result := FItemInfo.ExtraField;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetFileComment : AnsiString;\nbegin\n Result := FItemInfo.FileComment;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetInternalFileAttributes : Word;\nbegin\n Result := FItemInfo.InternalFileAttributes;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetIsDirectory: Boolean;\nbegin\n Result := ((ExternalFileAttributes and faDirectory) <> 0) or\n ((FileName <> '') and CharInSet(Filename[Length(FFilename)], ['\\','/']));\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetIsEncrypted : Boolean;\nbegin\n Result := FItemInfo.IsEncrypted;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetLastModFileDate : Word;\nbegin\n Result := FItemInfo.LastModFileDate;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetLastModFileTime : Word;\nbegin\n Result := FItemInfo.LastModFileTime;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetNativeFileAttributes : LongInt;\nbegin\n{$IFDEF MSWINDOWS}\n if (HostOS = hosUnix) or (ExternalFileAttributes > $1FFFF) then\n Result := AbUnix2DosFileAttributes(ExternalFileAttributes shr 16)\n else\n Result := Byte(ExternalFileAttributes);\n{$ENDIF}\n{$IFDEF UNIX}\n if HostOS in [hosDOS, hosNTFS, hosWinNT] then\n Result := AbDOS2UnixFileAttributes(ExternalFileAttributes)\n else\n Result := ExternalFileAttributes shr 16;\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetRawFileName : AnsiString;\nbegin\n Result := FItemInfo.FileName;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetShannonFanoTreeCount : Byte;\nbegin\n Result := FItemInfo.ShannonFanoTreeCount;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetVersionMadeBy : Word;\nbegin\n Result := FItemInfo.VersionMadeBy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipItem.GetVersionNeededToExtract : Word;\nbegin\n Result := FItemInfo.VersionNeededToExtract;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.LoadFromStream( Stream : TStream );\nvar\n FieldSize: Word;\n FieldStream: TStream;\n InfoZipField: PInfoZipUnicodePathRec;\n UnicodeName: UnicodeString;\n UTF8Name: AnsiString;\n XceedField: PXceedUnicodePathRec;\nbegin\n FItemInfo.LoadFromStream( Stream );\n\n { decode filename (ANSI/OEM/UTF-8) }\n if FItemInfo.IsUTF8 or (AbDetectCharSet(FItemInfo.FileName) = csUTF8) then\n FFileName := UTF8ToString(FItemInfo.FileName)\n else if FItemInfo.ExtraField.Get(Ab_InfoZipUnicodePathSubfieldID, Pointer(InfoZipField), FieldSize) and\n (FieldSize > SizeOf(TInfoZipUnicodePathRec)) and\n (InfoZipField.Version = 1) and\n (InfoZipField.NameCRC32 = AbCRC32Of(FItemInfo.FileName)) then begin\n SetString(UTF8Name, InfoZipField.UnicodeName,\n FieldSize - SizeOf(TInfoZipUnicodePathRec) + 1);\n FFileName := UTF8ToString(UTF8Name);\n end\n else if FItemInfo.ExtraField.Get(Ab_XceedUnicodePathSubfieldID, Pointer(XceedField), FieldSize) and\n (FieldSize > SizeOf(TXceedUnicodePathRec)) and\n (XceedField.Signature = Ab_XceedUnicodePathSignature) and\n (XceedField.Length * SizeOf(WideChar) = FieldSize - SizeOf(TXceedUnicodePathRec) + SizeOf(WideChar)) then begin\n SetString(UnicodeName, XceedField.UnicodeName, XceedField.Length);\n FFileName := string(UnicodeName);\n end\n {$IFDEF MSWINDOWS}\n else if (GetACP <> GetOEMCP) and ((HostOS = hosDOS) or AbIsOEM(FItemInfo.FileName)) then begin\n SetLength(FFileName, Length(FItemInfo.FileName));\n OemToCharBuff(PAnsiChar(FItemInfo.FileName), PChar(FFileName), Length(FFileName));\n end\n {$ENDIF}\n else\n FFileName := string(FItemInfo.FileName);\n\n { read ZIP64 extended header }\n FUncompressedSize := FItemInfo.UncompressedSize;\n FCompressedSize := FItemInfo.CompressedSize;\n FRelativeOffset := FItemInfo.RelativeOffset;\n FDiskNumberStart := FItemInfo.DiskNumberStart;\n if FItemInfo.ExtraField.GetStream(Ab_Zip64SubfieldID, FieldStream) then\n try\n if FItemInfo.UncompressedSize = $FFFFFFFF then\n FieldStream.ReadBuffer(FUncompressedSize, SizeOf(Int64));\n if FItemInfo.CompressedSize = $FFFFFFFF then\n FieldStream.ReadBuffer(FCompressedSize, SizeOf(Int64));\n if FItemInfo.RelativeOffset = $FFFFFFFF then\n FieldStream.ReadBuffer(FRelativeOffset, SizeOf(Int64));\n if FItemInfo.DiskNumberStart = $FFFF then\n FieldStream.ReadBuffer(FDiskNumberStart, SizeOf(LongWord));\n finally\n FieldStream.Free;\n end;\n\n LastModFileTime := FItemInfo.LastModFileTime;\n LastModFileDate := FItemInfo.LastModFileDate;\n FDiskFileName := FileName;\n AbUnfixName( FDiskFileName );\n Action := aaNone;\n Tagged := False;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SaveLFHToStream( Stream : TStream );\nvar\n LFH : TAbZipLocalFileHeader;\n Zip64Field: TZip64LocalHeaderRec;\nbegin\n LFH := TAbZipLocalFileHeader.Create;\n try\n LFH.VersionNeededToExtract := VersionNeededToExtract;\n LFH.GeneralPurposeBitFlag := GeneralPurposeBitFlag;\n LFH.CompressionMethod := CompressionMethod;\n LFH.LastModFileTime := LastModFileTime;\n LFH.LastModFileDate := LastModFileDate;\n LFH.CRC32 := CRC32;\n LFH.FileName := RawFileName;\n LFH.ExtraField.Assign(LFHExtraField);\n LFH.ExtraField.CloneFrom(ExtraField, Ab_InfoZipUnicodePathSubfieldID);\n LFH.ExtraField.CloneFrom(ExtraField, Ab_XceedUnicodePathSubfieldID);\n { setup sizes; unlike the central directory header, the ZIP64 local header\n needs to store both compressed and uncompressed sizes if either needs it }\n if (CompressedSize >= $FFFFFFFF) or (UncompressedSize >= $FFFFFFFF) then begin\n LFH.UncompressedSize := $FFFFFFFF;\n LFH.CompressedSize := $FFFFFFFF;\n Zip64Field.UncompressedSize := UncompressedSize;\n Zip64Field.CompressedSize := CompressedSize;\n LFH.ExtraField.Put(Ab_Zip64SubfieldID, Zip64Field, SizeOf(Zip64Field));\n end\n else begin\n LFH.UncompressedSize := UncompressedSize;\n LFH.CompressedSize := CompressedSize;\n LFH.ExtraField.Delete(Ab_Zip64SubfieldID);\n end;\n LFH.SaveToStream( Stream );\n finally\n LFH.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SaveCDHToStream( Stream : TStream );\n {-Save a ZipCentralDirectorHeader entry to Stream}\nbegin\n FItemInfo.SaveToStream( Stream );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SaveDDToStream( Stream : TStream );\nvar\n DD : TAbZipDataDescriptor;\nbegin\n DD := TAbZipDataDescriptor.Create;\n try\n DD.CRC32 := CRC32;\n DD.CompressedSize := CompressedSize;\n DD.UncompressedSize := UncompressedSize;\n DD.SaveToStream( Stream );\n finally\n DD.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetCompressedSize( const Value : Int64 );\nbegin\n FCompressedSize := Value;\n FItemInfo.CompressedSize := Min(Value, $FFFFFFFF);\n UpdateZip64ExtraHeader;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetCompressionMethod( Value : TAbZipCompressionMethod );\nbegin\n FItemInfo.CompressionMethod := Value;\n UpdateVersionNeededToExtract;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetCRC32( const Value : Longint );\nbegin\n FItemInfo.CRC32 := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetDiskNumberStart( Value : LongWord );\nbegin\n FDiskNumberStart := Value;\n FItemInfo.DiskNumberStart := Min(Value, $FFFF);\n UpdateZip64ExtraHeader;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetExternalFileAttributes( Value : LongWord );\nbegin\n FItemInfo.ExternalFileAttributes := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetFileComment(const Value : AnsiString );\nbegin\n FItemInfo.FileComment := Value;\nend;\n{ -------------------------------------------------------------------------- }\n{$IFDEF KYLIX}{$IFOPT O+}{$DEFINE OPTIMIZATIONS_ON}{$O-}{$ENDIF}{$ENDIF}\nprocedure TAbZipItem.SetFileName(const Value : string );\nvar\n {$IFDEF MSWINDOWS}\n AnsiName : AnsiString;\n {$ENDIF}\n UTF8Name : AnsiString;\n FieldSize : Word;\n I : Integer;\n InfoZipField : PInfoZipUnicodePathRec;\n UseExtraField: Boolean;\nbegin\n inherited SetFileName(Value);\n {$IFDEF MSWINDOWS}\n FItemInfo.IsUTF8 := False;\n HostOS := hosDOS;\n if AbTryEncode(Value, CP_OEMCP, False, AnsiName) then\n {no-op}\n else if (GetACP <> GetOEMCP) and AbTryEncode(Value, CP_ACP, False, AnsiName) then\n HostOS := hosWinNT\n else if AbTryEncode(Value, CP_OEMCP, True, AnsiName) then\n {no-op}\n else if (GetACP <> GetOEMCP) and AbTryEncode(Value, CP_ACP, True, AnsiName) then\n HostOS := hosWinNT\n else\n FItemInfo.IsUTF8 := True;\n if FItemInfo.IsUTF8 then\n FItemInfo.FileName := Utf8Encode(Value)\n else\n FItemInfo.FileName := AnsiName;\n {$ENDIF}\n {$IFDEF UNIX}\n FItemInfo.FileName := AnsiString(Value);\n FItemInfo.IsUTF8 := AbSysCharSetIsUTF8;\n {$ENDIF}\n\n UseExtraField := False;\n if not FItemInfo.IsUTF8 then\n for i := 1 to Length(Value) do begin\n if Ord(Value[i]) > 127 then begin\n UseExtraField := True;\n Break;\n end;\n end;\n\n if UseExtraField then begin\n UTF8Name := AnsiToUTF8(Value);\n FieldSize := SizeOf(TInfoZipUnicodePathRec) + Length(UTF8Name) - 1;\n GetMem(InfoZipField, FieldSize);\n try\n InfoZipField.Version := 1;\n InfoZipField.NameCRC32 := AbCRC32Of(FItemInfo.FileName);\n Move(UTF8Name[1], InfoZipField.UnicodeName, Length(UTF8Name));\n FItemInfo.ExtraField.Put(Ab_InfoZipUnicodePathSubfieldID, InfoZipField^, FieldSize);\n finally\n FreeMem(InfoZipField);\n end;\n end\n else\n FItemInfo.ExtraField.Delete(Ab_InfoZipUnicodePathSubfieldID);\n FItemInfo.ExtraField.Delete(Ab_XceedUnicodePathSubfieldID);\nend;\n{$IFDEF OPTIMIZATIONS_ON}{$O+}{$ENDIF}\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetGeneralPurposeBitFlag( Value : Word );\nbegin\n FItemInfo.GeneralPurposeBitFlag := Value;\n UpdateVersionNeededToExtract;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetHostOS( Value : TAbZipHostOS );\nbegin\n FItemInfo.VersionMadeBy := Low(FItemInfo.VersionMadeBy) or\n Word(Ord(Value)) shl 8;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetInternalFileAttributes( Value : Word );\nbegin\n FItemInfo.InternalFileAttributes := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetLastModFileDate( const Value : Word );\nbegin\n FItemInfo.LastModFileDate := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetLastModFileTime( const Value : Word );\nbegin\n FItemInfo.LastModFileTime := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetRelativeOffset( Value : Int64 );\nbegin\n FRelativeOffset := Value;\n FItemInfo.RelativeOffset := Min(Value, $FFFFFFFF);\n UpdateZip64ExtraHeader;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetUncompressedSize( const Value : Int64 );\nbegin\n FUncompressedSize := Value;\n FItemInfo.UncompressedSize:= Min(Value, $FFFFFFFF);\n UpdateZip64ExtraHeader;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetVersionMadeBy( Value : Word );\nbegin\n FItemInfo.VersionMadeBy := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.SetVersionNeededToExtract( Value : Word );\nbegin\n FItemInfo.VersionNeededToExtract := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.UpdateVersionNeededToExtract;\n {calculates VersionNeededToExtract and VersionMadeBy based on used features}\nbegin\n {According to AppNote.txt zipx compression methods should set the Version\n Needed To Extract to the AppNote version the method was introduced in (e.g.,\n 6.3 for PPMd). Most utilities just set it to 2.0 and rely on the extractor\n detecting unsupported compression methods, since it's easier to add support\n for decompression methods without implementing the entire newer spec. }\n if ExtraField.Has(Ab_Zip64SubfieldID) then\n VersionNeededToExtract := 45\n else if IsDirectory or IsEncrypted or not (CompressionMethod in [cmStored..cmImploded]) then\n VersionNeededToExtract := 20\n else\n VersionNeededToExtract := 10;\n VersionMadeBy := (VersionMadeBy and $FF00) + Max(20, VersionNeededToExtract);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipItem.UpdateZip64ExtraHeader;\nvar\n Changed: Boolean;\n FieldStream: TMemoryStream;\nbegin\n FieldStream := TMemoryStream.Create;\n try\n if UncompressedSize >= $FFFFFFFF then\n FieldStream.WriteBuffer(FUncompressedSize, SizeOf(Int64));\n if CompressedSize >= $FFFFFFFF then\n FieldStream.WriteBuffer(FCompressedSize, SizeOf(Int64));\n if RelativeOffset >= $FFFFFFFF then\n FieldStream.WriteBuffer(FRelativeOffset, SizeOf(Int64));\n if DiskNumberStart >= $FFFF then\n FieldStream.WriteBuffer(FDiskNumberStart, SizeOf(LongWord));\n Changed := (FieldStream.Size > 0) <> ExtraField.Has(Ab_Zip64SubfieldID);\n if FieldStream.Size > 0 then\n ExtraField.Put(Ab_Zip64SubfieldID, FieldStream.Memory^, FieldStream.Size)\n else\n ExtraField.Delete(Ab_Zip64SubfieldID);\n if Changed then\n UpdateVersionNeededToExtract;\n finally\n FieldStream.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\n\n\n{ TAbZipArchive implementation ============================================= }\nconstructor TAbZipArchive.CreateFromStream( aStream : TStream;\n const ArchiveName : string );\nbegin\n inherited CreateFromStream( aStream, ArchiveName );\n FCompressionMethodToUse := smBestMethod;\n FInfo := TAbZipDirectoryFileFooter.Create;\n StoreOptions := StoreOptions + [soStripDrive];\n FDeflationOption := doNormal;\n FPasswordRetries := AbDefPasswordRetries;\n FTempDir := '';\n SpanningThreshold := AbDefZipSpanningThreshold;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbZipArchive.Destroy;\nbegin\n FInfo.Free;\n FInfo := nil;\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipArchive.CreateItem( const FileName : string ): TAbArchiveItem;\nvar\n FileSpec : string;\nbegin\n FileSpec := FileName;\n Result := TAbZipItem.Create;\n with TAbZipItem( Result ) do begin\n CompressionMethod := cmDeflated;\n GeneralPurposeBitFlag := 0;\n CompressedSize := 0;\n CRC32 := 0;\n DiskFileName := ExpandFileName(FileSpec);\n FileName := FixName(FileSpec);\n RelativeOffset := 0;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoExtractHelper(Index : Integer; const NewName : string);\nbegin\n if Assigned(FExtractHelper) then\n FExtractHelper(Self, ItemList[Index], NewName)\n else\n raise EAbZipNoExtraction.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoExtractToStreamHelper(Index : Integer;\n aStream : TStream);\nbegin\n if Assigned(FExtractToStreamHelper) then\n FExtractToStreamHelper(Self, ItemList[Index], aStream)\n else\n raise EAbZipNoExtraction.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoTestHelper(Index : Integer);\nbegin\n if Assigned(FTestHelper) then\n FTestHelper(Self, ItemList[Index])\n else\n raise EAbZipNoExtraction.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoInsertHelper(Index : Integer; OutStream : TStream);\nbegin\n if Assigned(FInsertHelper) then\n FInsertHelper(Self, ItemList[Index], OutStream)\n else\n raise EAbZipNoInsertion.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoInsertFromStreamHelper(Index : Integer;\n OutStream : TStream);\nbegin\n if Assigned(FInsertFromStreamHelper) then\n FInsertFromStreamHelper(Self, ItemList[Index], OutStream, InStream)\n else\n raise EAbZipNoInsertion.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoRequestDisk(const AMessage: string; var Abort : Boolean);\nbegin\n{$IFDEF MSWINDOWS}\n Abort := Windows.MessageBox( 0, PChar(AMessage), PChar(AbDiskRequestS),\n MB_TASKMODAL or MB_OKCANCEL ) = IDCANCEL;\n{$ENDIF}\n{$IFDEF UnixDialogs}\n {$IFDEF KYLIX}\n Abort := QDialogs.MessageDlg(AbDiskRequestS, AMessage, mtWarning,\n mbOKCancel, 0) = mrCancel;\n {$ENDIF}\n {$IFDEF LCL}\n Abort := Dialogs.MessageDlg(AbDiskRequestS, AMessage, mtWarning, mbOKCancel,\n 0) = mrCancel;\n {$ENDIF}\n{$ELSE}\n Abort := True;\n{$ENDIF}\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoRequestLastDisk( var Abort : Boolean );\nbegin\n Abort := False;\n if Assigned( FOnRequestLastDisk ) then\n FOnRequestLastDisk( Self, Abort )\n else\n DoRequestDisk( AbLastDiskRequestS, Abort );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoRequestNthDisk( Sender: TObject;\n DiskNumber : Byte;\n var Abort : Boolean );\nbegin\n Abort := False;\n if Assigned( FOnRequestNthDisk ) then\n FOnRequestNthDisk( Self, DiskNumber, Abort )\n else\n DoRequestDisk( Format(AbDiskNumRequestS, [DiskNumber]), Abort );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoRequestBlankDisk(Sender: TObject; var Abort : Boolean );\nbegin\n Abort := False;\n FSpanned := True;\n\n if Assigned( FOnRequestBlankDisk ) then\n FOnRequestBlankDisk( Self, Abort )\n else\n DoRequestDisk( AbBlankDiskS, Abort );\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.DoRequestImage(Sender: TObject; ImageNumber : Integer;\n var ImageName : string ; var Abort : Boolean);\nbegin\n if Assigned(FOnRequestImage) then\n FOnRequestImage(Self, ImageNumber, ImageName, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.ExtractItemAt(Index : Integer; const UseName : string);\nbegin\n DoExtractHelper(Index, UseName);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.ExtractItemToStreamAt(Index : Integer;\n aStream : TStream);\nbegin\n DoExtractToStreamHelper(Index, aStream);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipArchive.FixName(const Value : string ) : string;\n {-changes backslashes to forward slashes}\nvar\n i : SmallInt;\n lValue : string;\nbegin\n lValue := Value;\n {$IFDEF MSWINDOWS}\n if DOSMode then begin\n {Add the base directory to the filename before converting }\n {the file spec to the short filespec format. }\n if BaseDirectory <> '' then begin\n {Does the filename contain a drive or a leading backslash? }\n if not ((Pos(':', lValue) = 2) or (Pos(AbPathDelim, lValue) = 1)) then\n {If not, add the BaseDirectory to the filename.}\n lValue := AbAddBackSlash(BaseDirectory) + lValue;\n end;\n lValue := AbGetShortFileSpec( lValue );\n end;\n {$ENDIF MSWINDOWS}\n\n {Zip files Always strip the drive path}\n StoreOptions := StoreOptions + [soStripDrive];\n\n {strip drive stuff}\n if soStripDrive in StoreOptions then\n AbStripDrive( lValue );\n\n {check for a leading backslash}\n if (Length(lValue) > 1) and (lValue[1] = AbPathDelim) then\n System.Delete( lValue, 1, 1 );\n\n if soStripPath in StoreOptions then begin\n lValue := ExtractFileName( lValue );\n end;\n\n if soRemoveDots in StoreOptions then\n AbStripDots( lValue );\n\n for i := 1 to Length( lValue ) do\n if lValue[i] = '\\' then\n lValue[i] := '/';\n Result := lValue;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipArchive.GetItem( Index : Integer ) : TAbZipItem;\nbegin\n Result := TAbZipItem(FItemList.Items[Index]);\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipArchive.GetSupportsEmptyFolders: Boolean;\nbegin\n Result := True;\nend;\n{ -------------------------------------------------------------------------- }\nfunction TAbZipArchive.GetZipfileComment : AnsiString;\nbegin\n Result := FInfo.ZipfileComment;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.LoadArchive;\nvar\n Abort : Boolean;\n TailPosition : int64;\n Item : TAbZipItem;\n Progress : Byte;\n FileSignature : Longint;\n Zip64Locator : TAbZip64EndOfCentralDirectoryLocator;\nbegin\n Abort := False;\n if FStream.Size = 0 then\n Exit;\n\n {Get signature info}\n FStream.Position := 0;\n FStream.Read( FileSignature, sizeof( FileSignature ) );\n\n {Get Executable Type; allow non-native stubs}\n IsExecutable :=\n (LongRec(FileSignature).Lo = Ab_WindowsExeSignature) or\n (FileSignature = Ab_LinuxExeSignature);\n\n { try to locate central directory tail }\n TailPosition := FindCentralDirectoryTail( FStream );\n if (TailPosition = -1) and (FileSignature = Ab_ZipSpannedSetSignature) and\n FOwnsStream and AbDriveIsRemovable(ArchiveName) then begin\n while TailPosition = -1 do begin\n FreeAndNil(FStream);\n DoRequestLastDisk(Abort);\n if Abort then begin\n FStatus := asInvalid; //TODO: Status updates are extremely inconsistent\n raise EAbUserAbort.Create;\n end;\n FStream := TFileStream.Create( ArchiveName, Mode );\n TailPosition := FindCentralDirectoryTail( FStream );\n end;\n end;\n\n if TailPosition = -1 then begin\n FStatus := asInvalid;\n raise EAbZipInvalid.Create;\n end;\n\n { load the ZipDirectoryFileFooter }\n FInfo.LoadFromStream(FStream);\n\n { find Zip64 end of central directory locator; it will usually occur\n immediately before the standard end of central directory record.\n the actual Zip64 end of central directory may be on another disk }\n if FInfo.IsZip64 then begin\n Dec(TailPosition, SizeOf(Zip64Locator));\n repeat\n if TailPosition < 0 then\n raise EAbZipInvalid.Create;\n FStream.Position := TailPosition;\n FStream.ReadBuffer(Zip64Locator, SizeOf(Zip64Locator));\n Dec(TailPosition);\n until Zip64Locator.Signature = Ab_Zip64EndCentralDirectoryLocatorSignature;\n { update current image number }\n FInfo.DiskNumber := Zip64Locator.TotalDisks - 1;\n end;\n\n { setup spanning support and move to the start of the central directory }\n FSpanned := FInfo.DiskNumber > 0;\n\n if FSpanned then begin\n if FOwnsStream then begin\n FStream := TAbSpanReadStream.Create( ArchiveName, FInfo.DiskNumber, FStream );\n TAbSpanReadStream(FStream).OnRequestImage := DoRequestImage;\n TAbSpanReadStream(FStream).OnRequestNthDisk := DoRequestNthDisk;\n if FInfo.IsZip64 then begin\n TAbSpanReadStream(FStream).SeekImage(Zip64Locator.StartDiskNumber,\n Zip64Locator.RelativeOffset);\n FInfo.LoadZip64FromStream(FStream);\n end;\n TAbSpanReadStream(FStream).SeekImage(FInfo.StartDiskNumber, FInfo.DirectoryOffset);\n end\n else\n raise EAbZipBadSpanStream.Create;\n end\n else begin\n if FInfo.IsZip64 then begin\n FStream.Position := Zip64Locator.RelativeOffset;\n FInfo.LoadZip64FromStream(FStream);\n end;\n FStream.Position := FInfo.DirectoryOffset;\n end;\n\n { build Items list from central directory records }\n FStubSize := High(LongWord);\n while Count < FInfo.TotalEntries do begin\n { create new Item }\n Item := TAbZipItem.Create;\n try\n Item.LoadFromStream(FStream);\n Item.Action := aaNone;\n FItemList.Add(Item);\n except\n Item.Free;\n raise;\n end;\n\n if IsExecutable and (Item.DiskNumberStart = 0) and\n (Item.RelativeOffset < FStubSize) then\n FStubSize := Item.RelativeOffset;\n\n Progress := (Count * 100) div FInfo.TotalEntries;\n DoArchiveProgress( Progress, Abort );\n if Abort then begin\n FStatus := asInvalid;\n raise EAbUserAbort.Create;\n end;\n end;\n\n DoArchiveProgress(100, Abort);\n FIsDirty := False;\nend;\n\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.PutItem( Index : Integer; Value : TAbZipItem );\nbegin\n FItemList.Items[Index] := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.SaveArchive;\n {builds a new archive and copies it to FStream}\nvar\n Abort : Boolean;\n MemStream : TMemoryStream;\n HasDataDescriptor : Boolean;\n i : LongWord;\n LFH : TAbZipLocalFileHeader;\n NewStream : TStream;\n WorkingStream : TAbVirtualMemoryStream;\n CurrItem : TAbZipItem;\n Progress : Byte;\nbegin\n if Count = 0 then\n Exit;\n\n {shouldn't be trying to overwrite an existing spanned archive}\n if Spanned then begin\n for i := 0 to Pred(Count) do\n if ItemList[i].Action <> aaFailed then\n ItemList[i].Action := aaNone;\n FIsDirty := False;\n raise EAbZipSpanOverwrite.Create;\n end;\n\n {init new zip archive stream\n can span only new archives, if SpanningThreshold > 0 or removable drive\n spanning writes to original location, rather than writing to a temp stream first}\n if FOwnsStream and (FStream.Size = 0) and not IsExecutable and\n ((SpanningThreshold > 0) or AbDriveIsRemovable(ArchiveName)) then begin\n NewStream := TAbSpanWriteStream.Create(ArchiveName, FStream, SpanningThreshold);\n FStream := nil;\n TAbSpanWriteStream(NewStream).OnRequestBlankDisk := DoRequestBlankDisk;\n TAbSpanWriteStream(NewStream).OnRequestImage := DoRequestImage;\n end\n else begin\n NewStream := TAbVirtualMemoryStream.Create;\n TAbVirtualMemoryStream(NewStream).SwapFileDirectory := FTempDir;\n end;\n\n try {NewStream}\n {copy the executable stub over to the output}\n if IsExecutable then\n NewStream.CopyFrom( FStream, StubSize )\n {assume spanned for spanning stream}\n else if NewStream is TAbSpanWriteStream then\n NewStream.Write(Ab_ZipSpannedSetSignature,\n SizeOf(Ab_ZipSpannedSetSignature));\n\n {build new zip archive from existing archive}\n for i := 0 to pred( Count ) do begin\n CurrItem := (ItemList[i] as TAbZipItem);\n FCurrentItem := ItemList[i];\n\n case CurrItem.Action of\n aaNone, aaMove: begin\n {just copy the file to new stream}\n Assert(not (NewStream is TAbSpanWriteStream));\n FStream.Position := CurrItem.RelativeOffset;\n CurrItem.DiskNumberStart := 0;\n CurrItem.RelativeOffset := NewStream.Position;\n {toss old local file header}\n LFH := TAbZipLocalFileHeader.Create;\n try {LFH}\n LFH.LoadFromStream( FStream );\n if CurrItem.LFHExtraField.Count = 0 then\n CurrItem.LFHExtraField.Assign(LFH.ExtraField);\n finally {LFH}\n LFH.Free;\n end; {LFH}\n {write out new local file header and append compressed data}\n\n CurrItem.SaveLFHToStream( NewStream );\n if (CurrItem.CompressedSize > 0) then\n NewStream.CopyFrom(FStream, CurrItem.CompressedSize);\n end;\n\n aaDelete: begin\n {doing nothing omits file from new stream}\n end;\n\n aaAdd, aaFreshen, aaReplace, aaStreamAdd: begin\n {compress the file and add it to new stream}\n try\n WorkingStream := TAbVirtualMemoryStream.Create;\n try {WorkingStream}\n WorkingStream.SwapFileDirectory := FTempDir;\n {compress the file}\n if (CurrItem.Action = aaStreamAdd) then\n DoInsertFromStreamHelper(i, WorkingStream)\n else\n DoInsertHelper(i, WorkingStream);\n {write local header}\n if NewStream is TAbSpanWriteStream then begin\n MemStream := TMemoryStream.Create;\n try\n CurrItem.SaveLFHToStream(MemStream);\n TAbSpanWriteStream(NewStream).WriteUnspanned(\n MemStream.Memory^, MemStream.Size);\n {calculate positions after the write in case it triggered a new span}\n CurrItem.DiskNumberStart := TAbSpanWriteStream(NewStream).CurrentImage;\n CurrItem.RelativeOffset := NewStream.Position - MemStream.Size;\n finally\n MemStream.Free;\n end;\n end\n else begin\n CurrItem.DiskNumberStart := 0;\n CurrItem.RelativeOffset := NewStream.Position;\n CurrItem.SaveLFHToStream(NewStream);\n end;\n {copy compressed data}\n NewStream.CopyFrom(WorkingStream, 0);\n if CurrItem.IsEncrypted then\n CurrItem.SaveDDToStream(NewStream);\n finally\n WorkingStream.Free;\n end;\n except\n on E : Exception do\n begin\n { Exception was caused by a User Abort and Item Failure should not be called\n Question: Do we want an New Event when this occurs or should the\n exception just be re-raised [783614] }\n if (E is EAbUserAbort) then\n raise;\n CurrItem.Action := aaDelete;\n DoProcessItemFailure(CurrItem, ptAdd, ecFileOpenError, 0);\n end;\n end;\n end;\n end; { case }\n\n { TODO: Check HasDataDescriptior behavior; seems like it's getting\n written twice for encrypted files }\n {Now add the data descriptor record to new stream}\n HasDataDescriptor := (CurrItem.CompressionMethod = cmDeflated) and\n ((CurrItem.GeneralPurposeBitFlag and AbHasDataDescriptorFlag) <> 0);\n if (CurrItem.Action <> aaDelete) and HasDataDescriptor then\n CurrItem.SaveDDToStream(NewStream);\n Progress := AbPercentage(9 * succ( i ), 10 * Count);\n DoArchiveSaveProgress(Progress, Abort);\n DoArchiveProgress(Progress, Abort);\n if Abort then\n raise EAbUserAbort.Create;\n end;\n\n {write the central directory}\n if NewStream is TAbSpanWriteStream then\n FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage\n else\n FInfo.DiskNumber := 0;\n FInfo.StartDiskNumber := FInfo.DiskNumber;\n FInfo.DirectoryOffset := NewStream.Position;\n FInfo.DirectorySize := 0;\n FInfo.EntriesOnDisk := 0;\n FInfo.TotalEntries := 0;\n MemStream := TMemoryStream.Create;\n try\n {write central directory entries}\n for i := 0 to Count - 1 do begin\n if not (FItemList[i].Action in [aaDelete, aaFailed]) then begin\n (FItemList[i] as TAbZipItem).SaveCDHToStream(MemStream);\n if NewStream is TAbSpanWriteStream then begin\n TAbSpanWriteStream(NewStream).WriteUnspanned(MemStream.Memory^, MemStream.Size);\n {update tail info on span change}\n if FInfo.DiskNumber <> TAbSpanWriteStream(NewStream).CurrentImage then begin\n FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage;\n FInfo.EntriesOnDisk := 0;\n if FInfo.TotalEntries = 0 then begin\n FInfo.StartDiskNumber := FInfo.DiskNumber;\n FInfo.DirectoryOffset := NewStream.Position - MemStream.Size;\n end;\n end;\n end\n else\n NewStream.WriteBuffer(MemStream.Memory^, MemStream.Size);\n FInfo.DirectorySize := FInfo.DirectorySize + MemStream.Size;\n FInfo.EntriesOnDisk := FInfo.EntriesOnDisk + 1;\n FInfo.TotalEntries := FInfo.TotalEntries + 1;\n MemStream.Clear;\n end;\n end;\n {append the central directory footer}\n FInfo.SaveToStream(MemStream, NewStream.Position);\n if NewStream is TAbSpanWriteStream then begin\n {update the footer if writing it would trigger a new span}\n if not TAbSpanWriteStream(NewStream).WriteUnspanned(MemStream.Memory^,\n MemStream.Size) then begin\n FInfo.DiskNumber := TAbSpanWriteStream(NewStream).CurrentImage;\n FInfo.EntriesOnDisk := 0;\n FInfo.SaveToStream(NewStream);\n end;\n end\n else\n NewStream.WriteBuffer(MemStream.Memory^, MemStream.Size);\n finally {MemStream}\n MemStream.Free;\n end; {MemStream}\n\n FSpanned := (FInfo.DiskNumber > 0);\n\n {update output stream}\n if NewStream is TAbSpanWriteStream then begin\n {zip has already been written to target location}\n FStream := TAbSpanWriteStream(NewStream).ReleaseStream;\n if Spanned then begin\n {switch to read stream}\n FStream := TAbSpanReadStream.Create(ArchiveName, FInfo.DiskNumber, FStream);\n TAbSpanReadStream(FStream).OnRequestImage := DoRequestImage;\n TAbSpanReadStream(FStream).OnRequestNthDisk := DoRequestNthDisk;\n end\n else begin\n {replace spanned signature}\n FStream.Position := 0;\n FStream.Write(Ab_ZipPossiblySpannedSignature,\n SizeOf(Ab_ZipPossiblySpannedSignature));\n end;\n end\n else begin\n {copy new stream to FStream (non-spanned only)}\n NewStream.Position := 0;\n if (FStream is TMemoryStream) then\n TMemoryStream(FStream).LoadFromStream(NewStream)\n else begin\n if FOwnsStream then begin\n {need new stream to write}\n FreeAndNil(FStream);\n FStream := TFileStream.Create(FArchiveName,\n fmOpenReadWrite or fmShareDenyWrite);\n end;\n FStream.Size := 0;\n FStream.Position := 0;\n FStream.CopyFrom(NewStream, 0)\n end;\n end;\n\n {update Items list}\n for i := pred( Count ) downto 0 do begin\n if FItemList[i].Action = aaDelete then\n FItemList.Delete( i )\n else if FItemList[i].Action <> aaFailed then\n FItemList[i].Action := aaNone;\n end;\n\n DoArchiveSaveProgress( 100, Abort );\n DoArchiveProgress( 100, Abort );\n finally {NewStream}\n NewStream.Free;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.SetZipfileComment(const Value : AnsiString );\nbegin\n FInfo.FZipfileComment := Value;\n FIsDirty := True;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbZipArchive.TestItemAt(Index : Integer);\nbegin\n DoTestHelper(Index);\nend;\n\nend.\n\n\n\n\n"
},
{
"path": "lib/abbrevia/source/AbZipper.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\n{*********************************************************}\n{* ABBREVIA: AbZipper.pas *}\n{*********************************************************}\n{* ABBREVIA: Non-visual Component with Zip support *}\n{*********************************************************}\n\nunit AbZipper;\n\n{$I AbDefine.inc}\n\ninterface\n\nuses\n Classes,\n AbBrowse, AbZBrows, AbArcTyp, AbZipTyp;\n\ntype\n TAbCustomZipper = class(TAbCustomZipBrowser)\n protected {private}\n FAutoSave : Boolean;\n FCompressionMethodToUse : TAbZipSupportedMethod;\n FDeflationOption : TAbZipDeflationOption;\n FDOSMode : Boolean;\n FOnConfirmSave : TAbArchiveConfirmEvent;\n FOnSave : TAbArchiveEvent;\n FOnArchiveSaveProgress : TAbArchiveProgressEvent;\n FArchiveSaveProgressMeter : IAbProgressMeter;\n\n FStoreOptions : TAbStoreOptions;\n\n protected {methods}\n procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean);\n virtual;\n procedure DoSave(Sender : TObject);\n virtual;\n procedure DoArchiveSaveProgress(Sender : TObject; Progress : Byte;\n var Abort : Boolean);\n\n procedure InitArchive;\n override;\n procedure SetAutoSave(Value : Boolean);\n procedure SetCompressionMethodToUse(Value : TAbZipSupportedMethod);\n procedure SetDeflationOption(Value : TAbZipDeflationOption);\n procedure SetDOSMode( Value : Boolean );\n procedure SetFileName(const aFileName : string);\n override;\n procedure SetStoreOptions( Value : TAbStoreOptions );\n procedure SetArchiveSaveProgressMeter(const Value: IAbProgressMeter);\n procedure SetZipfileComment(const Value : AnsiString);\n override;\n procedure ZipProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\n procedure ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream, InStream : TStream );\n procedure Notification(Component: TComponent;\n Operation: TOperation); override;\n procedure ResetMeters; override;\n\n protected {properties}\n property AutoSave : Boolean\n read FAutoSave\n write SetAutoSave;\n property CompressionMethodToUse : TAbZipSupportedMethod\n read FCompressionMethodToUse\n write SetCompressionMethodToUse\n default AbDefCompressionMethodToUse;\n property DeflationOption : TAbZipDeflationOption\n read FDeflationOption\n write SetDeflationOption\n default AbDefDeflationOption;\n property DOSMode : Boolean\n read FDOSMode\n write SetDOSMode;\n property StoreOptions : TAbStoreOptions\n read FStoreOptions\n write SetStoreOptions\n default AbDefStoreOptions;\n property ArchiveSaveProgressMeter : IAbProgressMeter\n read FArchiveSaveProgressMeter\n write SetArchiveSaveProgressMeter;\n\n\n protected {events}\n property OnConfirmSave : TAbArchiveConfirmEvent\n read FOnConfirmSave\n write FOnConfirmSave;\n property OnSave : TAbArchiveEvent\n read FOnSave\n write FOnSave;\n property OnArchiveSaveProgress : TAbArchiveProgressEvent\n read FOnArchiveSaveProgress\n write FOnArchiveSaveProgress;\n\n public {methods}\n constructor Create(AOwner : TComponent);\n override;\n destructor Destroy;\n override;\n procedure AddFiles(const FileMask : string; SearchAttr : Integer);\n procedure AddFilesEx(const FileMask, ExclusionMask : string; SearchAttr : Integer);\n procedure AddFromStream(const NewName : string; FromStream : TStream);\n procedure DeleteAt(Index : Integer);\n procedure DeleteFiles(const FileMask : string);\n procedure DeleteFilesEx(const FileMask, ExclusionMask : string);\n procedure DeleteTaggedItems;\n procedure FreshenFiles(const FileMask : string);\n procedure FreshenFilesEx(const FileMask, ExclusionMask : string);\n procedure FreshenTaggedItems;\n procedure Move(aItem : TAbArchiveItem; const NewStoredPath : string);\n procedure Save;\n procedure Replace(aItem : TAbArchiveItem);\n end;\n\ntype\n TAbZipper = class(TAbCustomZipper)\n published\n property ArchiveProgressMeter;\n property ArchiveSaveProgressMeter;\n property ItemProgressMeter;\n property AutoSave;\n property BaseDirectory;\n property CompressionMethodToUse;\n property DeflationOption;\n property DOSMode;\n property SpanningThreshold;\n property LogFile;\n property Logging;\n property OnArchiveProgress;\n property OnArchiveSaveProgress;\n property OnArchiveItemProgress;\n property OnChange;\n property OnConfirmProcessItem;\n property OnConfirmSave;\n property OnLoad;\n property OnProcessItemFailure;\n property OnRequestBlankDisk;\n property OnRequestImage;\n property OnRequestLastDisk;\n property OnRequestNthDisk;\n property OnSave;\n property Password;\n property StoreOptions;\n property TempDirectory;\n property Version;\n property FileName; {must be after OnLoad}\n end;\n\nimplementation\n\nuses\n SysUtils, AbUtils, AbTarTyp, AbGzTyp, AbBzip2Typ, AbExcept, AbZipPrc;\n\n{ -------------------------------------------------------------------------- }\nconstructor TAbCustomZipper.Create( AOwner : TComponent );\nbegin\n inherited Create( AOwner );\n CompressionMethodToUse := AbDefCompressionMethodToUse;\n DeflationOption := AbDefDeflationOption;\n StoreOptions := AbDefStoreOptions;\nend;\n{ -------------------------------------------------------------------------- }\ndestructor TAbCustomZipper.Destroy;\nbegin\n inherited Destroy;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.AddFiles(const FileMask : string; SearchAttr : Integer);\n {Add files to the archive where the disk filespec matches}\nbegin\n if (FArchive <> nil) then\n FArchive.AddFiles(FileMask, SearchAttr)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.AddFilesEx(const FileMask, ExclusionMask : string;\n SearchAttr : Integer);\n {Add files that match Filemask except those matching ExclusionMask}\nbegin\n if (FArchive <> nil) then\n FArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.AddFromStream(const NewName : string;\n FromStream : TStream);\n {Add stream directly to archive}\nbegin\n if (FArchive <> nil) then begin\n FromStream.Position := 0;\n FArchive.AddFromStream(NewName, FromStream);\n end else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DeleteFiles(const FileMask : string);\n {delete all files from the archive that match the file mask}\nbegin\n if (FArchive <> nil) then\n FArchive.DeleteFiles( FileMask )\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DeleteAt(Index : Integer);\n {delete item at Index}\nbegin\n if (FArchive <> nil) then\n FArchive.DeleteAt( Index )\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DeleteFilesEx(const FileMask, ExclusionMask : string);\n {Delete files that match Filemask except those matching ExclusionMask}\nbegin\n if (FArchive <> nil) then\n FArchive.DeleteFilesEx(FileMask, ExclusionMask)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DeleteTaggedItems;\n {delete all tagged items from the archive}\nbegin\n if (FArchive <> nil) then\n FArchive.DeleteTaggedItems\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DoConfirmSave(Sender : TObject; var Confirm : Boolean);\nbegin\n Confirm := True;\n if Assigned(FOnConfirmSave) then\n FOnConfirmSave(Self, Confirm);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DoSave(Sender : TObject);\nbegin\n if Assigned(FOnSave) then\n FOnSave(Self);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.FreshenFiles(const FileMask : string);\n {freshen all items that match the file mask}\nbegin\n if (FArchive <> nil) then\n FArchive.FreshenFiles( FileMask )\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.FreshenFilesEx(const FileMask, ExclusionMask : string);\n {freshen all items matching FileMask except those matching ExclusionMask}\nbegin\n if (FArchive <> nil) then\n FArchive.FreshenFilesEx( FileMask, ExclusionMask )\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.FreshenTaggedItems;\n {freshen all tagged items}\nbegin\n if (FArchive <> nil) then\n FArchive.FreshenTaggedItems\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.InitArchive;\nbegin\n inherited InitArchive;\n if FArchive <> nil then begin\n {properties}\n FArchive.AutoSave := FAutoSave;\n FArchive.DOSMode := FDOSMode;\n FArchive.StoreOptions := FStoreOptions;\n {events}\n FArchive.OnArchiveSaveProgress := DoArchiveSaveProgress;\n FArchive.OnConfirmSave := DoConfirmSave;\n FArchive.OnSave := DoSave;\n end;\n if (FArchive is TAbZipArchive) then begin\n {properties}\n TAbZipArchive(FArchive).CompressionMethodToUse := FCompressionMethodToUse;\n TAbZipArchive(FArchive).DeflationOption := FDeflationOption;\n {events}\n TAbZipArchive(FArchive).OnRequestBlankDisk := OnRequestBlankDisk;\n TAbZipArchive(FArchive).InsertHelper := ZipProc;\n TAbZipArchive(FArchive).InsertFromStreamHelper := ZipFromStreamProc;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.Move(aItem : TAbArchiveItem; const NewStoredPath : string);\n {renames the item}\nbegin\n if (FArchive <> nil) then\n FArchive.Move(aItem, NewStoredPath)\n else\n raise EAbNoArchive.Create;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.Replace(aItem : TAbArchiveItem);\n {replace the item}\nbegin\n if (FArchive <> nil) then\n FArchive.Replace( aItem )\n else\n raise EAbNoArchive.Create;\n DoChange; \nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.Save;\nbegin\n if (FArchive <> nil) then begin\n FArchive.Save;\n DoChange;\n end;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetAutoSave(Value : Boolean);\nbegin\n FAutoSave := Value;\n if (FArchive <> nil) then\n FArchive.AutoSave := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetCompressionMethodToUse(\n Value : TAbZipSupportedMethod);\nbegin\n FCompressionMethodToUse := Value;\n if (FArchive is TAbZipArchive) then\n TAbZipArchive(FArchive).CompressionMethodToUse := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetDeflationOption(Value : TAbZipDeflationOption);\nbegin\n FDeflationOption := Value;\n if (FArchive is TAbZipArchive) then\n TAbZipArchive(FArchive).DeflationOption := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetDOSMode(Value : Boolean);\nbegin\n FDOSMode := Value;\n if (FArchive <> nil) then\n FArchive.DOSMode := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetFileName(const aFileName : string);\nvar\n ArcType : TAbArchiveType;\nbegin\n FFileName := aFileName;\n if (csDesigning in ComponentState) then\n Exit;\n\n if Assigned(FArchive) then\n begin\n FArchive.Save;\n FreeAndNil(FArchive);\n end;\n\n ArcType := ArchiveType;\n\n if (FileName <> '') then\n if FileExists(FileName) then begin { open it }\n\n if not ForceType then\n ArcType := AbDetermineArcType(FileName, atUnknown);\n\n case ArcType of\n atZip, atSpannedZip, atSelfExtZip : begin\n FArchive := TAbZipArchive.Create(FileName, fmOpenRead or fmShareDenyNone);\n InitArchive;\n end;\n\n atTar : begin\n FArchive := TAbTarArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);\n inherited InitArchive;\n end;\n\n atGZip : begin\n FArchive := TAbGzipArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := False;\n inherited InitArchive;\n end;\n\n atGZippedTar : begin\n FArchive := TAbGzipArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := True;\n inherited InitArchive;\n end;\n\n atBzip2 : begin\n FArchive := TAbBzip2Archive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := False;\n inherited InitArchive;\n end;\n\n atBzippedTar : begin\n FArchive := TAbBzip2Archive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := True;\n inherited InitArchive;\n end;\n\n else\n raise EAbUnhandledType.Create;\n end {case};\n FArchive.Load;\n FArchiveType := ArcType;\n\n end else begin { file doesn't exist, so create a new one }\n if not ForceType then\n ArcType := AbDetermineArcType(FileName, atUnknown);\n\n case ArcType of\n atZip : begin \n FArchive := TAbZipArchive.Create(FileName, fmCreate);\n InitArchive;\n end;\n\n atTar : begin\n FArchive := TAbTarArchive.Create(FileName, fmCreate or fmShareDenyNone);\n inherited InitArchive;\n end;\n\n atGZip : begin\n FArchive := TAbGzipArchive.Create(FileName, fmCreate or fmShareDenyNone);\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := False;\n inherited InitArchive;\n end;\n\n atGZippedTar : begin\n FArchive := TAbGzipArchive.Create(FileName, fmCreate or fmShareDenyNone);\n TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbGzipArchive(FArchive).IsGzippedTar := True;\n inherited InitArchive;\n end;\n\n atBzip2 : begin\n FArchive := TAbBzip2Archive.Create(FileName, fmCreate or fmShareDenyNone);\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := False;\n inherited InitArchive;\n end;\n\n atBzippedTar : begin\n FArchive := TAbBzip2Archive.Create(FileName, fmCreate or fmShareDenyNone);\n TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;\n TAbBzip2Archive(FArchive).IsBzippedTar := True;\n inherited InitArchive;\n end;\n\n else\n raise EAbUnhandledType.Create;\n end {case};\n\n FArchiveType := ArcType;\n end;\n DoChange;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetStoreOptions(Value : TAbStoreOptions);\nbegin\n FStoreOptions := Value;\n if (FArchive <> nil) then\n FArchive.StoreOptions := Value;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetArchiveSaveProgressMeter(const Value: IAbProgressMeter);\nbegin\n ReferenceInterface(FArchiveSaveProgressMeter, opRemove);\n FArchiveSaveProgressMeter := Value;\n ReferenceInterface(FArchiveSaveProgressMeter, opInsert);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.SetZipfileComment(const Value : AnsiString);\nbegin\n if (FArchive is TAbZipArchive) then\n TAbZipArchive(FArchive).ZipfileComment := Value\n else\n raise EAbNoArchive.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.ZipProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream : TStream);\nbegin\n AbZip(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem;\n OutStream, InStream : TStream);\nbegin\n if Assigned(InStream) then\n AbZipFromStream(TAbZipArchive(Sender), TAbZipItem(Item),\n OutStream, InStream)\n else\n raise EAbZipNoInsertion.Create;\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.DoArchiveSaveProgress(Sender : TObject;\n Progress : Byte;\n var Abort : Boolean);\nbegin\n Abort := False;\n if Assigned(FArchiveSaveProgressMeter) then\n FArchiveSaveProgressMeter.DoProgress(Progress);\n if Assigned(FOnArchiveSaveProgress) then\n FOnArchiveSaveProgress(Self, Progress, Abort);\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.Notification(Component: TComponent;\n Operation: TOperation);\nbegin\n inherited Notification(Component, Operation);\n if (Operation = opRemove) then\n if Assigned(ArchiveSaveProgressMeter) and Component.IsImplementorOf(ArchiveSaveProgressMeter) then\n ArchiveSaveProgressMeter := nil\nend;\n{ -------------------------------------------------------------------------- }\nprocedure TAbCustomZipper.ResetMeters;\nbegin\n inherited ResetMeters;\n if Assigned(FArchiveSaveProgressMeter) then\n FArchiveSaveProgressMeter.Reset;\nend;\n{ -------------------------------------------------------------------------- }\n\nend.\n\n"
},
{
"path": "lib/abbrevia/source/COM/Abbrevia.dpr",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nlibrary Abbrevia;\n\nuses\n ComServ,\n _ZipKit in '_ZipKit.pas',\n _ZipItem in '_ZipItem.pas',\n _GZipItem in '_GZipItem.pas',\n _TarItem in '_TarItem.pas',\n Abbrevia_TLB in 'Abbrevia_TLB.pas';\n\nexports\n DllGetClassObject,\n DllCanUnloadNow,\n DllRegisterServer,\n DllUnregisterServer,\n DllInstall;\n\n{$R *.TLB}\n\n{$R *.RES}\n\nbegin\nend.\n"
},
{
"path": "lib/abbrevia/source/COM/Abbrevia.dproj",
"content": "\t\n\t\t\n\t\t\t{EDA07E3C-7B07-4B14-9B53-64A70EF3F00A}\n\t\t\tAbbrevia.dpr\n\t\t\tTrue\n\t\t\tRelease\n\t\t\t3\n\t\t\tLibrary\n\t\t\tNone\n\t\t\t13.4\n\t\t\tWin32\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tCfg_1\n\t\t\ttrue\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tCfg_1\n\t\t\ttrue\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tBase\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tCfg_2\n\t\t\ttrue\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tCfg_2\n\t\t\ttrue\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\t.\\$(Platform)\n\t\t\t..\\;$(DCC_UnitSearchPath)\n\t\t\tNone\n\t\t\ttrue\n\t\t\t5\n\t\t\t1033\n\t\t\tfalse\n\t\t\tCompanyName=;FileDescription=Abbrevia COM components;FileVersion=5.0.0.0;InternalName=;LegalCopyright=Copyright (c) Abbrevia Group 2011;LegalTrademarks=;OriginalFilename=;ProductName=Abbrevia;ProductVersion=5.0;Comments=\n\t\t\tSystem;Xml;Data;Datasnap;Web;Soap;System.Win;Winapi;Vcl;$(DCC_Namespace)\n\t\t\t00400000\n\t\t\tfalse\n\t\t\ttrue\n\t\t\tfalse\n\t\t\tfalse\n\t\t\tfalse\n\t\t\n\t\t\n\t\t\tData.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)\n\t\t\tCompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=\n\t\t\tAbbrevia_Icon.ico\n\t\t\n\t\t\n\t\t\t/i:user /n Abbrevia.dll\n\t\t\tC:\\Windows\\System32\\regsvr32.exe\n\t\t\tData.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)\n\t\t\tCompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=\n\t\t\n\t\t\n\t\t\tfalse\n\t\t\tfalse\n\t\t\t0\n\t\t\tRELEASE;$(DCC_Define)\n\t\t\n\t\t\n\t\t\tCompanyName=;FileDescription=Abbrevia COM components;FileVersion=5.0;InternalName=;LegalCopyright=Copyright (c) 2011 Abbrevia Group;LegalTrademarks=;OriginalFilename=Abbrevia.dll;ProductName=Abbrevia;ProductVersion=5.0;Comments=http://tpabbrevia.sourceforge.net/\n\t\t\n\t\t\n\t\t\tCompanyName=;FileDescription=Abbrevia COM components;FileVersion=5.0;InternalName=;LegalCopyright=Copyright (c) 2011 Abbrevia Group;LegalTrademarks=;OriginalFilename=Abbrevia.dll;ProductName=Abbrevia;ProductVersion=5.0;Comments=http://tpabbrevia.sourceforge.net/\n\t\t\n\t\t\n\t\t\tDEBUG;$(DCC_Define)\n\t\t\tfalse\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\n\t\t\n\t\t\ttrue\n\t\t\tCompanyName=;FileDescription=;FileVersion=5.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=\n\t\t\n\t\t\n\t\t\t\n\t\t\t\tMainSource\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_2\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tBase\n\t\t\t\n\t\t\t\n\t\t\t\tCfg_1\n\t\t\t\tBase\n\t\t\t\n\t\t\n\t\t\n\t\t\tDelphi.Personality.12\n\t\t\t\n\t\t\t\n\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tAbbrevia.dpr\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\t0\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\tFalse\n\t\t\t\t\t\t1033\n\t\t\t\t\t\t1252\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t1.0.0.0\n\t\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\tTrue\n\t\t\t\t\tFalse\n\t\t\t\t\tTrue\n\t\t\t\t\n\t\t\t\t\n\t\t\t\t\t1\n\t\t\t\t\n\t\t\t\n\t\t\t12\n\t\t\n\t\t\n\t\t\n\t\n"
},
{
"path": "lib/abbrevia/source/COM/Abbrevia.ridl",
"content": "// ************************************************************************ //\n// WARNING\n// -------\n// This file is generated by the Type Library importer or Type Libary Editor.\n// Barring syntax errors, the Editor will parse modifications made to the file.\n// However, when applying changes via the Editor this file will be regenerated\n// and comments or formatting changes will be lost.\n// ************************************************************************ //\n// File generated on 12/6/2011 11:22:23 AM (- $Rev: 12980 $, 51698824).\n\n[\n uuid(AF804E20-4043-499E-BB14-237B9F26F89F),\n version(3.0),\n helpstring(\"TurboPower Abbrevia Compression Library v3.03\"),\n helpfile(\"C:\\\\Abbrevia\\\\COM\\\\abrv-com.hlp\"),\n helpcontext(0x00000001)\n\n]\nlibrary Abbrevia\n{\n\n importlib(\"stdole2.tlb\");\n\n interface IZipItem;\n interface IGZipItem;\n interface ITarItem;\n interface IZipKit;\n dispinterface IZipKitEvents;\n coclass ZipItem;\n coclass GZipItem;\n coclass TarItem;\n coclass ZipKit;\n\n\n [\n uuid(6CABD61B-653C-4CEB-807C-C80E8DE8163D),\n version(3.0)\n ]\n enum TArchiveAction\n {\n aaFailed = 0,\n aaNone = 1,\n aaAdd = 2,\n aaDelete = 3,\n aaFreshen = 4,\n aaMove = 5,\n aaStreamAdd = 6\n };\n\n [\n uuid(148F84A1-2B70-4A63-B561-FF0EE49E74B3),\n version(3.0)\n ]\n enum TArchiveStatus\n {\n asInvalid = 0,\n asIdle = 1,\n asBusy = 2\n };\n\n [\n uuid(5D495174-DB09-4C59-A26D-FEBDE3EAE100),\n version(3.0)\n ]\n enum TErrorClass\n {\n eclAbbrevia = 0,\n eclInOutError = 1,\n eclFileError = 2,\n eclFileCreateError = 3,\n eclFileOpenError = 4,\n eclOther = 5\n };\n\n [\n uuid(6A4738B9-69F1-4717-8393-681FF21E8DB7),\n version(3.0)\n ]\n enum TFileAttributes\n {\n faReadOnly = 1,\n faHidden = 2,\n faSysFile = 4,\n faVolumeID = 8,\n faDirectory = 16,\n faArchive = 32\n };\n\n [\n uuid(F77BBE04-0859-4F18-9DEA-B2887C1F6AF7),\n version(3.0)\n ]\n enum TProcessType\n {\n ptAdd = 0,\n ptDelete = 1,\n ptExtract = 2,\n ptFreshen = 3,\n ptMove = 4,\n ptReplace = 5\n };\n\n [\n uuid(D78287A7-65FA-4391-8F5A-C7D3A11E9970),\n version(3.0)\n ]\n enum TStoreOptions\n {\n soStripDrive = 1,\n soStripPath = 2,\n soRemoveDots = 4,\n soRecurse = 8,\n soFreshen = 16,\n soReplace = 32\n };\n\n [\n uuid(192C6697-A38D-4F48-B32B-F33500460E62),\n version(3.0)\n ]\n enum TZipCompressionMethod\n {\n cmStored = 0,\n cmShrunk = 1,\n cmReduced1 = 2,\n cmReduced2 = 3,\n cmReduced3 = 4,\n cmReduced4 = 5,\n cmImploded = 6,\n cmTokenized = 7,\n cmDeflated = 8,\n cmEnhancedDeflated = 9,\n cmDCLImploded = 10,\n cmBestMethod = 11\n };\n\n [\n uuid(800F8CDC-2F0F-4020-BCBB-FEDA82D0EFEF),\n version(3.0)\n ]\n enum TZipDeflateOption\n {\n doInvalid = 0,\n doNormal = 1,\n doMaximum = 2,\n doFast = 3,\n doSuperFast = 4\n };\n\n [\n uuid(D697ED2A-F088-409F-962A-57D8324EEDD6),\n version(3.0)\n ]\n enum TZipDictionarySize\n {\n dsInvalid = 0,\n ds4K = 1,\n ds8K = 2\n };\n\n [\n uuid(B9889806-26F9-47E7-AC1F-906AA161B078),\n version(3.0)\n ]\n enum TZipExtractOptions\n {\n eoCreateDirs = 0,\n eoRestorePath = 1\n };\n\n [\n uuid(D40E0708-AE71-4A44-A6C8-430EDF760DE2),\n version(3.0)\n ]\n enum TZipSupportMethod\n {\n smStored = 0,\n smDeflated = 1,\n smBestMethod = 2\n };\n\n [\n uuid(EFD2C909-BF04-4C54-9ACB-38D872B95C9F),\n version(3.0)\n ]\n enum TErrorCode\n {\n ecDuplicateName = 0,\n ecInvalidPassword = 1,\n ecNoSuchDirectory = 2,\n ecUnknownCompressionMethod = 3,\n ecUserAbort = 4,\n ecZipBadCRC = 5,\n ecZipVersionNumber = 6,\n ecSpannedItemNotFound = 7\n };\n\n [\n uuid(44EB05F9-CED9-46D0-84E2-BD3362977437),\n version(3.0)\n ]\n enum TArchiveType\n {\n atUnknown = 0,\n atZip = 1,\n atSelfExtZip = 2,\n atTar = 3,\n atGZip = 4,\n atGZippedTar = 5,\n atCab = 6\n };\n\n [\n uuid(36568A72-3B4B-41C4-8E34-19931A8EAF63),\n version(3.0)\n ]\n enum TFileSystem\n {\n fsFAT = 0,\n fsAmiga = 1,\n fsVMS = 2,\n fsUnix = 3,\n fsVM_CMS = 4,\n fsAtariTOS = 5,\n fsHPFS = 6,\n fsMacintosh = 7,\n fsZSystem = 8,\n fsCP_M = 9,\n fsTOPS20 = 10,\n fsNTFS = 11,\n fsQDOS = 12,\n fsAcornRISCOS = 13,\n fsUnknown = 14,\n fsUndefined = 15\n };\n\n [\n uuid(851699A1-422A-4C65-8E08-D0499ACDD834),\n version(3.0),\n helpstring(\"Dispatch interface for ZipItem Object\"),\n helpcontext(0x00000005),\n dual,\n oleautomation\n ]\n interface IZipItem: IDispatch\n {\n [propget, id(0x00000001)]\n HRESULT _stdcall Action([out, retval] enum TArchiveAction* Value);\n [propget, id(0x00000002)]\n HRESULT _stdcall CompressedSize([out, retval] long* Value);\n [propget, id(0x00000003)]\n HRESULT _stdcall CRC32([out, retval] long* Value);\n [propget, id(0x00000004)]\n HRESULT _stdcall DiskFileName([out, retval] BSTR* Value);\n [propget, id(0x00000005)]\n HRESULT _stdcall DiskPath([out, retval] BSTR* Value);\n [propget, id(0x00000006)]\n HRESULT _stdcall ExternalFileAttributes([out, retval] enum TFileAttributes* Value);\n [propput, id(0x00000006)]\n HRESULT _stdcall ExternalFileAttributes([in] enum TFileAttributes Value);\n [propget, id(0x00000007)]\n HRESULT _stdcall FileName([out, retval] BSTR* Value);\n [propput, id(0x00000007)]\n HRESULT _stdcall FileName([in] BSTR Value);\n [propget, id(0x00000008)]\n HRESULT _stdcall IsEncrypted([out, retval] VARIANT_BOOL* Value);\n [propget, id(0x00000009)]\n HRESULT _stdcall LastModFileDateTime([out, retval] DATE* Value);\n [propget, id(0x0000000A)]\n HRESULT _stdcall StoredPath([out, retval] BSTR* Value);\n [propget, id(0x0000000B)]\n HRESULT _stdcall Tagged([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x0000000B)]\n HRESULT _stdcall Tagged([in] VARIANT_BOOL Value);\n [propget, id(0x0000000C)]\n HRESULT _stdcall UnCompressedSize([out, retval] long* Value);\n [propget, id(0x0000000D)]\n HRESULT _stdcall CRC32St([out, retval] BSTR* Value);\n [propget, id(0x0000000E)]\n HRESULT _stdcall Password([out, retval] BSTR* Value);\n [propput, id(0x0000000E)]\n HRESULT _stdcall Password([in] BSTR Value);\n [propget, id(0x0000000F)]\n HRESULT _stdcall CompressionMethod([out, retval] enum TZipCompressionMethod* Value);\n [propget, id(0x00000010)]\n HRESULT _stdcall CompressionRatio([out, retval] double* Value);\n [propget, id(0x00000011)]\n HRESULT _stdcall DeflateOption([out, retval] enum TZipDeflateOption* Value);\n [propget, id(0x00000012)]\n HRESULT _stdcall DictionarySize([out, retval] enum TZipDictionarySize* Value);\n [propget, id(0x00000013)]\n HRESULT _stdcall DiskNumberStart([out, retval] long* Value);\n [propget, id(0x00000014)]\n HRESULT _stdcall ExtraField([out, retval] BSTR* Value);\n [propput, id(0x00000014)]\n HRESULT _stdcall ExtraField([in] BSTR Value);\n [propget, id(0x00000015)]\n HRESULT _stdcall FileComment([out, retval] BSTR* Value);\n [propput, id(0x00000015)]\n HRESULT _stdcall FileComment([in] BSTR Value);\n [propget, id(0x00000016)]\n HRESULT _stdcall InternalFileAttributes([out, retval] long* Value);\n [propput, id(0x00000016)]\n HRESULT _stdcall InternalFileAttributes([in] long Value);\n [propget, id(0x00000017)]\n HRESULT _stdcall VersionMadeBy([out, retval] long* Value);\n [propget, id(0x00000018)]\n HRESULT _stdcall VersionNeededToExtract([out, retval] long* Value);\n };\n\n [\n uuid(8FA78CE0-FD29-441E-9777-93B63EF1A9EE),\n version(3.0),\n dual,\n oleautomation\n ]\n interface IGZipItem: IDispatch\n {\n [propget, id(0x00000001)]\n HRESULT _stdcall Action([out, retval] enum TArchiveAction* Value);\n [propget, id(0x00000002)]\n HRESULT _stdcall CompressedSize([out, retval] long* Value);\n [propget, id(0x00000003)]\n HRESULT _stdcall CRC32([out, retval] long* Value);\n [propget, id(0x00000004)]\n HRESULT _stdcall DiskFileName([out, retval] BSTR* Value);\n [propget, id(0x00000005)]\n HRESULT _stdcall DiskPath([out, retval] BSTR* Value);\n [propget, id(0x00000006)]\n HRESULT _stdcall ExternalFileAttributes([out, retval] enum TFileAttributes* Value);\n [propput, id(0x00000006)]\n HRESULT _stdcall ExternalFileAttributes([in] enum TFileAttributes Value);\n [propget, id(0x00000007)]\n HRESULT _stdcall FileName([out, retval] BSTR* Value);\n [propput, id(0x00000007)]\n HRESULT _stdcall FileName([in] BSTR Value);\n [propget, id(0x00000008)]\n HRESULT _stdcall IsEncrypted([out, retval] VARIANT_BOOL* Value);\n [propget, id(0x00000009)]\n HRESULT _stdcall LastModFileDateTime([out, retval] DATE* Value);\n [propget, id(0x0000000A)]\n HRESULT _stdcall StoredPath([out, retval] BSTR* Value);\n [propget, id(0x0000000B)]\n HRESULT _stdcall Tagged([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x0000000B)]\n HRESULT _stdcall Tagged([in] VARIANT_BOOL Value);\n [propget, id(0x0000000C)]\n HRESULT _stdcall UnCompressedSize([out, retval] long* Value);\n [propget, id(0x0000000D)]\n HRESULT _stdcall CRC32St([out, retval] BSTR* Value);\n [propget, id(0x0000000E)]\n HRESULT _stdcall Password([out, retval] BSTR* Value);\n [propput, id(0x0000000E)]\n HRESULT _stdcall Password([in] BSTR Value);\n [propget, id(0x0000000F)]\n HRESULT _stdcall CompressionMethod([out, retval] unsigned char* Value);\n [propput, id(0x0000000F)]\n HRESULT _stdcall CompressionMethod([in] unsigned char Value);\n [propget, id(0x00000010)]\n HRESULT _stdcall ExtraField([out, retval] BSTR* Value);\n [propput, id(0x00000010)]\n HRESULT _stdcall ExtraField([in] BSTR Value);\n [propget, id(0x00000011)]\n HRESULT _stdcall ExtraFlags([out, retval] unsigned char* Value);\n [propput, id(0x00000011)]\n HRESULT _stdcall ExtraFlags([in] unsigned char Value);\n [propget, id(0x00000012)]\n HRESULT _stdcall FileComment([out, retval] BSTR* Value);\n [propput, id(0x00000012)]\n HRESULT _stdcall FileComment([in] BSTR Value);\n [propget, id(0x00000013)]\n HRESULT _stdcall FileSystem([out, retval] enum TFileSystem* Value);\n [propput, id(0x00000013)]\n HRESULT _stdcall FileSystem([in] enum TFileSystem Value);\n [propget, id(0x00000014)]\n HRESULT _stdcall Flags([out, retval] unsigned char* Value);\n [propput, id(0x00000014)]\n HRESULT _stdcall Flags([in] unsigned char Value);\n [propget, id(0x00000015)]\n HRESULT _stdcall HeaderCRC([out, retval] long* Value);\n };\n\n [\n uuid(729E9F52-C489-4A41-A770-4E2C5282AE39),\n version(3.0),\n dual,\n oleautomation\n ]\n interface ITarItem: IDispatch\n {\n [propget, id(0x00000001)]\n HRESULT _stdcall Action([out, retval] enum TArchiveAction* Value);\n [propget, id(0x00000002)]\n HRESULT _stdcall CompressedSize([out, retval] long* Value);\n [propget, id(0x00000003)]\n HRESULT _stdcall CRC32([out, retval] long* Value);\n [propget, id(0x00000004)]\n HRESULT _stdcall DiskFileName([out, retval] BSTR* Value);\n [propget, id(0x00000005)]\n HRESULT _stdcall DiskPath([out, retval] BSTR* Value);\n [propget, id(0x00000006)]\n HRESULT _stdcall ExternalFileAttributes([out, retval] enum TFileAttributes* Value);\n [propput, id(0x00000006)]\n HRESULT _stdcall ExternalFileAttributes([in] enum TFileAttributes Value);\n [propget, id(0x00000007)]\n HRESULT _stdcall FileName([out, retval] BSTR* Value);\n [propput, id(0x00000007)]\n HRESULT _stdcall FileName([in] BSTR Value);\n [propget, id(0x00000008)]\n HRESULT _stdcall IsEncrypted([out, retval] VARIANT_BOOL* Value);\n [propget, id(0x00000009)]\n HRESULT _stdcall LastModFileDateTime([out, retval] DATE* Value);\n [propget, id(0x0000000A)]\n HRESULT _stdcall StoredPath([out, retval] BSTR* Value);\n [propget, id(0x0000000B)]\n HRESULT _stdcall Tagged([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x0000000B)]\n HRESULT _stdcall Tagged([in] VARIANT_BOOL Value);\n [propget, id(0x0000000C)]\n HRESULT _stdcall UnCompressedSize([out, retval] long* Value);\n [propget, id(0x0000000D)]\n HRESULT _stdcall CRC32St([out, retval] BSTR* Value);\n [propget, id(0x0000000E)]\n HRESULT _stdcall Password([out, retval] BSTR* Value);\n [propput, id(0x0000000E)]\n HRESULT _stdcall Password([in] BSTR Value);\n [propget, id(0x0000000F)]\n HRESULT _stdcall DevMajor([out, retval] long* Value);\n [propput, id(0x0000000F)]\n HRESULT _stdcall DevMajor([in] long Value);\n [propget, id(0x00000010)]\n HRESULT _stdcall DevMinor([out, retval] long* Value);\n [propput, id(0x00000010)]\n HRESULT _stdcall DevMinor([in] long Value);\n [propget, id(0x00000011)]\n HRESULT _stdcall GroupID([out, retval] long* Value);\n [propput, id(0x00000011)]\n HRESULT _stdcall GroupID([in] long Value);\n [propget, id(0x00000012)]\n HRESULT _stdcall GroupName([out, retval] BSTR* Value);\n [propput, id(0x00000012)]\n HRESULT _stdcall GroupName([in] BSTR Value);\n [propget, id(0x00000013)]\n HRESULT _stdcall LinkFlag([out, retval] unsigned char* Value);\n [propput, id(0x00000013)]\n HRESULT _stdcall LinkFlag([in] unsigned char Value);\n [propget, id(0x00000014)]\n HRESULT _stdcall LinkName([out, retval] BSTR* Value);\n [propput, id(0x00000014)]\n HRESULT _stdcall LinkName([in] BSTR Value);\n [propget, id(0x00000015)]\n HRESULT _stdcall Mode([out, retval] long* Value);\n [propput, id(0x00000015)]\n HRESULT _stdcall Mode([in] long Value);\n [propget, id(0x00000016)]\n HRESULT _stdcall UserID([out, retval] long* Value);\n [propput, id(0x00000016)]\n HRESULT _stdcall UserID([in] long Value);\n [propget, id(0x00000017)]\n HRESULT _stdcall UserName([out, retval] BSTR* Value);\n [propput, id(0x00000017)]\n HRESULT _stdcall UserName([in] BSTR Value);\n };\n\n [\n uuid(B7480A7F-4E27-4B45-9FE6-224B60295A0C),\n version(3.0),\n helpstring(\"Dispatch interface for ZipKit Object\"),\n helpcontext(0x00000006),\n dual,\n oleautomation\n ]\n interface IZipKit: IDispatch\n {\n [id(0x00000001)]\n HRESULT _stdcall Add([in] BSTR FileMask, [in] BSTR ExclusionMask, [in] long SearchAttr);\n [id(0x00000007)]\n HRESULT _stdcall AddFromStream([in] BSTR FileName, [in] VARIANT Stream);\n [propget, id(0x00000003)]\n HRESULT _stdcall AutoSave([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x00000003)]\n HRESULT _stdcall AutoSave([in] VARIANT_BOOL Value);\n [propget, id(0x00000004)]\n HRESULT _stdcall BaseDirectory([out, retval] BSTR* Value);\n [propput, id(0x00000004)]\n HRESULT _stdcall BaseDirectory([in] BSTR Value);\n [id(0x00000005)]\n HRESULT _stdcall ClearTags(void);\n [propget, id(0x00000006)]\n HRESULT _stdcall CompressionMethodToUse([out, retval] enum TZipSupportMethod* Value);\n [propput, id(0x00000006)]\n HRESULT _stdcall CompressionMethodToUse([in] enum TZipSupportMethod Value);\n [propget, id(0x00000002)]\n HRESULT _stdcall Count([out, retval] long* Value);\n [propget, id(0x00000008)]\n HRESULT _stdcall DeflateOption([out, retval] enum TZipDeflateOption* Value);\n [propput, id(0x00000008)]\n HRESULT _stdcall DeflateOption([in] enum TZipDeflateOption Value);\n [id(0x00000009)]\n HRESULT _stdcall Delete([in] BSTR FileMask, [in] BSTR ExclusionMask);\n [id(0x0000000A)]\n HRESULT _stdcall DeleteAt([in] long Index);\n [id(0x0000000B)]\n HRESULT _stdcall DeleteTaggedItems(void);\n [propget, id(0x0000000C)]\n HRESULT _stdcall DOSMode([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x0000000C)]\n HRESULT _stdcall DOSMode([in] VARIANT_BOOL Value);\n [id(0x0000000D)]\n HRESULT _stdcall Extract([in] BSTR FileMask, [in] BSTR ExclusionMask);\n [id(0x0000000E)]\n HRESULT _stdcall ExtractAt([in] long Index, [in] BSTR NewName);\n [propget, id(0x0000000F)]\n HRESULT _stdcall ExtractOptions([out, retval] enum TZipExtractOptions* Value);\n [propput, id(0x0000000F)]\n HRESULT _stdcall ExtractOptions([in] enum TZipExtractOptions Value);\n [id(0x00000010)]\n HRESULT _stdcall ExtractTaggedItems(void);\n [propget, id(0x00000011)]\n HRESULT _stdcall FileName([out, retval] BSTR* Value);\n [propput, id(0x00000011)]\n HRESULT _stdcall FileName([in] BSTR Value);\n [id(0x00000012)]\n HRESULT _stdcall Find([in] BSTR FileName, [out, retval] long* Value);\n [id(0x00000013)]\n HRESULT _stdcall Freshen([in] BSTR FileMask, [in] BSTR ExclusionMask);\n [id(0x00000014)]\n HRESULT _stdcall FreshenTaggedItems(void);\n [propget, id(0x00000000)]\n HRESULT _stdcall Item([in] long Index, [out, retval] IDispatch** Value);\n [propget, id(0x00000017)]\n HRESULT _stdcall LogFile([out, retval] BSTR* Value);\n [propput, id(0x00000017)]\n HRESULT _stdcall LogFile([in] BSTR Value);\n [propget, id(0x00000018)]\n HRESULT _stdcall Logging([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x00000018)]\n HRESULT _stdcall Logging([in] VARIANT_BOOL Value);\n [propget, id(0x00000019)]\n HRESULT _stdcall Password([out, retval] BSTR* Value);\n [propput, id(0x00000019)]\n HRESULT _stdcall Password([in] BSTR Value);\n [propget, id(0x0000001A)]\n HRESULT _stdcall PasswordRetries([out, retval] unsigned char* Value);\n [propput, id(0x0000001A)]\n HRESULT _stdcall PasswordRetries([in] unsigned char Value);\n [id(0x0000001B)]\n HRESULT _stdcall Replace([in] BSTR FileMask);\n [id(0x0000001C)]\n HRESULT _stdcall Save(void);\n [propget, id(0x0000001D)]\n HRESULT _stdcall Spanned([out, retval] VARIANT_BOOL* Value);\n [propget, id(0x0000001E)]\n HRESULT _stdcall SpanningThreshold([out, retval] long* Value);\n [propput, id(0x0000001E)]\n HRESULT _stdcall SpanningThreshold([in] long Value);\n [propget, id(0x0000001F)]\n HRESULT _stdcall Status([out, retval] enum TArchiveStatus* Value);\n [propget, id(0x00000020)]\n HRESULT _stdcall StoreOptions([out, retval] enum TStoreOptions* Value);\n [propput, id(0x00000020)]\n HRESULT _stdcall StoreOptions([in] enum TStoreOptions Value);\n [id(0x00000021)]\n HRESULT _stdcall TagItems([in] BSTR FileMask);\n [propget, id(0x00000022)]\n HRESULT _stdcall TempDirectory([out, retval] BSTR* Value);\n [propput, id(0x00000022)]\n HRESULT _stdcall TempDirectory([in] BSTR Value);\n [id(0x00000023)]\n HRESULT _stdcall TestTaggedItems(void);\n [id(0x00000024)]\n HRESULT _stdcall UntagItems([in] BSTR FileMask);\n [propget, id(0x00000025)]\n HRESULT _stdcall ZipFileComment([out, retval] BSTR* Value);\n [propput, id(0x00000025)]\n HRESULT _stdcall ZipFileComment([in] BSTR Value);\n [id(0x00000026)]\n HRESULT _stdcall License([in] BSTR Key, [out, retval] VARIANT_BOOL* Value);\n [propget, id(0xFFFFFFFC), restricted, hidden]\n HRESULT _stdcall _NewEnum([out, retval] IUnknown** Value);\n [id(0x00000015)]\n HRESULT _stdcall ExtractToStream([in] BSTR FileName, [out, retval] VARIANT* Value);\n [propget, id(0x00000028)]\n HRESULT _stdcall CompressionType([out, retval] enum TArchiveType* Value);\n [propput, id(0x00000028)]\n HRESULT _stdcall CompressionType([in] enum TArchiveType Value);\n [propget, id(0x00000029)]\n HRESULT _stdcall TarAutoHandle([out, retval] VARIANT_BOOL* Value);\n [propput, id(0x00000029)]\n HRESULT _stdcall TarAutoHandle([in] VARIANT_BOOL Value);\n };\n\n [\n uuid(F094D5F4-3A52-45AE-9D86-4409611DD29E),\n version(3.0),\n helpstring(\"Events interface for ZipKit Object\")\n ]\n dispinterface IZipKitEvents\n {\n properties:\n methods:\n [id(0x00000001)]\n void OnArchiveItemProgress([in] IDispatch* Item, [in] unsigned char Progress, [in, out] VARIANT_BOOL* Abort);\n [id(0x00000002)]\n void OnArchiveProgress([in] unsigned char Progress, [in, out] VARIANT_BOOL* Abort);\n [id(0x00000003)]\n void OnChange(void);\n [id(0x00000004)]\n void OnConfirmOverwrite([in, out] BSTR* Name, [in, out] VARIANT_BOOL* Confirm);\n [id(0x00000005)]\n void OnConfirmProcessItem([in] IDispatch* Item, [in] enum TProcessType ProcessType, [in, out] VARIANT_BOOL* Confirm);\n [id(0x00000006)]\n void OnConfirmSave([in, out] VARIANT_BOOL* Confirm);\n [id(0x00000007)]\n void OnLoad(void);\n [id(0x00000008)]\n void OnNeedPassword([in, out] BSTR* NewPassword);\n [id(0x00000009)]\n void OnProcessItemFailure([in] IDispatch* Item, [in] enum TProcessType ProcessType, [in] enum TErrorClass ErrorClass, [in] enum TErrorCode ErrorCode, [in] BSTR ErrorString);\n [id(0x0000000A)]\n void OnRequestBlankDisk([in, out] VARIANT_BOOL* Abort);\n [id(0x0000000B)]\n void OnRequestImage([in] long ImageNumber, [in, out] BSTR* ImageName, [in, out] VARIANT_BOOL* Abort);\n [id(0x0000000C)]\n void OnRequestLastDisk([in, out] VARIANT_BOOL* Abort);\n [id(0x0000000D)]\n void OnRequestNthDisk([in] long DiskNumber, [in, out] VARIANT_BOOL* Abort);\n [id(0x0000000E)]\n void OnSave(void);\n };\n\n [\n uuid(650989D8-F0FF-4C71-83C3-92556F4329F5),\n version(3.0)\n ]\n coclass ZipItem\n {\n [default] interface IZipItem;\n };\n\n [\n uuid(2B35BB50-D9C7-4669-B18E-943B5199FD8E),\n version(3.0)\n ]\n coclass GZipItem\n {\n [default] interface IGZipItem;\n };\n\n [\n uuid(2DF3E624-0E6C-42CF-8041-676B9A06375E),\n version(3.0)\n ]\n coclass TarItem\n {\n [default] interface ITarItem;\n };\n\n [\n uuid(730B4B32-9127-492A-BF02-196A7E6B4E1B),\n version(3.0),\n helpstring(\"ZipKit Object\"),\n helpcontext(0x00000006)\n ]\n coclass ZipKit\n {\n [default] interface IZipKit;\n [default, source] dispinterface IZipKitEvents;\n };\n\n};\n"
},
{
"path": "lib/abbrevia/source/COM/Abbrevia_TLB.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit Abbrevia_TLB;\n\n// ************************************************************************ //\n// WARNING \n// ------- \n// The types declared in this file were generated from data read from a \n// Type Library. If this type library is explicitly or indirectly (via \n// another type library referring to this type library) re-imported, or the \n// 'Refresh' command of the Type Library Editor activated while editing the \n// Type Library, the contents of this file will be regenerated and all \n// manual modifications will be lost. \n// ************************************************************************ //\n\n// $Rev: 491 $\n// File generated on 7/23/2009 9:45:45 PM from Type Library described below.\n\n// ************************************************************************ //\n// Type Lib: C:\\Abbrevia\\COM\\abbrevia.dll\n// LIBID: {AF804E20-4043-499E-BB14-237B9F26F89F}\n// LCID: 0\n// Helpfile: C:\\Abbrevia\\COM\\abrv-com.hlp\n// HelpString: TurboPower Abbrevia Compression Library v3.03\n// DepndLst: \n// (1) v2.0 stdole, (C:\\WINDOWS\\System32\\stdole2.tlb)\n// ************************************************************************ //\n{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. \n{$WARN SYMBOL_PLATFORM OFF}\n{$WRITEABLECONST ON}\n{$VARPROPSETTER ON}\ninterface\n\nuses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;\n \n\n// *********************************************************************//\n// GUIDS declared in the TypeLibrary. Following prefixes are used: \n// Type Libraries : LIBID_xxxx \n// CoClasses : CLASS_xxxx \n// DISPInterfaces : DIID_xxxx \n// Non-DISP interfaces: IID_xxxx \n// *********************************************************************//\nconst\n // TypeLibrary Major and minor versions\n AbbreviaMajorVersion = 5;\n AbbreviaMinorVersion = 0;\n\n LIBID_Abbrevia: TGUID = '{AF804E20-4043-499E-BB14-237B9F26F89F}';\n\n IID_IZipItem: TGUID = '{851699A1-422A-4C65-8E08-D0499ACDD834}';\n IID_IGZipItem: TGUID = '{8FA78CE0-FD29-441E-9777-93B63EF1A9EE}';\n IID_ITarItem: TGUID = '{729E9F52-C489-4A41-A770-4E2C5282AE39}';\n IID_IZipKit: TGUID = '{B7480A7F-4E27-4B45-9FE6-224B60295A0C}';\n DIID_IZipKitEvents: TGUID = '{F094D5F4-3A52-45AE-9D86-4409611DD29E}';\n CLASS_ZipItem: TGUID = '{650989D8-F0FF-4C71-83C3-92556F4329F5}';\n CLASS_GZipItem: TGUID = '{2B35BB50-D9C7-4669-B18E-943B5199FD8E}';\n CLASS_TarItem: TGUID = '{2DF3E624-0E6C-42CF-8041-676B9A06375E}';\n CLASS_ZipKit: TGUID = '{730B4B32-9127-492A-BF02-196A7E6B4E1B}';\n\n// *********************************************************************//\n// Declaration of Enumerations defined in Type Library \n// *********************************************************************//\n// Constants for enum TArchiveAction\ntype\n TArchiveAction = TOleEnum;\nconst\n aaFailed = $00000000;\n aaNone = $00000001;\n aaAdd = $00000002;\n aaDelete = $00000003;\n aaFreshen = $00000004;\n aaMove = $00000005;\n aaStreamAdd = $00000006;\n\n// Constants for enum TArchiveStatus\ntype\n TArchiveStatus = TOleEnum;\nconst\n asInvalid = $00000000;\n asIdle = $00000001;\n asBusy = $00000002;\n\n// Constants for enum TErrorClass\ntype\n TErrorClass = TOleEnum;\nconst\n eclAbbrevia = $00000000;\n eclInOutError = $00000001;\n eclFileError = $00000002;\n eclFileCreateError = $00000003;\n eclFileOpenError = $00000004;\n eclOther = $00000005;\n\n// Constants for enum TFileAttributes\ntype\n TFileAttributes = TOleEnum;\nconst\n faReadOnly = $00000001;\n faHidden = $00000002;\n faSysFile = $00000004;\n faVolumeID = $00000008;\n faDirectory = $00000010;\n faArchive = $00000020;\n\n// Constants for enum TProcessType\ntype\n TProcessType = TOleEnum;\nconst\n ptAdd = $00000000;\n ptDelete = $00000001;\n ptExtract = $00000002;\n ptFreshen = $00000003;\n ptMove = $00000004;\n ptReplace = $00000005;\n\n// Constants for enum TStoreOptions\ntype\n TStoreOptions = TOleEnum;\nconst\n soStripDrive = $00000001;\n soStripPath = $00000002;\n soRemoveDots = $00000004;\n soRecurse = $00000008;\n soFreshen = $00000010;\n soReplace = $00000020;\n\n// Constants for enum TZipCompressionMethod\ntype\n TZipCompressionMethod = TOleEnum;\nconst\n cmStored = $00000000;\n cmShrunk = $00000001;\n cmReduced1 = $00000002;\n cmReduced2 = $00000003;\n cmReduced3 = $00000004;\n cmReduced4 = $00000005;\n cmImploded = $00000006;\n cmTokenized = $00000007;\n cmDeflated = $00000008;\n cmEnhancedDeflated = $00000009;\n cmDCLImploded = $0000000A;\n cmBestMethod = $0000000B;\n\n// Constants for enum TZipDeflateOption\ntype\n TZipDeflateOption = TOleEnum;\nconst\n doInvalid = $00000000;\n doNormal = $00000001;\n doMaximum = $00000002;\n doFast = $00000003;\n doSuperFast = $00000004;\n\n// Constants for enum TZipDictionarySize\ntype\n TZipDictionarySize = TOleEnum;\nconst\n dsInvalid = $00000000;\n ds4K = $00000001;\n ds8K = $00000002;\n\n// Constants for enum TZipExtractOptions\ntype\n TZipExtractOptions = TOleEnum;\nconst\n eoCreateDirs = $00000000;\n eoRestorePath = $00000001;\n\n// Constants for enum TZipSupportMethod\ntype\n TZipSupportMethod = TOleEnum;\nconst\n smStored = $00000000;\n smDeflated = $00000001;\n smBestMethod = $00000002;\n\n// Constants for enum TErrorCode\ntype\n TErrorCode = TOleEnum;\nconst\n ecDuplicateName = $00000000;\n ecInvalidPassword = $00000001;\n ecNoSuchDirectory = $00000002;\n ecUnknownCompressionMethod = $00000003;\n ecUserAbort = $00000004;\n ecZipBadCRC = $00000005;\n ecZipVersionNumber = $00000006;\n ecSpannedItemNotFound = $00000007;\n\n// Constants for enum TArchiveType\ntype\n TArchiveType = TOleEnum;\nconst\n atUnknown = $00000000;\n atZip = $00000001;\n atSelfExtZip = $00000002;\n atTar = $00000003;\n atGZip = $00000004;\n atGZippedTar = $00000005;\n atCab = $00000006;\n\n// Constants for enum TFileSystem\ntype\n TFileSystem = TOleEnum;\nconst\n fsFAT = $00000000;\n fsAmiga = $00000001;\n fsVMS = $00000002;\n fsUnix = $00000003;\n fsVM_CMS = $00000004;\n fsAtariTOS = $00000005;\n fsHPFS = $00000006;\n fsMacintosh = $00000007;\n fsZSystem = $00000008;\n fsCP_M = $00000009;\n fsTOPS20 = $0000000A;\n fsNTFS = $0000000B;\n fsQDOS = $0000000C;\n fsAcornRISCOS = $0000000D;\n fsUnknown = $0000000E;\n fsUndefined = $0000000F;\n\ntype\n\n// *********************************************************************//\n// Forward declaration of types defined in TypeLibrary \n// *********************************************************************//\n IZipItem = interface;\n IZipItemDisp = dispinterface;\n IGZipItem = interface;\n IGZipItemDisp = dispinterface;\n ITarItem = interface;\n ITarItemDisp = dispinterface;\n IZipKit = interface;\n IZipKitDisp = dispinterface;\n IZipKitEvents = dispinterface;\n\n// *********************************************************************//\n// Declaration of CoClasses defined in Type Library \n// (NOTE: Here we map each CoClass to its Default Interface) \n// *********************************************************************//\n ZipItem = IZipItem;\n GZipItem = IGZipItem;\n TarItem = ITarItem;\n ZipKit = IZipKit;\n\n\n// *********************************************************************//\n// Interface: IZipItem\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {851699A1-422A-4C65-8E08-D0499ACDD834}\n// *********************************************************************//\n IZipItem = interface(IDispatch)\n ['{851699A1-422A-4C65-8E08-D0499ACDD834}']\n function Get_Action: TArchiveAction; safecall;\n function Get_CompressedSize: Integer; safecall;\n function Get_CRC32: Integer; safecall;\n function Get_DiskFileName: WideString; safecall;\n function Get_DiskPath: WideString; safecall;\n function Get_ExternalFileAttributes: TFileAttributes; safecall;\n procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Get_IsEncrypted: WordBool; safecall;\n function Get_LastModFileDateTime: TDateTime; safecall;\n function Get_StoredPath: WideString; safecall;\n function Get_Tagged: WordBool; safecall;\n procedure Set_Tagged(Value: WordBool); safecall;\n function Get_UnCompressedSize: Integer; safecall;\n function Get_CRC32St: WideString; safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n function Get_CompressionMethod: TZipCompressionMethod; safecall;\n function Get_CompressionRatio: Double; safecall;\n function Get_DeflateOption: TZipDeflateOption; safecall;\n function Get_DictionarySize: TZipDictionarySize; safecall;\n function Get_DiskNumberStart: Integer; safecall;\n function Get_ExtraField: WideString; safecall;\n procedure Set_ExtraField(const Value: WideString); safecall;\n function Get_FileComment: WideString; safecall;\n procedure Set_FileComment(const Value: WideString); safecall;\n function Get_InternalFileAttributes: Integer; safecall;\n procedure Set_InternalFileAttributes(Value: Integer); safecall;\n function Get_VersionMadeBy: Integer; safecall;\n function Get_VersionNeededToExtract: Integer; safecall;\n property Action: TArchiveAction read Get_Action;\n property CompressedSize: Integer read Get_CompressedSize;\n property CRC32: Integer read Get_CRC32;\n property DiskFileName: WideString read Get_DiskFileName;\n property DiskPath: WideString read Get_DiskPath;\n property ExternalFileAttributes: TFileAttributes read Get_ExternalFileAttributes write Set_ExternalFileAttributes;\n property FileName: WideString read Get_FileName write Set_FileName;\n property IsEncrypted: WordBool read Get_IsEncrypted;\n property LastModFileDateTime: TDateTime read Get_LastModFileDateTime;\n property StoredPath: WideString read Get_StoredPath;\n property Tagged: WordBool read Get_Tagged write Set_Tagged;\n property UnCompressedSize: Integer read Get_UnCompressedSize;\n property CRC32St: WideString read Get_CRC32St;\n property Password: WideString read Get_Password write Set_Password;\n property CompressionMethod: TZipCompressionMethod read Get_CompressionMethod;\n property CompressionRatio: Double read Get_CompressionRatio;\n property DeflateOption: TZipDeflateOption read Get_DeflateOption;\n property DictionarySize: TZipDictionarySize read Get_DictionarySize;\n property DiskNumberStart: Integer read Get_DiskNumberStart;\n property ExtraField: WideString read Get_ExtraField write Set_ExtraField;\n property FileComment: WideString read Get_FileComment write Set_FileComment;\n property InternalFileAttributes: Integer read Get_InternalFileAttributes write Set_InternalFileAttributes;\n property VersionMadeBy: Integer read Get_VersionMadeBy;\n property VersionNeededToExtract: Integer read Get_VersionNeededToExtract;\n end;\n\n// *********************************************************************//\n// DispIntf: IZipItemDisp\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {851699A1-422A-4C65-8E08-D0499ACDD834}\n// *********************************************************************//\n IZipItemDisp = dispinterface\n ['{851699A1-422A-4C65-8E08-D0499ACDD834}']\n property Action: TArchiveAction readonly dispid 1;\n property CompressedSize: Integer readonly dispid 2;\n property CRC32: Integer readonly dispid 3;\n property DiskFileName: WideString readonly dispid 4;\n property DiskPath: WideString readonly dispid 5;\n property ExternalFileAttributes: TFileAttributes dispid 6;\n property FileName: WideString dispid 7;\n property IsEncrypted: WordBool readonly dispid 8;\n property LastModFileDateTime: TDateTime readonly dispid 9;\n property StoredPath: WideString readonly dispid 10;\n property Tagged: WordBool dispid 11;\n property UnCompressedSize: Integer readonly dispid 12;\n property CRC32St: WideString readonly dispid 13;\n property Password: WideString dispid 14;\n property CompressionMethod: TZipCompressionMethod readonly dispid 15;\n property CompressionRatio: Double readonly dispid 16;\n property DeflateOption: TZipDeflateOption readonly dispid 17;\n property DictionarySize: TZipDictionarySize readonly dispid 18;\n property DiskNumberStart: Integer readonly dispid 19;\n property ExtraField: WideString dispid 20;\n property FileComment: WideString dispid 21;\n property InternalFileAttributes: Integer dispid 22;\n property VersionMadeBy: Integer readonly dispid 23;\n property VersionNeededToExtract: Integer readonly dispid 24;\n end;\n\n// *********************************************************************//\n// Interface: IGZipItem\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {8FA78CE0-FD29-441E-9777-93B63EF1A9EE}\n// *********************************************************************//\n IGZipItem = interface(IDispatch)\n ['{8FA78CE0-FD29-441E-9777-93B63EF1A9EE}']\n function Get_Action: TArchiveAction; safecall;\n function Get_CompressedSize: Integer; safecall;\n function Get_CRC32: Integer; safecall;\n function Get_DiskFileName: WideString; safecall;\n function Get_DiskPath: WideString; safecall;\n function Get_ExternalFileAttributes: TFileAttributes; safecall;\n procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Get_IsEncrypted: WordBool; safecall;\n function Get_LastModFileDateTime: TDateTime; safecall;\n function Get_StoredPath: WideString; safecall;\n function Get_Tagged: WordBool; safecall;\n procedure Set_Tagged(Value: WordBool); safecall;\n function Get_UnCompressedSize: Integer; safecall;\n function Get_CRC32St: WideString; safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n function Get_CompressionMethod: Byte; safecall;\n procedure Set_CompressionMethod(Value: Byte); safecall;\n function Get_ExtraField: WideString; safecall;\n procedure Set_ExtraField(const Value: WideString); safecall;\n function Get_ExtraFlags: Byte; safecall;\n procedure Set_ExtraFlags(Value: Byte); safecall;\n function Get_FileComment: WideString; safecall;\n procedure Set_FileComment(const Value: WideString); safecall;\n function Get_FileSystem: TFileSystem; safecall;\n procedure Set_FileSystem(Value: TFileSystem); safecall;\n function Get_Flags: Byte; safecall;\n procedure Set_Flags(Value: Byte); safecall;\n function Get_HeaderCRC: Integer; safecall;\n property Action: TArchiveAction read Get_Action;\n property CompressedSize: Integer read Get_CompressedSize;\n property CRC32: Integer read Get_CRC32;\n property DiskFileName: WideString read Get_DiskFileName;\n property DiskPath: WideString read Get_DiskPath;\n property ExternalFileAttributes: TFileAttributes read Get_ExternalFileAttributes write Set_ExternalFileAttributes;\n property FileName: WideString read Get_FileName write Set_FileName;\n property IsEncrypted: WordBool read Get_IsEncrypted;\n property LastModFileDateTime: TDateTime read Get_LastModFileDateTime;\n property StoredPath: WideString read Get_StoredPath;\n property Tagged: WordBool read Get_Tagged write Set_Tagged;\n property UnCompressedSize: Integer read Get_UnCompressedSize;\n property CRC32St: WideString read Get_CRC32St;\n property Password: WideString read Get_Password write Set_Password;\n property CompressionMethod: Byte read Get_CompressionMethod write Set_CompressionMethod;\n property ExtraField: WideString read Get_ExtraField write Set_ExtraField;\n property ExtraFlags: Byte read Get_ExtraFlags write Set_ExtraFlags;\n property FileComment: WideString read Get_FileComment write Set_FileComment;\n property FileSystem: TFileSystem read Get_FileSystem write Set_FileSystem;\n property Flags: Byte read Get_Flags write Set_Flags;\n property HeaderCRC: Integer read Get_HeaderCRC;\n end;\n\n// *********************************************************************//\n// DispIntf: IGZipItemDisp\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {8FA78CE0-FD29-441E-9777-93B63EF1A9EE}\n// *********************************************************************//\n IGZipItemDisp = dispinterface\n ['{8FA78CE0-FD29-441E-9777-93B63EF1A9EE}']\n property Action: TArchiveAction readonly dispid 1;\n property CompressedSize: Integer readonly dispid 2;\n property CRC32: Integer readonly dispid 3;\n property DiskFileName: WideString readonly dispid 4;\n property DiskPath: WideString readonly dispid 5;\n property ExternalFileAttributes: TFileAttributes dispid 6;\n property FileName: WideString dispid 7;\n property IsEncrypted: WordBool readonly dispid 8;\n property LastModFileDateTime: TDateTime readonly dispid 9;\n property StoredPath: WideString readonly dispid 10;\n property Tagged: WordBool dispid 11;\n property UnCompressedSize: Integer readonly dispid 12;\n property CRC32St: WideString readonly dispid 13;\n property Password: WideString dispid 14;\n property CompressionMethod: Byte dispid 15;\n property ExtraField: WideString dispid 16;\n property ExtraFlags: Byte dispid 17;\n property FileComment: WideString dispid 18;\n property FileSystem: TFileSystem dispid 19;\n property Flags: Byte dispid 20;\n property HeaderCRC: Integer readonly dispid 21;\n end;\n\n// *********************************************************************//\n// Interface: ITarItem\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {729E9F52-C489-4A41-A770-4E2C5282AE39}\n// *********************************************************************//\n ITarItem = interface(IDispatch)\n ['{729E9F52-C489-4A41-A770-4E2C5282AE39}']\n function Get_Action: TArchiveAction; safecall;\n function Get_CompressedSize: Integer; safecall;\n function Get_CRC32: Integer; safecall;\n function Get_DiskFileName: WideString; safecall;\n function Get_DiskPath: WideString; safecall;\n function Get_ExternalFileAttributes: TFileAttributes; safecall;\n procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Get_IsEncrypted: WordBool; safecall;\n function Get_LastModFileDateTime: TDateTime; safecall;\n function Get_StoredPath: WideString; safecall;\n function Get_Tagged: WordBool; safecall;\n procedure Set_Tagged(Value: WordBool); safecall;\n function Get_UnCompressedSize: Integer; safecall;\n function Get_CRC32St: WideString; safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n function Get_DevMajor: Integer; safecall;\n procedure Set_DevMajor(Value: Integer); safecall;\n function Get_DevMinor: Integer; safecall;\n procedure Set_DevMinor(Value: Integer); safecall;\n function Get_GroupID: Integer; safecall;\n procedure Set_GroupID(Value: Integer); safecall;\n function Get_GroupName: WideString; safecall;\n procedure Set_GroupName(const Value: WideString); safecall;\n function Get_LinkFlag: Byte; safecall;\n procedure Set_LinkFlag(Value: Byte); safecall;\n function Get_LinkName: WideString; safecall;\n procedure Set_LinkName(const Value: WideString); safecall;\n function Get_Mode: Integer; safecall;\n procedure Set_Mode(Value: Integer); safecall;\n function Get_UserID: Integer; safecall;\n procedure Set_UserID(Value: Integer); safecall;\n function Get_UserName: WideString; safecall;\n procedure Set_UserName(const Value: WideString); safecall;\n property Action: TArchiveAction read Get_Action;\n property CompressedSize: Integer read Get_CompressedSize;\n property CRC32: Integer read Get_CRC32;\n property DiskFileName: WideString read Get_DiskFileName;\n property DiskPath: WideString read Get_DiskPath;\n property ExternalFileAttributes: TFileAttributes read Get_ExternalFileAttributes write Set_ExternalFileAttributes;\n property FileName: WideString read Get_FileName write Set_FileName;\n property IsEncrypted: WordBool read Get_IsEncrypted;\n property LastModFileDateTime: TDateTime read Get_LastModFileDateTime;\n property StoredPath: WideString read Get_StoredPath;\n property Tagged: WordBool read Get_Tagged write Set_Tagged;\n property UnCompressedSize: Integer read Get_UnCompressedSize;\n property CRC32St: WideString read Get_CRC32St;\n property Password: WideString read Get_Password write Set_Password;\n property DevMajor: Integer read Get_DevMajor write Set_DevMajor;\n property DevMinor: Integer read Get_DevMinor write Set_DevMinor;\n property GroupID: Integer read Get_GroupID write Set_GroupID;\n property GroupName: WideString read Get_GroupName write Set_GroupName;\n property LinkFlag: Byte read Get_LinkFlag write Set_LinkFlag;\n property LinkName: WideString read Get_LinkName write Set_LinkName;\n property Mode: Integer read Get_Mode write Set_Mode;\n property UserID: Integer read Get_UserID write Set_UserID;\n property UserName: WideString read Get_UserName write Set_UserName;\n end;\n\n// *********************************************************************//\n// DispIntf: ITarItemDisp\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {729E9F52-C489-4A41-A770-4E2C5282AE39}\n// *********************************************************************//\n ITarItemDisp = dispinterface\n ['{729E9F52-C489-4A41-A770-4E2C5282AE39}']\n property Action: TArchiveAction readonly dispid 1;\n property CompressedSize: Integer readonly dispid 2;\n property CRC32: Integer readonly dispid 3;\n property DiskFileName: WideString readonly dispid 4;\n property DiskPath: WideString readonly dispid 5;\n property ExternalFileAttributes: TFileAttributes dispid 6;\n property FileName: WideString dispid 7;\n property IsEncrypted: WordBool readonly dispid 8;\n property LastModFileDateTime: TDateTime readonly dispid 9;\n property StoredPath: WideString readonly dispid 10;\n property Tagged: WordBool dispid 11;\n property UnCompressedSize: Integer readonly dispid 12;\n property CRC32St: WideString readonly dispid 13;\n property Password: WideString dispid 14;\n property DevMajor: Integer dispid 15;\n property DevMinor: Integer dispid 16;\n property GroupID: Integer dispid 17;\n property GroupName: WideString dispid 18;\n property LinkFlag: Byte dispid 19;\n property LinkName: WideString dispid 20;\n property Mode: Integer dispid 21;\n property UserID: Integer dispid 22;\n property UserName: WideString dispid 23;\n end;\n\n// *********************************************************************//\n// Interface: IZipKit\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {B7480A7F-4E27-4B45-9FE6-224B60295A0C}\n// *********************************************************************//\n IZipKit = interface(IDispatch)\n ['{B7480A7F-4E27-4B45-9FE6-224B60295A0C}']\n procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); safecall;\n procedure AddFromStream(const FileName: WideString; Stream: OleVariant); safecall;\n function Get_AutoSave: WordBool; safecall;\n procedure Set_AutoSave(Value: WordBool); safecall;\n function Get_BaseDirectory: WideString; safecall;\n procedure Set_BaseDirectory(const Value: WideString); safecall;\n procedure ClearTags; safecall;\n function Get_CompressionMethodToUse: TZipSupportMethod; safecall;\n procedure Set_CompressionMethodToUse(Value: TZipSupportMethod); safecall;\n function Get_Count: Integer; safecall;\n function Get_DeflateOption: TZipDeflateOption; safecall;\n procedure Set_DeflateOption(Value: TZipDeflateOption); safecall;\n procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); safecall;\n procedure DeleteAt(Index: Integer); safecall;\n procedure DeleteTaggedItems; safecall;\n function Get_DOSMode: WordBool; safecall;\n procedure Set_DOSMode(Value: WordBool); safecall;\n procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); safecall;\n procedure ExtractAt(Index: Integer; const NewName: WideString); safecall;\n function Get_ExtractOptions: TZipExtractOptions; safecall;\n procedure Set_ExtractOptions(Value: TZipExtractOptions); safecall;\n procedure ExtractTaggedItems; safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Find(const FileName: WideString): Integer; safecall;\n procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); safecall;\n procedure FreshenTaggedItems; safecall;\n function Get_Item(Index: Integer): IDispatch; safecall;\n function Get_LogFile: WideString; safecall;\n procedure Set_LogFile(const Value: WideString); safecall;\n function Get_Logging: WordBool; safecall;\n procedure Set_Logging(Value: WordBool); safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n function Get_PasswordRetries: Byte; safecall;\n procedure Set_PasswordRetries(Value: Byte); safecall;\n procedure Replace(const FileMask: WideString); safecall;\n procedure Save; safecall;\n function Get_Spanned: WordBool; safecall;\n function Get_SpanningThreshold: Integer; safecall;\n procedure Set_SpanningThreshold(Value: Integer); safecall;\n function Get_Status: TArchiveStatus; safecall;\n function Get_StoreOptions: TStoreOptions; safecall;\n procedure Set_StoreOptions(Value: TStoreOptions); safecall;\n procedure TagItems(const FileMask: WideString); safecall;\n function Get_TempDirectory: WideString; safecall;\n procedure Set_TempDirectory(const Value: WideString); safecall;\n procedure TestTaggedItems; safecall;\n procedure UntagItems(const FileMask: WideString); safecall;\n function Get_ZipFileComment: WideString; safecall;\n procedure Set_ZipFileComment(const Value: WideString); safecall;\n function License(const Key: WideString): WordBool; safecall;\n function Get__NewEnum: IUnknown; safecall;\n function ExtractToStream(const FileName: WideString): OleVariant; safecall;\n function Get_CompressionType: TArchiveType; safecall;\n procedure Set_CompressionType(Value: TArchiveType); safecall;\n function Get_TarAutoHandle: WordBool; safecall;\n procedure Set_TarAutoHandle(Value: WordBool); safecall;\n property AutoSave: WordBool read Get_AutoSave write Set_AutoSave;\n property BaseDirectory: WideString read Get_BaseDirectory write Set_BaseDirectory;\n property CompressionMethodToUse: TZipSupportMethod read Get_CompressionMethodToUse write Set_CompressionMethodToUse;\n property Count: Integer read Get_Count;\n property DeflateOption: TZipDeflateOption read Get_DeflateOption write Set_DeflateOption;\n property DOSMode: WordBool read Get_DOSMode write Set_DOSMode;\n property ExtractOptions: TZipExtractOptions read Get_ExtractOptions write Set_ExtractOptions;\n property FileName: WideString read Get_FileName write Set_FileName;\n property Item[Index: Integer]: IDispatch read Get_Item;\n property LogFile: WideString read Get_LogFile write Set_LogFile;\n property Logging: WordBool read Get_Logging write Set_Logging;\n property Password: WideString read Get_Password write Set_Password;\n property PasswordRetries: Byte read Get_PasswordRetries write Set_PasswordRetries;\n property Spanned: WordBool read Get_Spanned;\n property SpanningThreshold: Integer read Get_SpanningThreshold write Set_SpanningThreshold;\n property Status: TArchiveStatus read Get_Status;\n property StoreOptions: TStoreOptions read Get_StoreOptions write Set_StoreOptions;\n property TempDirectory: WideString read Get_TempDirectory write Set_TempDirectory;\n property ZipFileComment: WideString read Get_ZipFileComment write Set_ZipFileComment;\n property _NewEnum: IUnknown read Get__NewEnum;\n property CompressionType: TArchiveType read Get_CompressionType write Set_CompressionType;\n property TarAutoHandle: WordBool read Get_TarAutoHandle write Set_TarAutoHandle;\n end;\n\n// *********************************************************************//\n// DispIntf: IZipKitDisp\n// Flags: (4416) Dual OleAutomation Dispatchable\n// GUID: {B7480A7F-4E27-4B45-9FE6-224B60295A0C}\n// *********************************************************************//\n IZipKitDisp = dispinterface\n ['{B7480A7F-4E27-4B45-9FE6-224B60295A0C}']\n procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); dispid 1;\n procedure AddFromStream(const FileName: WideString; Stream: OleVariant); dispid 7;\n property AutoSave: WordBool dispid 3;\n property BaseDirectory: WideString dispid 4;\n procedure ClearTags; dispid 5;\n property CompressionMethodToUse: TZipSupportMethod dispid 6;\n property Count: Integer readonly dispid 2;\n property DeflateOption: TZipDeflateOption dispid 8;\n procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); dispid 9;\n procedure DeleteAt(Index: Integer); dispid 10;\n procedure DeleteTaggedItems; dispid 11;\n property DOSMode: WordBool dispid 12;\n procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); dispid 13;\n procedure ExtractAt(Index: Integer; const NewName: WideString); dispid 14;\n property ExtractOptions: TZipExtractOptions dispid 15;\n procedure ExtractTaggedItems; dispid 16;\n property FileName: WideString dispid 17;\n function Find(const FileName: WideString): Integer; dispid 18;\n procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); dispid 19;\n procedure FreshenTaggedItems; dispid 20;\n property Item[Index: Integer]: IDispatch readonly dispid 0;\n property LogFile: WideString dispid 23;\n property Logging: WordBool dispid 24;\n property Password: WideString dispid 25;\n property PasswordRetries: Byte dispid 26;\n procedure Replace(const FileMask: WideString); dispid 27;\n procedure Save; dispid 28;\n property Spanned: WordBool readonly dispid 29;\n property SpanningThreshold: Integer dispid 30;\n property Status: TArchiveStatus readonly dispid 31;\n property StoreOptions: TStoreOptions dispid 32;\n procedure TagItems(const FileMask: WideString); dispid 33;\n property TempDirectory: WideString dispid 34;\n procedure TestTaggedItems; dispid 35;\n procedure UntagItems(const FileMask: WideString); dispid 36;\n property ZipFileComment: WideString dispid 37;\n function License(const Key: WideString): WordBool; dispid 38;\n property _NewEnum: IUnknown readonly dispid $FFFFFFFC;\n function ExtractToStream(const FileName: WideString): OleVariant; dispid 21;\n property CompressionType: TArchiveType dispid 40;\n property TarAutoHandle: WordBool dispid 41;\n end;\n\n// *********************************************************************//\n// DispIntf: IZipKitEvents\n// Flags: (4096) Dispatchable\n// GUID: {F094D5F4-3A52-45AE-9D86-4409611DD29E}\n// *********************************************************************//\n IZipKitEvents = dispinterface\n ['{F094D5F4-3A52-45AE-9D86-4409611DD29E}']\n procedure OnArchiveItemProgress(const Item: IDispatch; Progress: Byte; var Abort: WordBool); dispid 1;\n procedure OnArchiveProgress(Progress: Byte; var Abort: WordBool); dispid 2;\n procedure OnChange; dispid 3;\n procedure OnConfirmOverwrite(var Name: WideString; var Confirm: WordBool); dispid 4;\n procedure OnConfirmProcessItem(const Item: IDispatch; ProcessType: TProcessType; \n var Confirm: WordBool); dispid 5;\n procedure OnConfirmSave(var Confirm: WordBool); dispid 6;\n procedure OnLoad; dispid 7;\n procedure OnNeedPassword(var NewPassword: WideString); dispid 8;\n procedure OnProcessItemFailure(const Item: IDispatch; ProcessType: TProcessType; \n ErrorClass: TErrorClass; ErrorCode: TErrorCode; \n const ErrorString: WideString); dispid 9;\n procedure OnRequestBlankDisk(var Abort: WordBool); dispid 10;\n procedure OnRequestImage(ImageNumber: Integer; var ImageName: WideString; var Abort: WordBool); dispid 11;\n procedure OnRequestLastDisk(var Abort: WordBool); dispid 12;\n procedure OnRequestNthDisk(DiskNumber: Integer; var Abort: WordBool); dispid 13;\n procedure OnSave; dispid 14;\n end;\n\n// *********************************************************************//\n// The Class CoZipItem provides a Create and CreateRemote method to \n// create instances of the default interface IZipItem exposed by \n// the CoClass ZipItem. The functions are intended to be used by \n// clients wishing to automate the CoClass objects exposed by the \n// server of this typelibrary. \n// *********************************************************************//\n CoZipItem = class\n class function Create: IZipItem;\n class function CreateRemote(const MachineName: string): IZipItem;\n end;\n\n// *********************************************************************//\n// The Class CoGZipItem provides a Create and CreateRemote method to \n// create instances of the default interface IGZipItem exposed by \n// the CoClass GZipItem. The functions are intended to be used by \n// clients wishing to automate the CoClass objects exposed by the \n// server of this typelibrary. \n// *********************************************************************//\n CoGZipItem = class\n class function Create: IGZipItem;\n class function CreateRemote(const MachineName: string): IGZipItem;\n end;\n\n// *********************************************************************//\n// The Class CoTarItem provides a Create and CreateRemote method to \n// create instances of the default interface ITarItem exposed by \n// the CoClass TarItem. The functions are intended to be used by \n// clients wishing to automate the CoClass objects exposed by the \n// server of this typelibrary. \n// *********************************************************************//\n CoTarItem = class\n class function Create: ITarItem;\n class function CreateRemote(const MachineName: string): ITarItem;\n end;\n\n// *********************************************************************//\n// The Class CoZipKit provides a Create and CreateRemote method to \n// create instances of the default interface IZipKit exposed by \n// the CoClass ZipKit. The functions are intended to be used by \n// clients wishing to automate the CoClass objects exposed by the \n// server of this typelibrary. \n// *********************************************************************//\n CoZipKit = class\n class function Create: IZipKit;\n class function CreateRemote(const MachineName: string): IZipKit;\n end;\n\nimplementation\n\nuses ComObj;\n\nclass function CoZipItem.Create: IZipItem;\nbegin\n Result := CreateComObject(CLASS_ZipItem) as IZipItem;\nend;\n\nclass function CoZipItem.CreateRemote(const MachineName: string): IZipItem;\nbegin\n Result := CreateRemoteComObject(MachineName, CLASS_ZipItem) as IZipItem;\nend;\n\nclass function CoGZipItem.Create: IGZipItem;\nbegin\n Result := CreateComObject(CLASS_GZipItem) as IGZipItem;\nend;\n\nclass function CoGZipItem.CreateRemote(const MachineName: string): IGZipItem;\nbegin\n Result := CreateRemoteComObject(MachineName, CLASS_GZipItem) as IGZipItem;\nend;\n\nclass function CoTarItem.Create: ITarItem;\nbegin\n Result := CreateComObject(CLASS_TarItem) as ITarItem;\nend;\n\nclass function CoTarItem.CreateRemote(const MachineName: string): ITarItem;\nbegin\n Result := CreateRemoteComObject(MachineName, CLASS_TarItem) as ITarItem;\nend;\n\nclass function CoZipKit.Create: IZipKit;\nbegin\n Result := CreateComObject(CLASS_ZipKit) as IZipKit;\nend;\n\nclass function CoZipKit.CreateRemote(const MachineName: string): IZipKit;\nbegin\n Result := CreateRemoteComObject(MachineName, CLASS_ZipKit) as IZipKit;\nend;\n\nend.\n"
},
{
"path": "lib/abbrevia/source/COM/Readme.txt",
"content": "The COM DLLs for v5.0 are compiled using Delphi XE2 (including extended RTTI) and include zipx support. Recompiling with Delphi 2009 and without zipx support should roughly halve the size of the 32-bit DLL.\n\nThey can be registered for all users (requires admin rights) using:\n\n regsvr32 Abbrevia.dll\n\nAnd for the current user using:\n\n regsvr32 /i:user /n Abbrevia.dll\n\nTo uninstall use:\n\n regsvr32 /u Abbrevia.dll\n\nor \n\n regsvr32 /i:user /n /u Abbrevia.dll"
},
{
"path": "lib/abbrevia/source/COM/_GZipItem.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit _GZipItem;\n\ninterface\n\nuses\n ComObj, Abbrevia_TLB, AbGzTyp, AbZipKit;\n\ntype\n\n TGZipItem = class(TAutoIntfObject, IGZipItem)\n private\n FOwner : TAbGzipItem;\n FParent : TAbZipKit;\n public\n constructor Create(AOwner : TAbGzipItem; AParent : TAbZipKit);\n protected\n {IArchiveItem}\n function Get_Action: TArchiveAction; safecall;\n function Get_CompressedSize: Integer; safecall;\n function Get_CRC32: Integer; safecall;\n function Get_CRC32St: WideString; safecall;\n function Get_DiskFileName: WideString; safecall;\n function Get_DiskPath: WideString; safecall;\n function Get_ExternalFileAttributes: TFileAttributes; safecall;\n procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Get_IsEncrypted: WordBool; safecall;\n function Get_LastModFileDateTime: TDateTime; safecall;\n function Get_StoredPath: WideString; safecall;\n function Get_Tagged: WordBool; safecall;\n procedure Set_Tagged(Value: WordBool); safecall;\n function Get_UnCompressedSize: Integer; safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n\n {IGZipItem}\n function Get_CompressionMethod: Byte; safecall;\n procedure Set_CompressionMethod(Value: Byte); safecall;\n function Get_ExtraField: WideString; safecall;\n procedure Set_ExtraField(const Value: WideString); safecall;\n function Get_ExtraFlags: Byte; safecall;\n procedure Set_ExtraFlags(Value: Byte); safecall;\n function Get_FileComment: WideString; safecall;\n procedure Set_FileComment(const Value: WideString); safecall;\n function Get_FileSystem: TFileSystem; safecall;\n procedure Set_FileSystem(Value: TFileSystem); safecall;\n function Get_Flags: Byte; safecall;\n procedure Set_Flags(Value: Byte); safecall;\n function Get_HeaderCRC: Integer; safecall;\n end;\n\n\nimplementation\n\nuses\n ComServ, {StStrL,} SysUtils;\n\n{------------------------------------------------------------------------------}\nconstructor TGzipItem.Create(AOwner : TAbGzipItem; AParent : TAbZipKit);\nbegin\n inherited Create(ComServer.TypeLib, IGZipItem);\n FOwner := AOwner;\n FParent := AParent;\nend;\n{------------------------------------------------------------------------------}\n{IArchiveItem}\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_Action: TArchiveAction;\nbegin\n Result := TArchiveAction(FOwner.Action);\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_CompressedSize: Integer;\nbegin\n result := FOwner.CompressedSize;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_CRC32: Integer;\nbegin\n result := FOwner.CRC32;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_CRC32St: WideString;\nbegin\n result := IntToHex(FOwner.CRC32, 8);\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_DiskFileName: WideString;\nbegin\n result := FOwner.DiskFileName;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_DiskPath: WideString;\nbegin\n result := FOwner.DiskPath;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_ExternalFileAttributes: TFileAttributes;\nbegin\n result := TFileAttributes(FOwner.ExternalFileAttributes);\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_ExternalFileAttributes(Value: TFileAttributes);\nbegin\n FOwner.ExternalFileAttributes := LongInt(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_FileName: WideString;\nbegin\n result := FOwner.FileName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_FileName(const Value: WideString);\nbegin\n FOwner.FileName := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_IsEncrypted: WordBool;\nbegin\n result := FOwner.IsEncrypted;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_LastModFileDateTime: TDateTime;\nbegin\n result := FileDateToDateTime((FOwner.LastModFileDate shl 16) + FOwner.LastModFileTime);\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_StoredPath: WideString;\nbegin\n result := FOwner.StoredPath;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_Tagged: WordBool;\nbegin\n result := FOwner.Tagged;\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_Tagged(Value: WordBool);\nbegin\n FOwner.Tagged := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_UnCompressedSize: Integer;\nbegin\n result := FOwner.UncompressedSize;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_Password: WideString;\nbegin\n {!!!}\n //result := FOwner.Password;\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_Password(const Value: WideString);\nbegin\n {!!!}\n //FOwner.Password := Value;\n //FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\n{IGZipItem}\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_CompressionMethod: Byte;\nbegin\n result := FOwner.CompressionMethod;\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_CompressionMethod(Value: Byte);\nbegin\n\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_ExtraField: WideString;\nbegin\n result := '';\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_ExtraField(const Value: WideString);\nbegin\n\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_ExtraFlags: Byte;\nbegin\n result := FOwner.ExtraFlags;\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_ExtraFlags(Value: Byte);\nbegin\n FOwner.ExtraFlags := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_FileComment: WideString;\nbegin\n result := WideString(FOwner.FileComment);\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_FileComment(const Value: WideString);\nbegin\n FOwner.FileComment := AnsiString(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_FileSystem: TFileSystem;\nbegin\n result := TFileSystem(FOwner.FileSystem);\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_FileSystem(Value: TFileSystem);\nbegin\n FOwner.FileSystem := TAbGzFileSystem(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_Flags: Byte;\nbegin\n result := FOwner.Flags;\nend;\n{------------------------------------------------------------------------------}\nprocedure TGzipItem.Set_Flags(Value: Byte);\nbegin\n\nend;\n{------------------------------------------------------------------------------}\nfunction TGzipItem.Get_HeaderCRC: Integer;\nbegin\n result := 0;\nend;\n{------------------------------------------------------------------------------}\n\n\n\n\nend.\n"
},
{
"path": "lib/abbrevia/source/COM/_TarItem.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit _TarItem;\n\ninterface\n\nuses\n ComObj, Abbrevia_TLB, AbTarTyp, AbZipKit;\n\ntype\n\n TTarItem = class(TAutoIntfObject, ITarItem)\n private\n FOwner : TAbTarItem;\n FParent : TAbZipKit;\n public\n constructor Create(AOwner : TAbTarItem; AParent : TAbZipKit);\n protected\n {IArchiveItem}\n function Get_Action: TArchiveAction; safecall;\n function Get_CompressedSize: Integer; safecall;\n function Get_CRC32: Integer; safecall;\n function Get_CRC32St: WideString; safecall;\n function Get_DiskFileName: WideString; safecall;\n function Get_DiskPath: WideString; safecall;\n function Get_ExternalFileAttributes: TFileAttributes; safecall;\n procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Get_IsEncrypted: WordBool; safecall;\n function Get_LastModFileDateTime: TDateTime; safecall;\n function Get_StoredPath: WideString; safecall;\n function Get_Tagged: WordBool; safecall;\n procedure Set_Tagged(Value: WordBool); safecall;\n function Get_UnCompressedSize: Integer; safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n\n {ITarItem}\n function Get_DevMajor: Integer; safecall;\n procedure Set_DevMajor(Value: Integer); safecall;\n function Get_DevMinor: Integer; safecall;\n procedure Set_DevMinor(Value: Integer); safecall;\n function Get_GroupID: Integer; safecall;\n procedure Set_GroupID(Value: Integer); safecall;\n function Get_GroupName: WideString; safecall;\n procedure Set_GroupName(const Value: WideString); safecall;\n function Get_LinkFlag: Byte; safecall;\n procedure Set_LinkFlag(Value: Byte); safecall;\n function Get_LinkName: WideString; safecall;\n procedure Set_LinkName(const Value: WideString); safecall;\n function Get_Mode: Integer; safecall;\n procedure Set_Mode(Value: Integer); safecall;\n function Get_UserID: Integer; safecall;\n procedure Set_UserID(Value: Integer); safecall;\n function Get_UserName: WideString; safecall;\n procedure Set_UserName(const Value: WideString); safecall;\n\n end;\n\n\nimplementation\n\nuses\n ComServ, {StStrL,} SysUtils;\n\n{------------------------------------------------------------------------------}\nconstructor TTarItem.Create(AOwner : TAbTarItem; AParent : TAbZipKit);\nbegin\n inherited Create(ComServer.TypeLib, ITarItem);\n FOwner := AOwner;\n FParent := AParent;\nend;\n{------------------------------------------------------------------------------}\n{IArchiveItem}\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_Action: TArchiveAction;\nbegin\n Result := TArchiveAction(FOwner.Action);\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_CompressedSize: Integer;\nbegin\n result := FOwner.CompressedSize;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_CRC32: Integer;\nbegin\n result := FOwner.CRC32;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_CRC32St: WideString;\nbegin\n result := IntToHex(FOwner.CRC32, 8);\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_DiskFileName: WideString;\nbegin\n result := FOwner.DiskFileName;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_DiskPath: WideString;\nbegin\n result := FOwner.DiskPath;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_ExternalFileAttributes: TFileAttributes;\nbegin\n result := TFileAttributes(FOwner.ExternalFileAttributes);\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_ExternalFileAttributes(Value: TFileAttributes);\nbegin\n FOwner.ExternalFileAttributes := LongInt(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_FileName: WideString;\nbegin\n result := FOwner.FileName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_FileName(const Value: WideString);\nbegin\n FOwner.FileName := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_IsEncrypted: WordBool;\nbegin\n result := FOwner.IsEncrypted;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_LastModFileDateTime: TDateTime;\nbegin\n result := FileDateToDateTime((FOwner.LastModFileDate shl 16) + FOwner.LastModFileTime);\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_StoredPath: WideString;\nbegin\n result := FOwner.StoredPath;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_Tagged: WordBool;\nbegin\n result := FOwner.Tagged;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_Tagged(Value: WordBool);\nbegin\n FOwner.Tagged := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_UnCompressedSize: Integer;\nbegin\n result := FOwner.UncompressedSize;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_Password: WideString;\nbegin\n {!!!}\n //result := FOwner.Password;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_Password(const Value: WideString);\nbegin\n {!!!}\n //FOwner.Password := Value;\n //FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\n{ITarItem}\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_DevMajor: Integer;\nbegin\n result := FOwner.DevMajor;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_DevMajor(Value: Integer);\nbegin\n FOwner.DevMajor := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_DevMinor: Integer;\nbegin\n result := FOwner.DevMinor;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_DevMinor(Value: Integer);\nbegin\n FOwner.DevMinor := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_GroupID: Integer;\nbegin\n result := FOwner.GroupID;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_GroupID(Value: Integer);\nbegin\n FOwner.GroupID := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_GroupName: WideString;\nbegin\n result := FOwner.GroupName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_GroupName(const Value: WideString);\nbegin\n FOwner.GroupName := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_LinkFlag: Byte;\nbegin\n result := Byte(FOwner.LinkFlag);\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_LinkFlag(Value: Byte);\nbegin\n FOwner.LinkFlag := AnsiChar(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_LinkName: WideString;\nbegin\n result := FOwner.LinkName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_LinkName(const Value: WideString);\nbegin\n FOwner.LinkName := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_Mode: Integer;\nbegin\n result := FOwner.Mode;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_Mode(Value: Integer);\nbegin\n FOwner.Mode := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_UserID: Integer;\nbegin\n result := FOwner.UserID;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_UserID(Value: Integer);\nbegin\n FOwner.UserID := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TTarItem.Get_UserName: WideString;\nbegin\n result := FOwner.UserName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TTarItem.Set_UserName(const Value: WideString);\nbegin\n FOwner.UserName := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\n\n\nend.\n"
},
{
"path": "lib/abbrevia/source/COM/_ZipItem.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit _ZipItem;\n\ninterface\n\nuses\n ComObj, Abbrevia_TLB, AbZipTyp, AbZipKit;\n\ntype\n TZipItem = class(TAutoIntfObject, IZipItem)\n private\n FOwner : TAbZipItem;\n FParent : TAbZipKit;\n public\n constructor Create(AOwner : TAbZipItem; AParent : TAbZipKit);\n protected\n {IArchiveItem}\n function Get_Action: TArchiveAction; safecall;\n function Get_CompressedSize: Integer; safecall;\n function Get_CRC32: Integer; safecall;\n function Get_CRC32St: WideString; safecall;\n function Get_DiskFileName: WideString; safecall;\n function Get_DiskPath: WideString; safecall;\n function Get_ExternalFileAttributes: TFileAttributes; safecall;\n procedure Set_ExternalFileAttributes(Value: TFileAttributes); safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Get_IsEncrypted: WordBool; safecall;\n function Get_LastModFileDateTime: TDateTime; safecall;\n function Get_StoredPath: WideString; safecall;\n function Get_Tagged: WordBool; safecall;\n procedure Set_Tagged(Value: WordBool); safecall;\n function Get_UnCompressedSize: Integer; safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n\n {IZipItem}\n function Get_CompressionMethod: TZipCompressionMethod; safecall;\n function Get_CompressionRatio: Double; safecall;\n function Get_DeflateOption: TZipDeflateOption; safecall;\n function Get_DictionarySize: TZipDictionarySize; safecall;\n function Get_DiskNumberStart: Integer; safecall;\n function Get_ExtraField: WideString; safecall;\n procedure Set_ExtraField(const Value: WideString); safecall;\n function Get_FileComment: WideString; safecall;\n procedure Set_FileComment(const Value: WideString); safecall;\n function Get_InternalFileAttributes: Integer; safecall;\n procedure Set_InternalFileAttributes(Value: Integer); safecall;\n function Get_VersionMadeBy: Integer; safecall;\n function Get_VersionNeededToExtract: Integer; safecall;\n end;\n\nimplementation\n\nuses\n ComServ, SysUtils;\n\n{------------------------------------------------------------------------------}\nconstructor TZipItem.Create(AOwner : TAbZipItem; AParent : TAbZipKit);\nbegin\n inherited Create(ComServer.TypeLib, IZipItem);\n FOwner := AOwner;\n FParent := AParent;\nend;\n{------------------------------------------------------------------------------}\n{IArchiveItem}\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_Action: TArchiveAction;\nbegin\n Result := TArchiveAction(FOwner.Action);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_CompressedSize: Integer;\nbegin\n result := FOwner.CompressedSize;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_CRC32: Integer;\nbegin\n result := FOwner.CRC32;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_CRC32St: WideString;\nbegin\n result := IntToHex(FOwner.CRC32, 8);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_DiskFileName: WideString;\nbegin\n result := FOwner.DiskFileName;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_DiskPath: WideString;\nbegin\n result := FOwner.DiskPath;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_ExternalFileAttributes: TFileAttributes;\nbegin\n result := TFileAttributes(FOwner.ExternalFileAttributes);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_ExternalFileAttributes(Value: TFileAttributes);\nbegin\n FOwner.ExternalFileAttributes := LongInt(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_FileName: WideString;\nbegin\n result := FOwner.FileName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_FileName(const Value: WideString);\nbegin\n FOwner.FileName := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_IsEncrypted: WordBool;\nbegin\n result := FOwner.IsEncrypted;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_LastModFileDateTime: TDateTime;\nbegin\n result := FileDateToDateTime((FOwner.LastModFileDate shl 16) + FOwner.LastModFileTime);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_StoredPath: WideString;\nbegin\n result := FOwner.StoredPath;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_Tagged: WordBool;\nbegin\n result := FOwner.Tagged;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_Tagged(Value: WordBool);\nbegin\n FOwner.Tagged := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_UnCompressedSize: Integer;\nbegin\n result := FOwner.UncompressedSize;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_Password: WideString;\nbegin\n Result := WideString(FParent.Password);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_Password(const Value: WideString);\nbegin\n FParent.Password := AnsiString(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\n{IZipItem}\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_CompressionMethod: TZipCompressionMethod;\nbegin\n Result := TZipCompressionMethod(FOwner.CompressionMethod);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_CompressionRatio: Double;\nbegin\n result := FOwner.CompressionRatio;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_DeflateOption: TZipDeflateOption;\nbegin\n result := TZipDeflateOption(FOwner.DeflationOption);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_DictionarySize: TZipDictionarySize;\nbegin\n result := TZipDictionarySize(FOwner.DictionarySize);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_DiskNumberStart: Integer;\nbegin\n result := FOwner.DiskNumberStart;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_ExtraField: WideString;\nbegin\n result := '';\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_ExtraField(const Value: WideString);\nbegin\n\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_FileComment: WideString;\nbegin\n result := WideString(FOwner.FileComment);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_FileComment(const Value: WideString);\nbegin\n FOwner.FileComment := AnsiString(Value);\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_InternalFileAttributes: Integer;\nbegin\n result := FOwner.InternalFileAttributes;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipItem.Set_InternalFileAttributes(Value: Integer);\nbegin\n FOwner.InternalFileAttributes := Value;\n FParent.ZipArchive.IsDirty := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_VersionMadeBy: Integer;\nbegin\n result := FOwner.VersionMadeBy;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipItem.Get_VersionNeededToExtract: Integer;\nbegin\n result := FOwner.VersionNeededToExtract;\nend;\n{------------------------------------------------------------------------------}\n\n\nend.\n"
},
{
"path": "lib/abbrevia/source/COM/_ZipKit.pas",
"content": "(* ***** BEGIN LICENSE BLOCK *****\n * Version: MPL 1.1\n *\n * The contents of this file are subject to the Mozilla Public License Version\n * 1.1 (the \"License\"); you may not use this file except in compliance with\n * the License. You may obtain a copy of the License at\n * http://www.mozilla.org/MPL/\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License\n * for the specific language governing rights and limitations under the\n * License.\n *\n * The Original Code is TurboPower Abbrevia\n *\n * The Initial Developer of the Original Code is\n * TurboPower Software\n *\n * Portions created by the Initial Developer are Copyright (C) 1997-2002\n * the Initial Developer. All Rights Reserved.\n *\n * Contributor(s):\n *\n * ***** END LICENSE BLOCK ***** *)\n\nunit _ZipKit;\n\ninterface\n\nuses\n ComObj, Classes, Windows, Abbrevia_TLB, ActiveX, axctrls, AbZipKit, AbArcTyp,\n AbUtils, _ZipItem, _GZipItem, _TarItem, AbZipTyp, AbTarTyp, AbGzTyp,\n AbConst, AbBrowse;\n\ntype\n {$IFNDEF VER130}{$WARN SYMBOL_PLATFORM OFF}{$ENDIF}\n TZipKit = class(TAutoObject, IConnectionPointContainer, IEnumVariant, IZipKit)\n private\n {private declarations}\n FConnectionPoints : TConnectionPoints;\n FEvents : IZipKitEvents;\n FOwner : TAbZipKit;\n FEnumPos : Integer;\n\n {Events for FOwner}\n procedure _OnArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem; Progress : Byte; var Abort : Boolean);\n procedure _OnArchiveProgress(Sender : TObject; Progress : Byte; var Abort : Boolean);\n procedure _OnChange(Sender : TObject);\n procedure _OnConfirmOverwrite(var Name : string; var confirm : Boolean);\n procedure _OnConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem; ProcessType : TAbProcessType; var Confirm : Boolean);\n procedure _OnConfirmSave(Sender : TObject; var Confirm : Boolean);\n procedure _OnLoad(Sender : TObject);\n procedure _OnNeedPassword(Sender : TObject; var NewPassword : AnsiString);\n procedure _OnProcessItemFailure(Sender : TObject; Item : TAbArchiveItem; ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; ErrorCode : Integer);\n procedure _OnRequestBlankDisk(Sender : TObject; var Abort : Boolean);\n procedure _OnRequestImage(Sender : TObject; ImageNumber : Integer; var ImageName : string; var Abort : Boolean);\n procedure _OnRequestLastDisk(Sender : TObject; var Abort : Boolean);\n procedure _OnRequestNthDisk(Sender : TObject; DiskNumber : Byte; var Abort : Boolean);\n procedure _OnSave(Sender : TObject);\n\n public\n procedure Initialize; override;\n destructor Destroy; override;\n\n protected\n\n {IConnectionPointContainer}\n property ConnectionPoints: TConnectionPoints read FConnectionPoints\n implements IConnectionPointContainer;\n procedure EventSinkChanged(const EventSink: IUnknown); override;\n\n\n {IEnumVariant}\n function Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall;\n function Skip(celt: LongWord): HResult; stdcall;\n function Reset: HResult; stdcall;\n function Clone(out Enum: IEnumVariant): HResult; stdcall;\n\n\n {IZipKit}\n procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); safecall;\n procedure AddFromStream(const FileName: WideString; Stream: OleVariant); safecall;\n function Get_AutoSave: WordBool; safecall;\n procedure Set_AutoSave(Value: WordBool); safecall;\n function Get_BaseDirectory: WideString; safecall;\n procedure Set_BaseDirectory(const Value: WideString); safecall;\n procedure ClearTags; safecall;\n function Get_CompressionMethodToUse: TZipSupportMethod; safecall;\n procedure Set_CompressionMethodToUse(Value: TZipSupportMethod); safecall;\n function Get_Count: Integer; safecall;\n function Get_DeflateOption: TZipDeflateOption; safecall;\n procedure Set_DeflateOption(Value: TZipDeflateOption); safecall;\n procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); safecall;\n procedure DeleteAt(Index: Integer); safecall;\n procedure DeleteTaggedItems; safecall;\n function Get_DOSMode: WordBool; safecall;\n procedure Set_DOSMode(Value: WordBool); safecall;\n procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); safecall;\n procedure ExtractAt(Index: Integer; const NewName: WideString); safecall;\n function Get_ExtractOptions: TZipExtractOptions; safecall;\n procedure Set_ExtractOptions(Value: TZipExtractOptions); safecall;\n procedure ExtractTaggedItems; safecall;\n function Get_FileName: WideString; safecall;\n procedure Set_FileName(const Value: WideString); safecall;\n function Find(const FileName: WideString): Integer; safecall;\n procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); safecall;\n procedure FreshenTaggedItems; safecall;\n function Get_Item(Index: Integer): IDispatch; safecall;\n function Get_LogFile: WideString; safecall;\n procedure Set_LogFile(const Value: WideString); safecall;\n function Get_Logging: WordBool; safecall;\n procedure Set_Logging(Value: WordBool); safecall;\n function Get_Password: WideString; safecall;\n procedure Set_Password(const Value: WideString); safecall;\n function Get_PasswordRetries: Byte; safecall;\n procedure Set_PasswordRetries(Value: Byte); safecall;\n procedure Replace(const FileMask: WideString); safecall;\n procedure Save; safecall;\n function Get_Spanned: WordBool; safecall;\n function Get_SpanningThreshold: Integer; safecall;\n procedure Set_SpanningThreshold(Value: Integer); safecall;\n function Get_Status: TArchiveStatus; safecall;\n function Get_StoreOptions: TStoreOptions; safecall;\n procedure Set_StoreOptions(Value: TStoreOptions); safecall;\n procedure TagItems(const FileMask: WideString); safecall;\n function Get_TempDirectory: WideString; safecall;\n procedure Set_TempDirectory(const Value: WideString); safecall;\n procedure TestTaggedItems; safecall;\n procedure UntagItems(const FileMask: WideString); safecall;\n function Get_ZipFileComment: WideString; safecall;\n procedure Set_ZipFileComment(const Value: WideString); safecall;\n function License(const Key: WideString): WordBool; safecall;\n function Get__NewEnum: IUnknown; safecall;\n function ExtractToStream(const FileName: WideString): OleVariant; safecall;\n function Get_CompressionType: TArchiveType; safecall;\n procedure Set_CompressionType(Value: TArchiveType); safecall;\n\n function Get_TarAutoHandle: WordBool; safecall;\n procedure Set_TarAutoHandle(Value: WordBool); safecall;\n end;\n\n\nimplementation\n\n\nuses\n ComServ;\n\n{------------------------------------------------------------------------------}\n{IConnectionPointContainer}\n{------------------------------------------------------------------------------}\nprocedure TZipKit.EventSinkChanged(const EventSink: IUnknown);\nbegin\n FEvents := EventSink as IZipKitEvents;\nend;\n{------------------------------------------------------------------------------}\n{IEnumVariant}\n{------------------------------------------------------------------------------}\nfunction TZipKit.Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall;\nvar\n V : OleVariant;\n I : Integer;\nbegin\n Result := S_FALSE;\n try\n if @pceltFetched <> nil then\n pceltFetched := 0;\n for I := 0 to celt - 1 do begin\n if FEnumPos >= FOwner.Count then begin\n FEnumPos := 0;\n Exit;\n end;\n V := Get_Item(FEnumPos);\n PVariantArgList(@rgvar)[I] := TVariantArg(V);\n\n { Prevent COM garbage collection }\n TVarData(V).VType := varEmpty;\n TVarData(V).VInteger := 0;\n\n Inc(FEnumPos);\n if @pceltFetched <> nil then\n Inc(pceltFetched);\n end;\n except\n end;\n if (@pceltFetched = nil) or (pceltFetched = celt) then\n Result := S_OK;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Skip(celt: LongWord): HResult;\nbegin\n Inc(FEnumPos, celt);\n Result := S_OK;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Reset: HResult;\nbegin\n FEnumPos := 0;\n Result := S_OK;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Clone(out Enum: IEnumVariant): HResult;\nbegin\n Enum := nil;\n Result := S_OK;\n try\n Enum := Self.Create;\n TZipKit(Enum).FOwner := FOwner;\n except\n Result := E_OUTOFMEMORY;\n end;\nend;\n{------------------------------------------------------------------------------}\n{IZipKit}\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer);\nbegin\n FOwner.AddFilesEx(FileMask, ExclusionMask, SearchAttr);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.AddFromStream(const FileName: WideString; Stream: OleVariant);\nvar\n InStream : TMemoryStream;\n Info : array of Byte;\nbegin\n Info := nil;\n InStream := TMemoryStream.Create;\n try\n Info := Stream;\n InStream.Write(Info[0], Length(Info));\n InStream.Position := 0;\n FOwner.AddFromStream(FileName, InStream);\n finally\n InStream.Free;\n end;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_AutoSave: WordBool;\nbegin\n Result := FOwner.AutoSave;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_AutoSave(Value: WordBool);\nbegin\n FOwner.AutoSave := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_BaseDirectory: WideString;\nbegin\n Result := FOwner.BaseDirectory;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_BaseDirectory(const Value: WideString);\nbegin\n FOwner.BaseDirectory := Value;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.ClearTags;\nbegin\n FOwner.ClearTags;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_CompressionMethodToUse: TZipSupportMethod;\nbegin\n Result := TZipCompressionMethod(FOwner.CompressionMethodToUse);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_CompressionMethodToUse(Value: TZipSupportMethod);\nbegin\n FOwner.CompressionMethodToUse := TAbZipSupportedMethod(Value);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_Count: Integer;\nbegin\n Result := FOwner.Count;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_DeflateOption: TZipDeflateOption;\nbegin\n Result := TZipDeflateOption(FOwner.DeflationOption);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_DeflateOption(Value: TZipDeflateOption);\nbegin\n FOwner.DeflationOption := TAbZipDeflationOption(Value);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Delete(const FileMask: WideString; const ExclusionMask: WideString);\nbegin\n FOwner.DeleteFilesEx(FileMask, ExclusionMask);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.DeleteAt(Index: Integer);\nbegin\n FOwner.DeleteAt(Index);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.DeleteTaggedItems;\nbegin\n FOwner.DeleteTaggedItems;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_DOSMode: WordBool;\nbegin\n Result := FOwner.DOSMode;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_DOSMode(Value: WordBool);\nbegin\n FOwner.DOSMode := Value;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Extract(const FileMask: WideString; const ExclusionMask: WideString);\nbegin\n FOwner.ExtractFilesEx(FileMask, ExclusionMask);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.ExtractAt(Index: Integer; const NewName: WideString);\nbegin\n FOwner.ExtractAt(Index, NewName);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_ExtractOptions: TZipExtractOptions;\nbegin\n Result := 0;\n if TAbExtractOption(eoCreateDirs) in FOwner.ExtractOptions then\n Result := Result + TZipExtractOptions(eoCreateDirs);\n if TAbExtractOption(eoRestorePath) in FOwner.ExtractOptions then\n Result := Result + TZipExtractOptions(eoRestorePath);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_ExtractOptions(Value: TZipExtractOptions);\nvar\n TempOptions : TAbExtractOptions;\nbegin\n TempOptions := [];\n if (Value or Abbrevia_TLB.eoCreateDirs) = Value then\n Include(TempOptions, AbArcTyp.eoCreateDirs);\n if (Value or Abbrevia_TLB.eoRestorePath) = Value then\n Include(TempOptions, AbArcTyp.eoRestorePath);\n FOwner.ExtractOptions := TempOptions\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.ExtractTaggedItems;\nbegin\n FOwner.ExtractTaggedItems;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_FileName: WideString;\nbegin\n Result := FOwner.FileName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_FileName(const Value: WideString);\nbegin\n FOwner.FileName := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Find(const FileName: WideString): Integer;\nbegin\n Result := FOwner.FindFile(FileName);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Freshen(const FileMask: WideString; const ExclusionMask: WideString);\nbegin\n FOwner.FreshenFilesEx(FileMask, ExclusionMask);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.FreshenTaggedItems;\nbegin\n FOwner.FreshenTaggedItems;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_Item(Index: Integer): IDispatch;\nbegin\n Result := TZipItem.Create(FOwner.Items[Index], FOwner);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_LogFile: WideString;\nbegin\n Result := FOwner.LogFile;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_LogFile(const Value: WideString);\nbegin\n FOwner.LogFile := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_Logging: WordBool;\nbegin\n Result := FOwner.Logging;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_Logging(Value: WordBool);\nbegin\n FOwner.Logging := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_Password: WideString;\nbegin\n Result := WideString(FOwner.Password);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_Password(const Value: WideString);\nbegin\n FOwner.Password := AnsiString(Value);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_PasswordRetries: Byte;\nbegin\n Result := FOwner.PasswordRetries;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_PasswordRetries(Value: Byte);\nbegin\n FOwner.PasswordRetries := Value;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Replace(const FileMask: WideString);\nbegin\n FOwner.Replace(FOwner.Items[FOwner.FindFile(FileMask)]);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Save;\nbegin\n FOwner.Save;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_Spanned: WordBool;\nbegin\n Result := FOwner.Spanned;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_SpanningThreshold: Integer;\nbegin\n Result := FOwner.SpanningThreshold;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_SpanningThreshold(Value: Integer);\nbegin\n FOwner.SpanningThreshold := Value;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_Status: TArchiveStatus;\nbegin\n Result := TArchiveStatus(FOwner.Status);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_StoreOptions: TStoreOptions;\nbegin\n Result := 0;\n if TAbStoreOption(soStripDrive) in FOwner.StoreOptions then\n Result := Result + TStoreOptions(soStripDrive);\n if TAbStoreOption(soStripPath) in FOwner.StoreOptions then\n Result := Result + TStoreOptions(soStripPath);\n if TAbStoreOption(soRemoveDots) in FOwner.StoreOptions then\n Result := Result + TStoreOptions(soRemoveDots);\n if TAbStoreOption(soRecurse) in FOwner.StoreOptions then\n Result := Result + TStoreOptions(soRecurse);\n if TAbStoreOption(soFreshen) in FOwner.StoreOptions then\n Result := Result + TStoreOptions(soFreshen);\n if TAbStoreOption(soReplace) in FOwner.StoreOptions then\n Result := Result + TStoreOptions(soReplace);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_StoreOptions(Value: TStoreOptions);\nvar\n TempOptions : TAbStoreOptions;\nbegin\n TempOptions := [];\n if (Value or Abbrevia_TLB.soStripDrive) = Value then\n Include(TempOptions, AbArcTyp.soStripDrive);\n if (Value or Abbrevia_TLB.soStripPath) = Value then\n Include(TempOptions, AbArcTyp.soStripPath);\n if (Value or Abbrevia_TLB.soRemoveDots) = Value then\n Include(TempOptions, AbArcTyp.soRemoveDots);\n if (Value or Abbrevia_TLB.soRecurse) = Value then\n Include(TempOptions, AbArcTyp.soRecurse);\n if (Value or Abbrevia_TLB.soFreshen) = Value then\n Include(TempOptions, AbArcTyp.soFreshen);\n if (Value or Abbrevia_TLB.soReplace) = Value then\n Include(TempOptions, AbArcTyp.soReplace);\n FOwner.StoreOptions := TempOptions\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.TagItems(const FileMask: WideString);\nbegin\n FOwner.TagItems(FileMask);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_TempDirectory: WideString;\nbegin\n Result := FOwner.TempDirectory;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_TempDirectory(const Value: WideString);\nbegin\n FOwner.TempDirectory := Value;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.TestTaggedItems;\nbegin\n FOwner.TestTaggedItems;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.UntagItems(const FileMask: WideString);\nbegin\n FOwner.UnTagItems(FileMask);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_ZipFileComment: WideString;\nbegin\n Result := WideString(FOwner.ZipFileComment);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_ZipFileComment(const Value: WideString);\nbegin\n FOwner.ZipfileComment := AnsiString(Value);\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.License(const Key: WideString): WordBool;\nbegin\n Result := True;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get__NewEnum: IUnknown;\nbegin\n Result := Self;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.ExtractToStream(const FileName: WideString): OleVariant;\nvar\n Stream : TMemoryStream;\n Info : array of Byte;\nbegin\n Stream := TMemoryStream.Create;\n try\n FOwner.ExtractToStream(FileName, Stream);\n Stream.Position := 0;\n SetLength(Info, Stream.Size);\n Stream.Read(Info[0], Stream.Size);\n Result := Info;\n finally\n Stream.Free;\n end;\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_CompressionType: TArchiveType;\nbegin\n Result := TArchiveType((FOwner as TAbBaseBrowser).ArchiveType);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_CompressionType(Value: TArchiveType);\nbegin\n (FOwner as TAbBaseBrowser).ArchiveType := TAbArchiveType(ord(Value));\nend;\n{------------------------------------------------------------------------------}\nfunction TZipKit.Get_TarAutoHandle: WordBool;\nbegin\n Result := FOwner.TarAutoHandle;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Set_TarAutoHandle(Value: WordBool);\nbegin\n FOwner.TarAutoHandle := Value;\nend;\n{------------------------------------------------------------------------------}\n{TZipKit Events}\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem;\n Progress : Byte; var Abort : Boolean);\nvar\n FAbort : WordBool;\nbegin\n FAbort := Abort;\n if Assigned(FEvents) then begin\n if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then\n FEvents.OnArchiveItemProgress(TZipItem.Create(TAbZipItem(Item), FOwner),\n Progress, FAbort)\n else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then\n FEvents.OnArchiveItemProgress(TTarItem.Create(TAbTarItem(Item), FOwner),\n Progress, FAbort)\n else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then\n FEvents.OnArchiveItemProgress(TGZipItem.Create(TAbGZipItem(Item), FOwner),\n Progress, FAbort);\n end;\n Abort := FAbort;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnArchiveProgress(Sender : TObject; Progress : Byte;\n var Abort : Boolean);\nvar\n FAbort : WordBool;\nbegin\n FAbort := Abort;\n if Assigned(FEvents) then\n FEvents.OnArchiveProgress(Progress, FAbort);\n Abort := FAbort;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnChange(Sender : TObject);\nbegin\n if Assigned(FEvents) then\n FEvents.OnChange;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnConfirmOverwrite(var Name : string; var confirm : Boolean);\nvar\n FConfirm : WordBool;\n FName : WideString;\nbegin\n FConfirm := Confirm;\n FName := Name;\n if Assigned(FEvents) then\n FEvents.OnConfirmOverwrite(FName, FConfirm);\n Name := FName;\n Confirm := FConfirm;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem;\n ProcessType : TAbProcessType; var Confirm : Boolean);\nvar\n FConfirm : WordBool;\nbegin\n FConfirm := Confirm;\n if Assigned(FEvents) then begin\n if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then\n FEvents.OnConfirmProcessItem(TZipItem.Create(TAbZipItem(Item), FOwner),\n TProcessType(ProcessType), FConfirm)\n else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then\n FEvents.OnConfirmProcessItem(TTarItem.Create(TAbTarItem(Item), FOwner),\n TProcessType(ProcessType), FConfirm)\n else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then\n FEvents.OnConfirmProcessItem(TGZipItem.Create(TAbGZipItem(Item), FOwner),\n TProcessType(ProcessType), FConfirm);\n end;\n Confirm := FConfirm\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnConfirmSave(Sender : TObject; var Confirm : Boolean);\nvar\n FConfirm : WordBool;\nbegin\n FConfirm := Confirm;\n if Assigned(FEvents) then\n FEvents.OnConfirmSave(FConfirm);\n Confirm := FConfirm;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnLoad(Sender : TObject);\nbegin\n if Assigned(FEvents) then\n FEvents.OnLoad;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnNeedPassword(Sender : TObject; var NewPassword : AnsiString);\nvar\n FNewPassword : WideString;\nbegin\n FNewPassword := WideString(NewPassword);\n if Assigned(FEvents) then\n FEvents.OnNeedPassword(FNewPassword);\n NewPassword := AnsiString(FNewPassword);\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnProcessItemFailure(Sender : TObject; Item : TAbArchiveItem;\n ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;\n ErrorCode : Integer);\nbegin\n if Assigned(FEvents) then begin\n if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then\n FEvents.OnProcessItemFailure(TZipItem.Create(TAbZipItem(Item), FOwner),\n TProcessType(ProcessType), TErrorClass(ErrorClass),\n TErrorCode(ErrorCode), AbStrRes(ErrorCode))\n else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then\n FEvents.OnProcessItemFailure(TTarItem.Create(TAbTarItem(Item), FOwner),\n TProcessType(ProcessType), TErrorClass(ErrorClass),\n TErrorCode(ErrorCode),AbStrRes(ErrorCode))\n else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then\n FEvents.OnProcessItemFailure(TGZipItem.Create(TAbGZipItem(Item), FOwner),\n TProcessType(ProcessType), TErrorClass(ErrorClass),\n TErrorCode(ErrorCode),AbStrRes(ErrorCode));\n end;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnRequestBlankDisk(Sender : TObject; var Abort : Boolean);\nvar\n FAbort : WordBool;\nbegin\n FAbort := Abort;\n if Assigned(FEvents) then\n FEvents.OnRequestBlankDisk(FAbort);\n Abort := FAbort;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnRequestImage(Sender : TObject; ImageNumber : Integer; var ImageName : string; var Abort : Boolean);\nvar\n FImageName : WideString;\n FAbort : WordBool;\nbegin\n FImageName := ImageName;\n FAbort := Abort;\n if Assigned(FEvents) then\n FEvents.OnRequestImage(ImageNumber, FImageName, FAbort);\n Abort := FAbort;\n ImageName := FImageName;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnRequestLastDisk(Sender : TObject; var Abort : Boolean);\nvar\n FAbort : WordBool;\nbegin\n FAbort := Abort;\n if Assigned(FEvents) then\n FEvents.OnRequestLastDisk(FAbort);\n Abort := FAbort;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnRequestNthDisk(Sender : TObject; DiskNumber : Byte; var Abort : Boolean);\nvar\n FAbort : WordBool;\nbegin\n FAbort := Abort;\n if Assigned(FEvents) then\n FEvents.OnRequestNthDisk(DiskNumber, FAbort);\n Abort := FAbort;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit._OnSave(Sender : TObject);\nbegin\n if Assigned(FEvents) then\n FEvents.OnSave;\nend;\n{------------------------------------------------------------------------------}\nprocedure TZipKit.Initialize;\nbegin\n inherited Initialize;\n FConnectionPoints := TConnectionPoints.Create(Self);\n if AutoFactory.EventTypeInfo <> nil then\n FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,\n ckSingle, EventConnect);\n FOwner := AbZipKit.TAbZipKit.Create(nil);\n FOwner.OnArchiveItemProgress := _OnArchiveItemProgress;\n FOwner.OnArchiveProgress := _OnArchiveProgress;\n FOwner.OnChange := _OnChange;\n FOwner.OnConfirmOverwrite := _OnConfirmOverwrite;\n FOwner.OnConfirmProcessItem := _OnConfirmProcessItem;\n FOwner.OnConfirmSave := _OnConfirmSave;\n FOwner.OnLoad := _OnLoad;\n FOwner.OnNeedPassword := _OnNeedPassword;\n FOwner.OnProcessItemFailure := _OnProcessItemFailure;\n FOwner.OnRequestBlankDisk := _OnRequestBlankDisk;\n FOwner.OnRequestImage := _OnRequestImage;\n FOwner.OnRequestLastDisk := _OnRequestLastDisk;\n FOwner.OnRequestNthDisk := _OnRequestNthDisk;\n FOwner.OnSave := _OnSave;\n FEnumPos := 0;\nend;\n{------------------------------------------------------------------------------}\ndestructor TZipKit.Destroy;\nbegin\n FOwner.Free;\n inherited Destroy;\nend;\n{------------------------------------------------------------------------------}\n\ninitialization\n TAutoObjectFactory.Create(ComServer, TZipKit, Class_ZipKit, ciMultiInstance, tmBoth);\n\n\nend.\n"
},
{
"path": "lib/mte/CRC32.pas",
"content": "unit CRC32;\n\ninterface\ntype\n Long = record\n LoWord: Word;\n HiWord: Word;\n end;\n\n // exported functions\n function FileCRC32(FileName: string): string;\n function StrCRC32(input: string): string;\n\nconst\n CRCPOLY = $EDB88320;\n\nvar\n CRCTable: array[0..512] Of Longint;\n\nimplementation\n{$WARNINGS OFF}\n\nuses\n SysUtils;\n\nprocedure BuildCRCTable;\nvar\n i, j: Word;\n r: Longint;\nbegin\n FillChar(CRCTable, SizeOf(CRCTable), 0);\n for i := 0 to 255 do\n begin\n r := i shl 1;\n for j := 8 downto 0 do\n if (r and 1) <> 0 then\n r := (r Shr 1) xor CRCPOLY\n else\n r := r shr 1;\n CRCTable[i] := r;\n end;\nend;\n\nfunction RecountCRC(b: byte; CrcOld: Longint): Longint;\nbegin\n RecountCRC := CRCTable[byte(CrcOld xor Longint(b))] xor ((CrcOld shr 8) and $00FFFFFF)\nend;\n\nfunction HextW(w: Word): string;\nconst\n h: array[0..15] Of char = '0123456789ABCDEF';\nbegin\n HextW := '';\n HextW := h[Hi(w) shr 4] + h[Hi(w) and $F] + h[Lo(w) shr 4]+h[Lo(w) and $F];\nend;\n\nfunction HextL(l: Longint): string;\nbegin\n with Long(l) do\n HextL := HextW(HiWord) + HextW(LoWord);\nend;\n\nfunction FileCRC32(FileName: string): string;\nvar\n Buffer: PChar;\n F: File of Byte;\n B: array[0..255] of Byte;\n CRC: Longint;\n e, i: Integer;\nbegin\n BuildCRCTable;\n CRC := $FFFFFFFF;\n AssignFile(F, FileName);\n FileMode := 0;\n Reset(F);\n GetMem(Buffer, SizeOf(B));\n repeat\n FillChar(B, SizeOf(B), 0);\n BlockRead(F, B, SizeOf(B), e);\n for i := 0 to (e-1) do\n CRC := RecountCRC(b[i], CRC);\n until (e < 255) or (IOresult <> 0);\n FreeMem(Buffer, SizeOf(B));\n CloseFile(F);\n CRC := Not CRC;\n Result := HextL(CRC);\nend;\n\nfunction StrCRC32(input: string): string;\nvar\n B: TArray;\n CRC: Longint;\n i: Integer;\nbegin\n BuildCRCTable;\n CRC := $FFFFFFFF;\n B := TEncoding.UTF8.GetBytes(input);\n for i := 0 to Pred(Length(B)) do\n CRC := RecountCRC(B[i], CRC);\n CRC := Not CRC;\n Result := HextL(CRC);\nend;\n\nend.\n"
},
{
"path": "lib/mte/RttiIni.pas",
"content": "unit RttiIni;\n\ninterface\n\nuses\n SysUtils, Classes, Rtti, TypInfo, IniFiles;\n\ntype\n IniSectionAttribute = class(TCustomAttribute)\n private\n FSection: string;\n public\n constructor Create(const aSection: String);\n property Section: string read FSection write FSection;\n end;\n\n TRttiIni = class (TObject)\n private\n class function ReadValue(section: string; var ini: TMemIniFile;\n field: TRttiField): TValue;\n class procedure WriteValue(section: string; var ini: TMemIniFile;\n field: TRttiField; aValue: TValue);\n class function GetIniAttribute(Obj: TRttiObject): IniSectionAttribute;\n public\n class procedure Load(filename: string; obj: TObject);\n class procedure Save(filename: string; obj: TObject);\n end;\n\nimplementation\n\n{ TIniSection }\nconstructor IniSectionAttribute.Create(const aSection: String);\nbegin\n FSection := aSection;\nend;\n\n{ TIniPersist }\nclass function TRttiIni.GetIniAttribute(Obj: TRttiObject): IniSectionAttribute;\nvar\n Attr: TCustomAttribute;\nbegin\n for Attr in Obj.GetAttributes do begin\n if Attr is IniSectionAttribute then\n exit(IniSectionAttribute(Attr));\n end;\n result := nil;\nend;\n\nclass procedure TRttiIni.Load(filename: string; obj: TObject);\nvar\n ctx: TRttiContext;\n objType: TRttiType;\n Field: TRttiField;\n IniSection: IniSectionAttribute;\n Ini: TMemIniFile;\n CurrentSection: string;\n value: TValue;\nbegin\n ctx := TRttiContext.Create;\n try\n Ini := TMemIniFile.Create(FileName);\n try\n objType := ctx.GetType(Obj.ClassInfo);\n for Field in objType.GetFields do begin\n IniSection := GetIniAttribute(Field);\n if Assigned(IniSection) then\n CurrentSection := IniSection.Section;\n value := ReadValue(CurrentSection, ini, Field);\n if not value.IsEmpty then\n field.SetValue(obj, value);\n end;\n finally\n Ini.Free;\n end;\n finally\n ctx.Free;\n end;\nend;\n\nclass function TRttiIni.ReadValue(section: string; var ini: TMemIniFile;\n field: TRttiField): TValue;\nvar\n fieldType: string;\nbegin\n Result := TValue.Empty;\n fieldType := field.FieldType.Name;\n\n // exit if value doesn't exist in ini being loaded\n // this allows us to use default values from the object's constructor\n if not ini.ValueExists(section, field.Name) then\n exit;\n\n // load string, Integer, and Boolean fields from ini\n if fieldType = 'string' then\n Result := TValue.From(ini.ReadString(section, field.Name, ''))\n else if fieldType = 'Integer' then\n Result := TValue.From(ini.ReadInteger(section, field.Name, 0))\n else if fieldType = 'Int64' then\n Result := TValue.From(ini.ReadInteger(section, field.Name, 0))\n else if fieldType = 'TDateTime' then\n Result := TValue.From(ini.ReadFloat(section, field.Name, 0))\n else if fieldType = 'Boolean' then\n Result := TValue.From(ini.ReadBool(section, field.Name, false));\nend;\n\nclass procedure TRttiIni.WriteValue(section: string; var ini: TMemIniFile;\n field: TRttiField; aValue: TValue);\nvar\n fieldType: string;\nbegin\n fieldType := field.FieldType.Name;\n if fieldType = 'string' then\n ini.WriteString(section, field.Name, aValue.AsString)\n else if fieldType = 'Integer' then\n ini.WriteInteger(section, field.Name, aValue.AsInteger)\n else if fieldType = 'Int64' then\n ini.WriteInteger(section, field.Name, aValue.AsInt64)\n else if fieldType = 'TDateTime' then\n ini.WriteFloat(section, field.Name, aValue.AsType)\n else if fieldType = 'Boolean' then\n ini.WriteBool(section, field.Name, aValue.AsBoolean)\nend;\n\nclass procedure TRttiIni.Save(filename: string; obj: TObject);\nvar\n ctx: TRttiContext;\n objType: TRttiType;\n field: TRttiField;\n IniSection: IniSectionAttribute;\n ini: TMemIniFile;\n CurrentSection: string;\nbegin\n ctx := TRttiContext.Create;\n try\n ini := TMemIniFile.Create(FileName);\n try\n objType := ctx.GetType(Obj.ClassInfo);\n for field in objType.GetFields do begin\n IniSection := GetIniAttribute(Field);\n if Assigned(IniSection) then\n CurrentSection := IniSection.Section;\n WriteValue(CurrentSection, ini, field, Field.GetValue(obj));\n end;\n finally\n Ini.UpdateFile;\n Ini.Free;\n end;\n finally\n ctx.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/mte/RttiJson.pas",
"content": "unit RttiJson;\n\ninterface\n\nuses\n SysUtils, Rtti,\n // superobject json library\n superobject;\n \ntype\n TRttiJson = class (TObject)\n public\n class function ToJson(obj: TObject): string;\n class function FromJson(json: string; classType: TClass): TObject;\n end;\n\nimplementation\n\nclass function TRttiJson.ToJson(obj: TObject): string;\nvar\n rtype: TRTTIType;\n field: TRTTIField;\n fieldType: string;\n jsonObj: ISuperObject;\n date: TDateTime;\nbegin\n jsonObj := SO;\n rtype := TRTTIContext.Create.GetType(obj.ClassType);\n\n // loop through fields\n for field in rType.GetFields do begin\n fieldType := field.FieldType.ToString;\n // handle datatypes I use\n if (fieldType = 'string') then\n jsonObj.S[field.Name] := field.GetValue(obj).ToString\n else if (fieldType = 'Integer') then\n jsonObj.I[field.Name] := field.GetValue(obj).AsInteger\n else if (fieldType = 'TDateTime') then begin\n date := StrToFloat(field.GetValue(obj).ToString);\n jsonObj.S[field.Name] := DateTimeToStr(date);\n end;\n end;\n\n Result := jsonObj.AsJSon;\nend;\n\n{\n Example usage:\n report := TReport(FromJson(reportJson, TReport));\n}\nclass function TRttiJson.FromJson(json: string; classType: TClass): TObject;\nvar\n rtype: TRTTIType;\n field: TRTTIField;\n fieldType: string;\n context: TRTTIContext;\n jsonObj: ISuperObject;\n date: TDateTime;\nbegin\n jsonObj := SO(PChar(json));\n context := TRTTIContext.Create;\n rtype := context.GetType(classType);\n Result := classType.Create;\n\n // loop through fields\n for field in rType.GetFields do begin\n fieldType := field.FieldType.ToString;\n // handle datatypes I use\n if (fieldType = 'string') then\n field.SetValue(Result, jsonObj.S[field.Name])\n else if (fieldType = 'Integer') then\n field.SetValue(Result, jsonObj.I[field.Name])\n else if (fieldType = 'TDateTime') then begin\n date := StrToDateTime(jsonObj.S[field.Name]);\n field.SetValue(Result, TValue.From(date));\n end;\n end;\n\n context.Free;\nend;\n\nend."
},
{
"path": "lib/mte/RttiTranslation.pas",
"content": "unit RttiTranslation;\n\ninterface\n\nuses\n SysUtils, Classes, StdCtrls, ComCtrls, Buttons, Menus, Rtti, TypInfo;\n\ntype\n FormPrefixAttribute = class(TCustomAttribute)\n private\n FPrefix: string;\n public\n constructor Create(const aPrefix: String);\n property Prefix: string read FPrefix write FPrefix;\n end;\n\n FormSectionAttribute = class(TCustomAttribute)\n private\n FSection: string;\n public\n constructor Create(const aSection: String);\n property Section: string read FSection write FSection;\n end;\n\n TRttiTranslation = class (TObject)\n private\n class function ReadValue(section: string; var sl: TStringList;\n field: TRttiField; subfield: string): string;\n class procedure WriteValue(section: string; value: string; var sl: TStringList;\n field: TRttiField; subfield: string);\n class function GetPrefixAttribute(Obj: TRttiObject): FormPrefixAttribute;\n class function GetSectionAttribute(Obj: TRttiObject): FormSectionAttribute;\n public\n class procedure Load(filename: string; obj: TObject); overload;\n class procedure Load(var sl: TStringList; obj: TObject); overload;\n class procedure Save(filename: string; obj: TObject);\n end;\n\nimplementation\n\n{ FormPrefixAttribute }\nconstructor FormPrefixAttribute.Create(const aPrefix: String);\nbegin\n FPrefix := aPrefix;\nend;\n\n{ FormSectionAttribute }\nconstructor FormSectionAttribute.Create(const aSection: String);\nbegin\n FSection := aSection;\nend;\n\n{ TRttiTranslation }\nclass function TRttiTranslation.GetPrefixAttribute(Obj: TRttiObject): FormPrefixAttribute;\nvar\n Attr: TCustomAttribute;\nbegin\n for Attr in Obj.GetAttributes do begin\n if Attr is FormPrefixAttribute then\n exit(FormPrefixAttribute(Attr));\n end;\n result := nil;\nend;\n\nclass function TRttiTranslation.GetSectionAttribute(Obj: TRttiObject): FormSectionAttribute;\nvar\n Attr: TCustomAttribute;\nbegin\n for Attr in Obj.GetAttributes do begin\n if Attr is FormSectionAttribute then\n exit(FormSectionAttribute(Attr));\n end;\n result := nil;\nend;\n\nclass procedure TRttiTranslation.Load(filename: string; obj: TObject);\nvar\n sl: TStringList;\nbegin\n sl := TStringList.Create;\n try\n sl.LoadFromFile(filename);\n TRttiTranslation.Load(sl, obj);\n finally\n sl.Free;\n end;\nend;\n\nclass procedure TRttiTranslation.Load(var sl: TStringList; obj: TObject);\nvar\n ctx: TRttiContext;\n objType: TRttiType;\n Field: TRttiField;\n FormPrefix: FormPrefixAttribute;\n FormSection: FormSectionAttribute;\n CurrentPrefix, CurrentSection, FieldName, value: string;\n aCheckBox: TCheckBox;\n aButton: TButton;\n aLabel: TLabel;\n aTabSheet: TTabSheet;\n aGroupBox: TGroupBox;\n aSpeedButton: TSpeedButton;\n aMenuItem: TMenuItem;\n aComboBox: TComboBox;\n aListView: TListView;\n i: Integer;\nbegin\n FormPrefix := nil;\n ctx := TRttiContext.Create;\n try\n objType := ctx.GetType(Obj.ClassInfo);\n for Field in objType.GetFields do begin\n // START BY FINDING FORM PREFIX, SKIP FIELDS UNTIL FOUND\n if not Assigned(FormPrefix) then begin\n FormPrefix := GetPrefixAttribute(Field);\n if Assigned(FormPrefix) then\n CurrentPrefix := FormPrefix.Prefix\n else\n continue;\n end;\n\n // IF FORM SECTION, DUMP SECTION\n FormSection := GetSectionAttribute(Field);\n if Assigned(FormSection) then\n CurrentSection := FormSection.Section;\n\n // SKIP ALL ITEMS IN 'DontTranslate' SECTION\n if CurrentSection = 'DontTranslate' then\n continue;\n\n // LOAD VALUES\n FieldName := Field.FieldType.Name;\n if FieldName = 'TCheckBox' then begin\n aCheckBox := TCheckBox(field.GetValue(obj).AsType);\n if Assigned(aCheckBox) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Caption');\n if value <> '' then aCheckBox.Caption := value;\n value := ReadValue(CurrentPrefix, sl, Field, 'Hint');\n aCheckBox.ShowHint := value <> '';\n if aCheckBox.ShowHint then aCheckBox.Hint := value;\n end;\n end\n else if FieldName = 'TButton' then begin\n aButton := TButton(field.GetValue(obj).AsType);\n if Assigned(aButton) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Caption');\n if value <> '' then aButton.Caption := value;\n value := ReadValue(CurrentPrefix, sl, Field, 'Hint');\n aButton.ShowHint := value <> '';\n if aButton.ShowHint then aButton.Hint := value;\n end;\n end\n else if FieldName = 'TLabel' then begin\n aLabel := TLabel(field.GetValue(obj).AsType);\n if Assigned(aLabel) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Caption');\n if value <> '' then aLabel.Caption := value;\n value := ReadValue(CurrentPrefix, sl, Field, 'Hint');\n aLabel.ShowHint := value <> '';\n if aLabel.ShowHint then aLabel.Hint := value;\n end;\n end\n else if FieldName = 'TTabSheet' then begin\n aTabSheet := TTabSheet(field.GetValue(obj).AsType);\n if Assigned(aTabSheet) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Caption');\n if value <> '' then aTabSheet.Caption := value;\n value := ReadValue(CurrentPrefix, sl, Field, 'Hint');\n aTabSheet.ShowHint := value <> '';\n if aTabSheet.ShowHint then aTabSheet.Hint := value;\n end;\n end\n else if FieldName = 'TGroupBox' then begin\n aGroupBox := TGroupBox(field.GetValue(obj).AsType);\n if Assigned(aGroupBox) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Caption');\n if value <> '' then aGroupBox.Caption := value;\n value := ReadValue(CurrentPrefix, sl, Field, 'Hint');\n aGroupBox.ShowHint := value <> '';\n if aGroupBox.ShowHint then aGroupBox.Hint := value;\n end;\n end\n else if FieldName = 'TSpeedButton' then begin\n aSpeedButton := TSpeedButton(field.GetValue(obj).AsType);\n if Assigned(aSpeedButton) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Hint');\n aSpeedButton.ShowHint := value <> '';\n if aSpeedButton.ShowHint then aSpeedButton.Hint := value;\n end;\n end\n else if FieldName = 'TMenuItem' then begin\n aMenuItem := TMenuItem(field.GetValue(obj).AsType);\n if Assigned(aMenuItem) then begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Caption');\n if value <> '' then aMenuItem.Caption := value;\n end;\n end\n else if FieldName = 'TComboBox' then begin\n aComboBox := TComboBox(field.GetValue(obj).AsType);\n if Assigned(aComboBox) then begin\n for i := 0 to Pred(aComboBox.Items.Count) do begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Item'+IntToStr(i));\n if value <> '' then aComboBox.Items[i] := value;\n end;\n end;\n end\n else if FieldName = 'TListView' then begin\n aListView := TListView(field.GetValue(obj).AsType);\n if Assigned(aListView) then begin\n if not aListView.ShowColumnHeaders then\n continue;\n for i := 0 to Pred(aListView.Columns.Count) do begin\n value := ReadValue(CurrentPrefix, sl, Field, 'Column'+IntToStr(i));\n if value <> '' then aListView.Columns[i].Caption := value;\n end;\n end;\n end;\n end;\n finally\n ctx.Free;\n end;\nend;\n\nclass function TRttiTranslation.ReadValue(section: string; var sl: TStringList;\n field: TRttiField; subfield: string): string;\nvar\n name: string;\nbegin\n // load value from stringlist\n name := Format('%s_%s_%s', [section, field.Name, subfield]);\n Result := StringReplace(sl.Values[name], '#13#10', #13#10, [rfReplaceAll]);\nend;\n\nclass procedure TRttiTranslation.WriteValue(section: string; value: string; var sl: TStringList;\n field: TRttiField; subfield: string);\nvar\n name: string;\nbegin\n if value = '' then\n exit;\n name := Format('%s_%s_%s', [section, field.Name, subfield]);\n sl.Values[name] := StringReplace(value, #13#10, '#13#10', [rfReplaceAll]);\nend;\n\nclass procedure TRttiTranslation.Save(filename: string; obj: TObject);\nvar\n ctx: TRttiContext;\n objType: TRttiType;\n Field: TRttiField;\n FormPrefix: FormPrefixAttribute;\n FormSection: FormSectionAttribute;\n sl: TStringList;\n i: Integer;\n Header, CurrentPrefix, CurrentSection, FieldName: string;\n bNewObject: boolean;\n aCheckBox: TCheckBox;\n aButton: TButton;\n aLabel: TLabel;\n aTabSheet: TTabSheet;\n aGroupBox: TGroupBox;\n aSpeedButton: TSpeedButton;\n aMenuItem: TMenuItem;\n aComboBox: TComboBox;\n aListView: TListView;\nbegin\n FormPrefix := nil;\n ctx := TRttiContext.Create;\n try\n // LOAD FILE IF IT EXISTS\n sl := TStringList.Create;\n if FileExists(filename) then\n sl.LoadFromFile(filename);\n\n // ADD HEADER IF NEW OBJECT\n Header := Format('{ %s }', [obj.ClassName]);\n bNewObject := sl.IndexOf(Header) = -1;\n if bNewObject then sl.Add(Header);\n\n try\n objType := ctx.GetType(Obj.ClassInfo);\n for Field in objType.GetFields do begin\n // START BY FINDING FORM PREFIX, SKIP FIELDS UNTIL FOUND\n if not Assigned(FormPrefix) then begin\n FormPrefix := GetPrefixAttribute(Field);\n if Assigned(FormPrefix) then\n CurrentPrefix := FormPrefix.Prefix\n else\n continue;\n end;\n\n // IF FORM SECTION, DUMP SECTION\n FormSection := GetSectionAttribute(Field);\n if Assigned(FormSection) then begin\n CurrentSection := FormSection.Section;\n if CurrentSection = 'DontTranslate' then\n continue;\n Header := Format('{ ## %s ## }', [FormSection.Section]);\n if (sl.IndexOf(Header) = -1) then sl.Add(Header);\n end;\n\n // SKIP ALL ITEMS IN 'DontTranslate' SECTION\n if CurrentSection = 'DontTranslate' then\n continue;\n\n // HANDLE COMPONENTS\n FieldName := Field.FieldType.Name;\n // Handle TCheckBox\n if FieldName = 'TCheckBox' then begin\n aCheckBox := TCheckBox(field.GetValue(obj).AsType);\n if Assigned(aCheckBox) then begin\n WriteValue(CurrentPrefix, aCheckBox.Caption, sl, field, 'Caption');\n WriteValue(CurrentPrefix, aCheckBox.Hint, sl, field, 'Hint');\n end;\n end\n // Handle TButton\n else if FieldName = 'TButton' then begin\n aButton := TButton(field.GetValue(obj).AsType);\n if Assigned(aButton) then begin\n WriteValue(CurrentPrefix, aButton.Caption, sl, field, 'Caption');\n WriteValue(CurrentPrefix, aButton.Hint, sl, field, 'Hint');\n end;\n end\n // Handle TLabel\n else if FieldName = 'TLabel' then begin\n aLabel := TLabel(field.GetValue(obj).AsType);\n if Assigned(aLabel) then begin\n WriteValue(CurrentPrefix, aLabel.Caption, sl, field, 'Caption');\n WriteValue(CurrentPrefix, aLabel.Hint, sl, field, 'Hint');\n end;\n end\n // Handle TTabSheet\n else if FieldName = 'TTabSheet' then begin\n aTabSheet := TTabSheet(field.GetValue(obj).AsType);\n if Assigned(aTabSheet) then begin\n WriteValue(CurrentPrefix, aTabSheet.Caption, sl, field, 'Caption');\n WriteValue(CurrentPrefix, aTabSheet.Hint, sl, field, 'Hint');\n end;\n end\n // Handle TGroupBox\n else if FieldName = 'TGroupBox' then begin\n aGroupBox := TGroupBox(field.GetValue(obj).AsType);\n if Assigned(aGroupBox) then begin\n WriteValue(CurrentPrefix, aGroupBox.Caption, sl, field, 'Caption');\n WriteValue(CurrentPrefix, aGroupBox.Hint, sl, field, 'Hint');\n end;\n end\n // Handle TSpeedButton\n else if FieldName = 'TSpeedButton' then begin\n aSpeedButton := TSpeedButton(field.GetValue(obj).AsType);\n if Assigned(aSpeedButton) then begin\n WriteValue(CurrentPrefix, aSpeedButton.Caption, sl, field, 'Caption');\n WriteValue(CurrentPrefix, aSpeedButton.Hint, sl, field, 'Hint');\n end;\n end\n // Handle TMenuItem\n else if FieldName = 'TMenuItem' then begin\n aMenuItem := TMenuItem(field.GetValue(obj).AsType);\n if Assigned(aMenuItem) then\n WriteValue(CurrentPrefix, aMenuItem.Caption, sl, field, 'Caption');\n end\n // Handle TComboBox\n else if FieldName = 'TComboBox' then begin\n aComboBox := TComboBox(field.GetValue(obj).AsType);\n if Assigned(aComboBox) then\n for i := 0 to Pred(aComboBox.Items.Count) do\n WriteValue(CurrentPrefix, aComboBox.Items[i], sl, field, 'Item'+IntToStr(i));\n end\n // Handle TListView\n else if FieldName = 'TListView' then begin\n aListView := TListView(field.GetValue(obj).AsType);\n if Assigned(aListView) then begin\n if not aListView.ShowColumnHeaders then\n continue;\n for i := 0 to Pred(aListView.Columns.Count) do\n WriteValue(CurrentPrefix, aListView.Columns[i].Caption, sl, field, 'Column'+IntToStr(i));\n end;\n end;\n end;\n finally\n if bNewObject then sl.Add(' ');\n ForceDirectories(ExtractFilePath(filename));\n sl.SaveToFile(fileName);\n sl.Free;\n end;\n finally\n ctx.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/mte/W7Taskbar.pas",
"content": "unit W7Taskbar;\n\ninterface\n\nuses\n Forms, Types, Windows, SysUtils, ComObj, Controls, Graphics;\n\ntype\n TTaskBarProgressState = (tbpsNone, tbpsIndeterminate, tbpsNormal, tbpsError,\n tbpsPaused);\n\n function InitializeTaskbarAPI: boolean;\n function SetTaskbarProgressState(const AState: TTaskBarProgressState): boolean;\n function SetTaskbarProgressValue(const ACurrent: UInt64; const AMax: UInt64): boolean;\n function SetTaskbarOverlayIcon(const AIcon: THandle; const ADescription: String): boolean;\n\nimplementation\n\nconst\n TASKBAR_CID: TGUID = '{56FDF344-FD6D-11d0-958A-006097C9A090}';\n TBPF_NOPROGRESS = 0;\n TBPF_INDETERMINATE = 1;\n TBPF_NORMAL = 2;\n TBPF_ERROR = 4;\n TBPF_PAUSED = 8;\n\ntype\n ITaskBarList3 = interface(IUnknown)\n ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}']\n function HrInit(): HRESULT; stdcall;\n function AddTab(hwnd: THandle): HRESULT; stdcall;\n function DeleteTab(hwnd: THandle): HRESULT; stdcall;\n function ActivateTab(hwnd: THandle): HRESULT; stdcall;\n function SetActiveAlt(hwnd: THandle): HRESULT; stdcall;\n function MarkFullscreenWindow(hwnd: THandle; fFullscreen: Boolean): HRESULT; stdcall;\n function SetProgressValue(hwnd: THandle; ullCompleted: UInt64; ullTotal: UInt64): HRESULT; stdcall;\n function SetProgressState(hwnd: THandle; tbpFlags: Cardinal): HRESULT; stdcall;\n function RegisterTab(hwnd: THandle; hwndMDI: THandle): HRESULT; stdcall;\n function UnregisterTab(hwndTab: THandle): HRESULT; stdcall;\n function SetTabOrder(hwndTab: THandle; hwndInsertBefore: THandle): HRESULT; stdcall;\n function SetTabActive(hwndTab: THandle; hwndMDI: THandle; tbatFlags: Cardinal): HRESULT; stdcall;\n function ThumbBarAddButtons(hwnd: THandle; cButtons: Cardinal; pButtons: Pointer): HRESULT; stdcall;\n function ThumbBarUpdateButtons(hwnd: THandle; cButtons: Cardinal; pButtons: Pointer): HRESULT; stdcall;\n function ThumbBarSetImageList(hwnd: THandle; himl: THandle): HRESULT; stdcall;\n function SetOverlayIcon(hwnd: THandle; hIcon: THandle; pszDescription: PChar): HRESULT; stdcall;\n function SetThumbnailTooltip(hwnd: THandle; pszDescription: PChar): HRESULT; stdcall;\n function SetThumbnailClip(hwnd: THandle; var prcClip: TRect): HRESULT; stdcall;\n end;\n\nvar\n TaskBarInterface: ITaskBarList3;\n\nfunction InitializeTaskbarAPI: Boolean;\nvar\n Unknown: IInterface;\n Temp: ITaskBarList3;\nbegin\n // return true and exit if already initialized\n if Assigned(TaskBarInterface) then begin\n Result := True;\n Exit;\n end;\n\n // create COM object for taskbar CID\n try\n Unknown := CreateComObject(TASKBAR_CID);\n if Assigned(Unknown) then begin\n Temp := Unknown as ITaskBarList3;\n if Temp.HrInit() = S_OK then\n TaskBarInterface := Temp;\n end;\n except\n TaskBarInterface := nil;\n end;\n\n // if we got the interface, return true\n Result := Assigned(TaskBarInterface);\nend;\n\n{ Check to see if the API has been initialized }\nfunction CheckAPI: boolean;\nbegin\n Result := Assigned(TaskBarInterface);\nend;\n\nfunction SetTaskbarProgressState(const AState: TTaskBarProgressState): boolean;\nvar\n Flag: Cardinal;\nbegin\n Result := False;\n\n // exit if api not initialized\n if not CheckAPI then\n exit;\n\n // check if state is valid, else use no progress\n case AState of\n tbpsIndeterminate: Flag := TBPF_INDETERMINATE;\n tbpsNormal: Flag := TBPF_NORMAL;\n tbpsError: Flag := TBPF_ERROR;\n tbpsPaused: Flag := TBPF_PAUSED;\n else\n Flag := TBPF_NOPROGRESS;\n end;\n\n // set progress state\n Result := TaskBarInterface.SetProgressState(Application.Handle, Flag) = S_OK;\nend;\n\nfunction SetTaskbarProgressValue(const ACurrent:UInt64; const AMax: UInt64): boolean;\nbegin\n Result := False;\n\n // exit if api not initialized\n if not CheckAPI then\n exit;\n\n // set progress value\n Result := TaskBarInterface.SetProgressValue(Application.Handle, ACurrent, AMax) = S_OK;\nend;\n\nfunction SetTaskbarOverlayIcon(const AIcon: THandle; const ADescription: String): boolean;\nbegin\n Result := False;\n\n // exit if api not initialized\n if not CheckAPI then\n exit;\n\n // set icon\n Result := TaskBarInterface.SetOverlayIcon(Application.Handle, AIcon, PWideChar(ADescription)) = S_OK;\nend;\n\ninitialization\n TaskBarInterface := nil;\n\nfinalization\n TaskBarInterface := nil;\n\nend.\n"
},
{
"path": "lib/mte/mteBase.pas",
"content": "unit mteBase;\n\ninterface\n\nuses\n Classes, Menus,\n // third party libraries\n superobject,\n // mte units\n mteTracker,\n // xEdit units\n wbHelpers, wbInterface, wbImplementation;\n\ntype\n TSmashType = ( stUnknown, stRecord, stString, stInteger, stFlag, stFloat,\n stStruct, stUnsortedArray, stUnsortedStructArray, stSortedArray,\n stSortedStructArray, stByteArray, stUnion );\n TBasePlugin = class(TObject)\n public\n _File: IwbFile;\n hasData: boolean;\n hash: string;\n fileSize: Int64;\n dateModified: string;\n filename: string;\n numRecords: Integer;\n numOverrides: Integer;\n author: string;\n dataPath: string;\n description: TStringList;\n masters: TStringList;\n requiredBy: TStringList;\n constructor Create; virtual;\n destructor Destroy; override;\n procedure GetData(var lst: TList);\n procedure UpdateData; virtual;\n procedure GetHash;\n function GetFormIndex: Integer;\n end;\n TPluginHelpers = class\n class function CreateNewBasePlugin(var list: TList; filename: string): TBasePlugin;\n class function BasePluginByFilename(var list: TList; filename: string): TBasePlugin;\n class function BasePluginLoadOrder(var list: TList; filename: string): integer;\n end;\n THeaderHelpers = class\n class procedure LoadPluginHeaders(var sl: TStringList);\n class procedure GetPluginMasters(filename: string; var sl: TStringList);\n class procedure GetPluginDependencies(filename: string; var sl: TStringList);\n end;\n\n { General Helper Functions }\n function etToString(et: TwbElementType): string;\n function dtToString(dt: TwbDefType): string;\n function ctToString(ct: TConflictThis): string;\n function stToString(st: TSmashType): string;\n function SmashType(def: IwbNamedDef): TSmashtype;\n function GetSmashType(element: IwbElement): TSmashType;\n function ElementByIndexedPath(e: IwbElement; ip: string): IwbElement;\n function IndexedPath(e: IwbElement): string;\n function GetAllValues(e: IwbElement): string;\n function IsSortedDef(def: IwbNamedDef): boolean;\n function IsSorted(e: IwbElement): boolean;\n function HasStructChildren(e: IwbElement): boolean;\n function HasStructChildrenDef(def: IwbNamedDef): boolean;\n function WinningOverrideInFiles(rec: IwbMainRecord;\n var sl: TStringList): IwbMainRecord;\n function IsOverride(aRecord: IwbMainRecord): boolean;\n function ExtractFormID(filename: string): string;\n function RemoveFileIndex(formID: string): string;\n function LocalFormID(aRecord: IwbMainRecord): integer;\n function LoadOrderPrefix(aRecord: IwbMainRecord): integer;\n function CountOverrides(aFile: IwbFile): integer;\n function OverrideCountInFiles(rec: IwbMainRecord; var files: TStringList): Integer;\n procedure AddRequiredBy(var lst: TList; filename: string;\n var masters: TStringList);\n procedure GetMasters(aFile: IwbFile; var sl: TStringList);\n procedure AddMasters(aFile: IwbFile; var sl: TStringList);\n function RemoveSelfOrContainer(const aElement: IwbElement): boolean;\n procedure UndeleteAndDisable(const aRecord: IwbMainRecord);\n function LoadOrderCompare(List: TStringList; Index1, Index2: Integer): Integer;\n\n { Record Prototyping Functions }\n function GetElementObj(var obj: ISuperObject; name: string): ISuperObject;\n function CreateRecordObj(var tree: ISuperObject; rec: IwbMainRecord): ISuperObject;\n function GetRecordObj(var tree: ISuperObject; name: string): ISuperObject;\n function GetRecordDef(sig: TwbSignature): TwbRecordDefEntry;\n function BuildDef(def: IwbNamedDef; name: string): ISuperObject;\n function BuildRecordDef(sName: string; mrDef: IwbRecordDef; out recObj: ISuperObject): boolean; overload;\n function BuildRecordDef(sName: string; out recObj: ISuperObject): boolean; overload;\n function GetEditableFileContainer: IwbContainerElementRef;\n\n { Plugin Error Functions }\n function FixErrors(const aElement: IwbElement; lastRecord: IwbMainRecord;\n var errors: TStringList): IwbMainRecord;\n function CheckForErrors(const aElement: IwbElement; lastRecord: IwbMainRecord;\n var errors: TStringList): IwbMainRecord;\n\n { Asset Handling Functions }\n procedure ExtractBSA(ContainerName, folder, destination: string); overload;\n procedure ExtractBSA(ContainerName, destination: string; var ignore: TStringList); overload;\n function BSAExists(filename: string): boolean;\n function INIExists(filename: string): boolean;\n function TranslationExists(filename: string): boolean;\n function FaceDataExists(filename: string): boolean;\n function VoiceDataExists(filename: string): boolean;\n function FragmentsExist(f: IwbFile): boolean;\n function ReferencesSelf(f: IwbFile): boolean;\n\nvar\n PluginsList: TList;\n HeaderList: TList;\n\nimplementation\n\nuses\n SysUtils, Dialogs,\n mteHelpers,\n msConfiguration;\n\nconstructor TBasePlugin.Create;\nbegin\n hasData := false;\n dataPath := wbDataPath;\n description := TStringList.Create;\n masters := TStringList.Create;\n requiredBy := TStringList.Create;\nend;\n\ndestructor TBasePlugin.Destroy;\nbegin\n description.Free;\n masters.Free;\n requiredBy.Free;\nend;\n\nprocedure TBasePlugin.GetData(var lst: TList);\nvar\n Container: IwbContainer;\n s: string;\nbegin\n hasData := true;\n\n // get data\n filename := _File.FileName;\n Container := _File as IwbContainer;\n Container := Container.Elements[0] as IwbContainer;\n author := Container.GetElementEditValue('CNAM - Author');\n // we have to subtract 1 because this count includes the\n // file header for some reason\n numRecords := Container.GetElementNativeValue('HEDR - Header\\Number of Records') - 1;\n\n // get masters, required by\n GetMasters(_File, masters);\n AddRequiredBy(lst, filename, masters);\n\n // get description\n s := Container.GetElementEditValue('SNAM - Description');\n description.Text := Wordwrap(s, 80);\n\n // get file attributes\n fileSize := GetFileSize(wbDataPath + filename);\n dateModified := DateTimeToStr(GetLastModified(wbDataPath + filename));\nend;\n\nprocedure TBasePlugin.UpdateData;\nbegin\n // virtual method to be overridden\nend;\n\nprocedure TBasePlugin.GetHash;\nbegin\n hash := IntToHex(wbCRC32File(wbDataPath + filename), 8);\nend;\n\nfunction TBasePlugin.GetFormIndex: Integer;\nvar\n Container, MasterFiles: IwbContainer;\nbegin\n Result := 0;\n Container := self._File as IwbContainer;\n Container := Container.Elements[0] as IwbContainer;\n if Container.ElementExists['Master Files'] then begin\n MasterFiles := Container.ElementByPath['Master Files'] as IwbContainer;\n Result := MasterFiles.ElementCount;\n end;\nend;\n\n\n{*****************************************************************************}\n{ PLUGIN HELPERS\n Helper methods for dealing with TBasePlugins.\n}\n{*****************************************************************************}\n\n{ Create a new plugin }\nclass function TPluginHelpers.CreateNewBasePlugin(var list: TList; filename: string): TBasePlugin;\nvar\n aFile: IwbFile;\n LoadOrder: integer;\n plugin: TBasePlugin;\nbegin\n Result := nil;\n LoadOrder := PluginsList.Count + 1;\n // fail if maximum load order reached\n if LoadOrder > 254 then begin\n Tracker.Write('Maximum load order reached! Can''t create file '+filename);\n exit;\n end;\n\n // create new plugin file\n SysUtils.FormatSettings.DecimalSeparator := '.';\n aFile := wbNewFile(wbDataPath + filename, LoadOrder);\n aFile._AddRef;\n\n // create new plugin object\n plugin := TBasePlugin.Create;\n plugin.filename := filename;\n plugin._File := aFile;\n Result := plugin;\nend;\n\n{ Gets the load order of the plugin matching the given name }\nclass function TPluginHelpers.BasePluginLoadOrder(var list: TList; filename: string): integer;\nvar\n i: integer;\n plugin: TBasePlugin;\nbegin\n Result := -1;\n for i := 0 to Pred(list.Count) do begin\n plugin := TBasePlugin(list[i]);\n if plugin.filename = filename then begin\n Result := i;\n exit;\n end;\n end;\nend;\n\n{ Gets a plugin matching the given name. }\nclass function TPluginHelpers.BasePluginByFilename(var list: TList; filename: string): TBasePlugin;\nvar\n i: integer;\n plugin: TBasePlugin;\nbegin\n Result := nil;\n for i := 0 to Pred(list.count) do begin\n plugin := TBasePlugin(list[i]);\n if plugin.filename = filename then begin\n Result := plugin;\n exit;\n end;\n end;\nend;\n\nclass procedure THeaderHelpers.LoadPluginHeaders(var sl: TStringList);\nvar\n i: Integer;\n aFile: IwbFile;\n plugin: TBasePlugin;\nbegin\n // create header list\n HeaderList := TList.Create;\n\n // load plugin headers for each plugin in @sl\n for i := 0 to Pred(sl.Count) do try\n aFile := wbFile(wbDataPath + sl[i], -1, '', False, True);\n plugin := TBasePlugin.Create;\n plugin._File := aFile;\n HeaderList.Add(plugin);\n except\n on x: Exception do begin\n Tracker.Write('Failed to load '+sl[i]);\n end;\n end;\n\n // get data for each plugin in the header list\n for i := 0 to Pred(HeaderList.Count) do begin\n plugin := TBasePlugin(HeaderList[i]);\n plugin.GetData(HeaderList);\n end;\nend;\n\nclass procedure THeaderHelpers.GetPluginMasters(filename: string;\n var sl: TStringList);\nvar\n plugin: TBasePlugin;\n i: integer;\nbegin\n // get plugin\n plugin := TPluginHelpers.BasePluginByFilename(HeaderList, filename);\n if not Assigned(plugin) then exit;\n // add its masters to @sl\n for i := 0 to Pred(plugin.masters.Count) do begin\n if sl.IndexOf(plugin.masters[i]) > -1 then continue;\n sl.Add(plugin.masters[i]);\n GetPluginMasters(plugin.masters[i], sl);\n end;\nend;\n\nclass procedure THeaderHelpers.GetPluginDependencies(filename: string;\n var sl: TStringList);\nvar\n plugin: TBasePlugin;\n i: integer;\nbegin\n // get plugin\n plugin := TPluginHelpers.BasePluginByFilename(HeaderList, filename);\n if not Assigned(plugin) then exit;\n // add its required by to @sl\n for i := 0 to Pred(plugin.requiredBy.Count) do begin\n if sl.IndexOf(plugin.requiredBy[i]) > -1 then continue;\n sl.Add(plugin.requiredBy[i]);\n GetPluginDependencies(plugin.requiredBy[i], sl);\n end;\nend;\n\n\n{******************************************************************************}\n{ General Helper Functions\n Set of functions that read bethesda plugin files for various attributes.\n\n List of functions:\n - etToString\n - dtToString\n - ctToString\n - stToString\n - GetSmashType\n - ElementByIndexedPath\n - IndexedPath\n - GetAllValues\n - IsSorted\n - HasStructChildren\n - WinningOverrideInFiles\n - IsOverride\n - LocalFormID\n -LoadOrderPrefix\n - CountOverrides\n - GetMasters\n - AddMasters\n - BSAExists\n - TranslationExists\n - FaceDataExists\n - VoiceDataExists\n - FragmentsExist\n - ExtractBSA\n - CheckForErorrsLinear\n - CheckForErrors\n - PluginsModified\n - CreatSEQFile\n}\n{*****************************************************************************}\n\n{ Converts a TwbElementType to a string }\nfunction etToString(et: TwbElementType): string;\nbegin\n case Ord(et) of\n Ord(etFile): Result := 'etFile';\n Ord(etMainRecord): Result := 'etMainRecord';\n Ord(etGroupRecord): Result := 'etGroupRecord';\n Ord(etSubRecord): Result := 'etSubRecord';\n Ord(etSubRecordStruct): Result := 'etSubRecordStruct';\n Ord(etSubRecordArray): Result := 'etSubRecordArray';\n Ord(etSubRecordUnion): Result := 'etSubRecordUnion';\n Ord(etArray): Result := 'etArray';\n Ord(etStruct): Result := 'etStruct';\n Ord(etValue): Result := 'etValue';\n Ord(etFlag): Result := 'etFlag';\n Ord(etStringListTerminator): Result := 'etStringListTerminator';\n Ord(etUnion): Result := 'etUnion';\n end;\nend;\n\n{ Converts a TwbDefType to a string }\nfunction dtToString(dt: TwbDefType): string;\nbegin\n case Ord(dt) of\n Ord(dtRecord): Result := 'dtRecord';\n Ord(dtSubRecord): Result := 'dtSubRecord';\n Ord(dtSubRecordArray): Result := 'dtSubRecordArray';\n Ord(dtSubRecordStruct): Result := 'dtSubRecordStruct';\n Ord(dtSubRecordUnion): Result := 'dtSubRecordUnion';\n Ord(dtString): Result := 'dtString';\n Ord(dtLString): Result := 'dtLString';\n Ord(dtLenString): Result := 'dtLenString';\n Ord(dtByteArray): Result := 'dtByteArray';\n Ord(dtInteger): Result := 'dtInteger';\n Ord(dtIntegerFormater): Result := 'dtIntegerFormatter';\n Ord(dtFloat): Result := 'dtFloat';\n Ord(dtArray): Result := 'dtArray';\n Ord(dtStruct): Result := 'dtStruct';\n Ord(dtUnion): Result := 'dtUnion';\n Ord(dtEmpty): Result := 'dtEmpty';\n end;\nend;\n\nfunction ctToString(ct: TConflictThis): string;\nbegin\n case Ord(ct) of\n Ord(ctUnknown): Result := 'ctUnknown';\n Ord(ctIgnored): Result := 'ctIgnored';\n Ord(ctNotDefined): Result := 'ctNotDefined';\n Ord(ctIdenticalToMaster): Result := 'ctIdenticalToMaster';\n Ord(ctOnlyOne): Result := 'ctOnlyOne';\n Ord(ctHiddenByModGroup): Result := 'ctHiddenByModGroup';\n Ord(ctMaster): Result := 'ctMaster';\n Ord(ctConflictBenign): Result := 'ctConflictBenign';\n Ord(ctOverride): Result := 'ctOverride';\n Ord(ctIdenticalToMasterWinsConflict): Result := 'ctIdenticalToMasterWinsConflict';\n Ord(ctConflictWins): Result := 'ctConflictWins';\n Ord(ctConflictLoses): Result := 'ctConflictLoses';\n end;\nend;\n\nfunction stToString(st: TSmashType): string;\nbegin\n case Ord(st) of\n Ord(stUnknown): Result := 'Unknown';\n Ord(stRecord): Result := 'Record';\n Ord(stString): Result := 'String';\n Ord(stInteger): Result := 'Integer';\n Ord(stFlag): Result := 'Flag';\n Ord(stFloat): Result := 'Float';\n Ord(stStruct): Result := 'Struct';\n Ord(stUnsortedArray): Result := 'Unsorted Array';\n Ord(stUnsortedStructArray): Result := 'Unsorted Struct Array';\n Ord(stSortedArray): Result := 'Sorted Array';\n Ord(stSortedStructArray): Result := 'Sorted Struct Array';\n Ord(stByteArray): Result := 'Byte Array';\n Ord(stUnion): Result := 'Union';\n else Result := 'Unknown';\n end;\nend;\n\nfunction SmashType(def: IwbNamedDef): TSmashtype;\nvar\n subDef: IwbSubRecordDef;\n dt: TwbDefType;\n bIsSorted, bHasStructChildren: boolean;\nbegin\n dt := def.DefType;\n if Supports(def, IwbSubrecordDef, subDef) then\n dt := subDef.GetValue.DefType;\n case Ord(dt) of\n Ord(dtRecord): Result := stRecord;\n Ord(dtSubRecord): Result := stUnknown;\n Ord(dtSubRecordStruct): Result := stStruct;\n Ord(dtSubRecordUnion): Result := stUnion;\n Ord(dtString): Result := stString;\n Ord(dtLString): Result := stString;\n Ord(dtLenString): Result := stString;\n Ord(dtByteArray): Result := stByteArray;\n Ord(dtInteger): Result := stInteger;\n Ord(dtIntegerFormater): Result := stInteger;\n Ord(dtIntegerFormaterUnion): Result := stInteger;\n Ord(dtFlag): Result := stFlag;\n Ord(dtFloat): Result := stFloat;\n Ord(dtSubRecordArray), Ord(dtArray): begin\n bIsSorted := IsSortedDef(def);\n bHasStructChildren := HasStructChildrenDef(def);\n if bIsSorted then begin\n if bHasStructChildren then\n Result := stSortedStructArray\n else\n Result := stSortedArray;\n end\n else begin\n if bHasStructChildren then\n Result := stUnsortedStructArray\n else\n Result := stUnsortedArray;\n end;\n end;\n Ord(dtStruct): Result := stStruct;\n Ord(dtUnion): Result := stUnion;\n Ord(dtEmpty): Result := stUnknown;\n Ord(dtStructChapter): Result := stStruct;\n else Result := stUnknown;\n end;\nend;\n\nfunction GetSmashType(element: IwbElement): TSmashType;\nbegin\n Result := SmashType(element.Def);\nend;\n\nfunction ElementByIndexedPath(e: IwbElement; ip: string): IwbElement;\nvar\n i, index: integer;\n path: TStringList;\n c: IwbContainerElementRef;\nbegin\n // replace forward slashes with backslashes\n ip := StringReplace(ip, '/', '\\', [rfReplaceAll]);\n\n // prepare path stringlist delimited by backslashes\n path := TStringList.Create;\n path.Delimiter := '\\';\n path.StrictDelimiter := true;\n path.DelimitedText := ip;\n\n // treat e as a container\n if not Supports(e, IwbContainerElementRef, c) then\n exit;\n\n // traverse path\n for i := 0 to Pred(path.count) do begin\n if Pos('[', path[i]) > 0 then begin\n index := StrToInt(GetTextIn(path[i], '[', ']'));\n e := c.Elements[index];\n if not Supports(e, IwbContainerElementRef, c) then\n exit;\n end\n else begin\n e := c.ElementByPath[path[i]];\n if not Supports(e, IwbContainerElementRef, c) then\n exit;\n end;\n end;\n\n // set result\n Result := e;\nend;\n\nfunction IndexedPath(e: IwbElement): string;\nvar\n c: IwbContainer;\n a: string;\nbegin\n c := e.Container;\n while (e.ElementType <> etMainRecord) do begin\n if c.ElementType = etSubRecordArray then\n a := '['+IntToStr(c.IndexOf(e))+']'\n else\n a := e.Name;\n if Result <> '' then\n Result := a + '\\' + Result\n else\n Result := a;\n e := c;\n c := e.Container;\n end;\nend;\n\n{ Returns a string hash of all of the values contained in an element }\nfunction GetAllValues(e: IwbElement): string;\nvar\n i: integer;\n c: IwbContainerElementRef;\nbegin\n Result := e.EditValue;\n if not Supports(e, IwbContainerElementRef, c) then\n exit;\n\n // loop through children elements\n for i := 0 to Pred(c.ElementCount) do begin\n if (Result <> '') then\n Result := Result + ';' + GetAllValues(c.Elements[i])\n else\n Result := GetAllValues(c.Elements[i]);\n end;\nend;\n\nfunction IsSortedDef(def: IwbNamedDef): boolean;\nvar\n sraDef: IwbSubRecordArrayDef;\n arDef: IwbArrayDef;\nbegin\n Result := false;\n if Supports(def, IwbSubRecordArrayDef, sraDef) then\n Result := Supports(sraDef.Element, IwbHasSortKeyDef)\n else if Supports(def, IwbArrayDef, arDef) then\n Result := Supports(arDef.Element, IwbHasSortKeyDef);\nend;\n\n{ Returns true if @e is a sorted container }\nfunction IsSorted(e: IwbElement): boolean;\nvar\n Container: IwbSortableContainer;\nbegin\n Result := false;\n if Supports(e, IwbSortableContainer, Container) then\n Result := Container.Sorted;\nend;\n\nfunction HasStructChildrenDef(def: IwbNamedDef): boolean;\nbegin\n Result := Supports(def, IwbSubRecordArrayDef);\nend;\n\n{ Returns true if @e is a container with struct children }\nfunction HasStructChildren(e: IwbElement): boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := false;\n if Supports(e, IwbContainerElementRef, Container)\n and (Container.ElementCount > 0) then\n Result := GetSmashType(Container.Elements[0]) = stStruct;\nend;\n\n{ Returns the most-winning override of @rec from the\n files listed in @sl }\nfunction WinningOverrideInFiles(rec: IwbMainRecord;\n var sl: TStringList): IwbMainRecord;\nvar\n i: Integer;\n ovr: IwbMainRecord;\nbegin\n Result := rec;\n for i := Pred(rec.OverrideCount) downto 0 do begin\n ovr := rec.Overrides[i];\n if sl.IndexOf(ovr._file.FileName) > -1 then begin\n Result := ovr;\n exit;\n end;\n end;\nend;\n\n{ Returns true if the input record is an override record }\nfunction IsOverride(aRecord: IwbMainRecord): boolean;\nbegin\n Result := not aRecord.IsMaster;\nend;\n\nfunction ExtractFormID(filename: string): string;\nconst\n HexChars = ['0'..'9', 'A'..'F', 'a'..'f'];\nvar\n i, counter: Integer;\nbegin\n counter := 0;\n // we loop from the back because the formID is usually at the\n // end of the filename\n for i := Length(filename) downto 1 do begin\n if (filename[i] in HexChars) then\n Inc(counter)\n else\n counter := 0;\n // set result and exit if counter has reached 8\n if counter = 8 then begin\n Result := Copy(filename, i, 8);\n exit;\n end;\n end;\nend;\n\nfunction RemoveFileIndex(formID: string): string;\nbegin\n if Length(formID) <> 8 then\n raise Exception.Create('RemoveFileIndex: FormID must be 8 characters long');\n Result := '00' + Copy(formID, 3, 6);\nend;\n\n{ Gets the local formID of a record (so no load order prefix) }\nfunction LocalFormID(aRecord: IwbMainRecord): integer;\nbegin\n Result := aRecord.LoadOrderFormID and $00FFFFFF;\nend;\n\n{ Gets the load order prefix from the FormID of a record }\nfunction LoadOrderPrefix(aRecord: IwbMainRecord): integer;\nbegin\n Result := aRecord.LoadOrderFormID and $FF000000;\nend;\n\n{ Returns the number of override records in a file }\nfunction CountOverrides(aFile: IwbFile): integer;\nvar\n i: Integer;\n aRecord: IwbMainRecord;\nbegin\n Result := 0;\n for i := 0 to Pred(aFile.GetRecordCount) do begin\n aRecord := aFile.GetRecord(i);\n if IsOverride(aRecord) then\n Inc(Result);\n end;\nend;\n\n{ Returns the number of overrides of the specified record in the specified file set }\nfunction OverrideCountInFiles(rec: IwbMainRecord; var files: TStringList): Integer;\nvar\n i: Integer;\n ovr: IwbMainRecord;\nbegin\n Result := 0;\n for i := 0 to Pred(rec.OverrideCount) do begin\n ovr := rec.Overrides[i];\n if files.IndexOf(ovr._File.FileName) > -1 then\n Inc(Result);\n end;\nend;\n\n{ Populates required by field of @masters that are required by plugin\n @filename }\nprocedure AddRequiredBy(var lst: TList; filename: string;\n var masters: TStringList);\nvar\n i: Integer;\n plugin: TBasePlugin;\nbegin\n for i := 0 to Pred(masters.Count) do begin\n plugin := TPluginHelpers.BasePluginByFilename(lst, masters[i]);\n if not Assigned(plugin) then\n continue;\n plugin.requiredBy.Add(filename);\n end;\nend;\n\n{ Gets the masters in an IwbFile and puts them into a stringlist }\nprocedure GetMasters(aFile: IwbFile; var sl: TStringList);\nvar\n Container, MasterFiles, MasterFile: IwbContainer;\n i, iLoadOrder: integer;\n filename: string;\nbegin\n Container := aFile as IwbContainer;\n Container := Container.Elements[0] as IwbContainer;\n if Container.ElementExists['Master Files'] then begin\n MasterFiles := Container.ElementByPath['Master Files'] as IwbContainer;\n for i := 0 to MasterFiles.ElementCount - 1 do begin\n MasterFile := MasterFiles.Elements[i] as IwbContainer;\n filename := MasterFile.GetElementEditValue('MAST - Filename');\n if sl.IndexOf(filename) = -1 then begin\n iLoadOrder := TPluginHelpers.BasePluginLoadOrder(PluginsList, filename);\n sl.AddObject(filename, TObject(iLoadOrder));\n end;\n end;\n end;\nend;\n\n{ Gets the masters in an IwbFile and puts them into a stringlist }\nprocedure AddMasters(aFile: IwbFile; var sl: TStringList);\nvar\n i: integer;\nbegin\n for i := 0 to Pred(sl.Count) do begin\n if Lowercase(aFile.FileName) = Lowercase(sl[i]) then\n continue;\n aFile.AddMasterIfMissing(sl[i]);\n end;\nend;\n\n{ Checks if a BSA exists associated with the given filename }\nfunction BSAExists(filename: string): boolean;\nvar\n bsaFilename, ContainerName: string;\nbegin\n Result := false;\n bsaFilename := ChangeFileExt(filename, '.bsa');\n if FileExists(wbDataPath + bsaFilename) then begin\n ContainerName := wbDataPath + bsaFilename;\n if not wbContainerHandler.ContainerExists(ContainerName) then\n wbContainerHandler.AddBSA(ContainerName);\n Result := true;\n end;\nend;\n\n{ Check if an INI exists associated with the given filename }\nfunction INIExists(filename: string): boolean;\nvar\n iniFilename: string;\nbegin\n iniFilename := ChangeFileExt(filename, '.ini');\n Result := FileExists(wbDataPath + iniFilename);\nend;\n\n{ Returns true if a file exists at @path matching @filename }\nfunction MatchingFileExists(path: string; filename: string): boolean;\nvar\n info: TSearchRec;\nbegin\n Result := false;\n filename := Lowercase(filename);\n if FindFirst(path, faAnyFile, info) = 0 then begin\n repeat\n if Pos(filename, Lowercase(info.Name)) > 0 then begin\n Result := true;\n exit;\n end;\n until FindNext(info) <> 0;\n FindClose(info);\n end;\nend;\n\n{ Return true if MCM translation files for @filename are found }\nfunction TranslationExists(filename: string): boolean;\nvar\n searchPath, bsaFilename, ContainerName: string;\n ResourceList: TStringList;\nbegin\n searchPath := wbDataPath + 'Interface\\translations\\*';\n Result := MatchingFileExists(searchPath, ChangeFileExt(filename, ''));\n if Result then exit;\n\n // check in BSA\n if BSAExists(filename) then begin\n bsaFilename := ChangeFileExt(filename, '.bsa');\n ContainerName := wbDataPath + bsaFilename;\n ResourceList := TStringList.Create;\n wbContainerHandler.ContainerResourceList(ContainerName, ResourceList, 'Interface\\translations');\n Result := ResourceList.Count > 0;\n end;\nend;\n\n{ Return true if file-specific FaceGenData files for @filename are found }\nfunction FaceDataExists(filename: string): boolean;\nvar\n facetintDir, facegeomDir, bsaFilename, ContainerName: string;\n ResourceList: TStringList;\n facetint, facegeom: boolean;\nbegin\n facetintDir := 'textures\\actors\\character\\facegendata\\facetint\\' + filename;\n facegeomDir := 'meshes\\actors\\character\\facegendata\\facegeom\\' + filename;\n facetint := DirectoryExists(wbDataPath + facetintDir);\n facegeom := DirectoryExists(wbDataPath + facegeomDir);\n Result := facetint or facegeom;\n if Result then exit;\n\n // check in BSA\n if BSAExists(filename) then begin\n bsaFilename := ChangeFileExt(filename, '.bsa');\n ContainerName := wbDataPath + bsaFilename;\n ResourceList := TStringList.Create;\n wbContainerHandler.ContainerResourceList(ContainerName, ResourceList, facetintDir);\n wbContainerHandler.ContainerResourceList(ContainerName, ResourceList, facegeomDir);\n Result := ResourceList.Count > 0;\n end;\nend;\n\n{ Return true if file-specific Voice files for @filename are found }\nfunction VoiceDataExists(filename: string): boolean;\nvar\n voiceDir, bsaFilename, ContainerName: string;\n ResourceList: TStringList;\nbegin\n voiceDir := 'sound\\voice\\' + filename;\n Result := DirectoryExists(wbDataPath + voiceDir);\n if Result then exit;\n\n // check in BSA\n if BSAExists(filename) then begin\n bsaFilename := ChangeFileExt(filename, '.bsa');\n ContainerName := wbDataPath + bsaFilename;\n ResourceList := TStringList.Create;\n wbContainerHandler.ContainerResourceList(ContainerName, ResourceList, voiceDir);\n Result := ResourceList.Count > 0;\n end;\nend;\n\n{ Returns true if Topic Info Fragments exist in @f }\nfunction TopicInfoFragmentsExist(f: IwbFile): boolean;\nconst\n infoFragmentsPath = 'VMAD - Virtual Machine Adapter\\Data\\Info VMAD\\Script Fragments Info';\nvar\n rec: IwbMainRecord;\n group: IwbGroupRecord;\n subgroup, container: IwbContainer;\n element, fragments: IwbElement;\n i, j: Integer;\nbegin\n Result := false;\n // exit if no DIAL records in file\n if not f.HasGroup('DIAL') then\n exit;\n\n // find all DIAL records\n group := f.GroupBySignature['DIAL'];\n for i := 0 to Pred(group.ElementCount) do begin\n element := group.Elements[i];\n // find all INFO records\n if not Supports(element, IwbContainer, subgroup) then\n continue;\n for j := 0 to Pred(subgroup.ElementCount) do begin\n if not Supports(subgroup.Elements[j], IwbMainRecord, rec) then\n continue;\n if not rec.IsMaster then\n continue;\n if not Supports(rec, IwbContainer, container) then\n continue;\n fragments := container.ElementByPath[infoFragmentsPath];\n if not Assigned(fragments) then\n continue;\n Result := true;\n end;\n end;\nend;\n\n{ Returns true if Quest Fragments exist in @f }\nfunction QuestFragmentsExist(f: IwbFile): boolean;\nconst\n questFragmentsPath = 'VMAD - Virtual Machine Adapter\\Data\\Quest VMAD\\Script Fragments Quest';\nvar\n rec: IwbMainRecord;\n group: IwbGroupRecord;\n container: IwbContainer;\n fragments: IwbElement;\n i: Integer;\nbegin\n Result := false;\n // exit if no QUST records in file\n if not f.HasGroup('QUST') then\n exit;\n\n // find all QUST records\n group := f.GroupBySignature['QUST'];\n for i := 0 to Pred(group.ElementCount) do begin\n if not Supports(group.Elements[i], IwbMainRecord, rec) then\n continue;\n if not rec.IsMaster then\n continue;\n if not Supports(rec, IwbContainer, container) then\n continue;\n fragments := container.ElementByPath[questFragmentsPath];\n if not Assigned(fragments) then\n continue;\n Result := true;\n end;\nend;\n\n{ Returns true if Quest Fragments exist in @f }\nfunction SceneFragmentsExist(f: IwbFile): boolean;\nconst\n sceneFragmentsPath = 'VMAD - Virtual Machine Adapter\\Data\\Quest VMAD\\Script Fragments Quest';\nvar\n rec: IwbMainRecord;\n group: IwbGroupRecord;\n container: IwbContainer;\n fragments: IwbElement;\n i: Integer;\nbegin\n Result := false;\n // exit if no SCEN records in file\n if not f.HasGroup('SCEN') then\n exit;\n\n // find all SCEN records\n group := f.GroupBySignature['SCEN'];\n for i := 0 to Pred(group.ElementCount) do begin\n if not Supports(group.Elements[i], IwbMainRecord, rec) then\n continue;\n if not rec.IsMaster then\n continue;\n if not Supports(rec, IwbContainer, container) then\n continue;\n fragments := container.ElementByPath[sceneFragmentsPath];\n if not Assigned(fragments) then\n continue;\n Result := true;\n end;\nend;\n\n{ Returns true if file-specific Script Fragments for @f are found }\nfunction FragmentsExist(f: IwbFile): boolean;\nbegin\n Result := TopicInfoFragmentsExist(f) or QuestFragmentsExist(f)\n or SceneFragmentsExist(f);\nend;\n\n{ References self }\nfunction ReferencesSelf(f: IwbFile): boolean;\nvar\n i: Integer;\n filename, source: string;\n scripts: IwbGroupRecord;\n container: IwbContainerElementRef;\n rec: IwbMainRecord;\nbegin\n // exit if has no script records in file\n Result := false;\n if not f.HasGroup('SCPT') then\n exit;\n\n // get scripts, and check them all for self-reference\n filename := f.FileName;\n scripts := f.GroupBySignature['SCPT'];\n if not Supports(scripts, IwbContainerElementRef, container) then\n exit;\n for i := 0 to Pred(container.ElementCount) do begin\n if not Supports(container.Elements[i], IwbMainRecord, rec) then\n continue;\n source := rec.ElementEditValues['SCTX - Script Source'];\n if Pos(filename, source) > 0 then begin\n Result := true;\n break;\n end;\n end;\nend;\n\n{ Extracts assets from @folder in the BSA @filename to @destination }\nprocedure ExtractBSA(ContainerName, folder, destination: string);\nvar\n ResourceList: TStringList;\n i: Integer;\nbegin\n if not wbContainerHandler.ContainerExists(ContainerName) then begin\n Tracker.Write(' '+ContainerName+' not loaded.');\n exit;\n end;\n ResourceList := TStringList.Create;\n wbContainerHandler.ContainerResourceList(ContainerName, ResourceList, folder);\n for i := 0 to Pred(ResourceList.Count) do\n wbContainerHandler.ResourceCopy(ContainerName, ResourceList[i], destination);\nend;\n\n{ Extracts assets from the BSA @filename to @destination, ignoring assets\n matching items in @ignore }\nprocedure ExtractBSA(ContainerName, destination: string; var ignore: TStringList);\nvar\n ResourceList: TStringList;\n i, j: Integer;\n skip: boolean;\nbegin\n if not wbContainerHandler.ContainerExists(ContainerName) then begin\n Tracker.Write(' '+ContainerName+' not loaded.');\n exit;\n end;\n ResourceList := TStringList.Create;\n wbContainerHandler.ContainerResourceList(ContainerName, ResourceList, '');\n for i := 0 to Pred(ResourceList.Count) do begin\n skip := false;\n for j := 0 to Pred(ignore.Count) do begin\n skip := Pos(ignore[j], ResourceList[i]) > 0;\n if skip then break;\n end;\n\n if skip then continue;\n wbContainerHandler.ResourceCopy(ContainerName, ResourceList[i], destination);\n end;\nend;\n\nfunction RemoveSelfOrContainer(const aElement: IwbElement): Boolean;\nvar\n cElement: IwbElement;\nbegin\n Result := false;\n if aElement.IsRemoveable then begin\n aElement.Remove;\n Result := true;\n end\n else begin\n if not Assigned(aElement.Container) then begin\n Tracker.Write(' Element has no container!');\n exit;\n end;\n // if element isn't removable, try removing its container\n if Supports(aElement.Container, IwbMainRecord) then begin\n Tracker.Write(' Reached main record, cannot remove element');\n exit;\n end;\n Tracker.Write(' Failed to remove '+aElement.Path+', removing container');\n if Supports(aElement.Container, IwbElement, cElement) then\n Result := RemoveSelfOrContainer(cElement);\n end;\nend;\n\nprocedure UndeleteAndDisable(const aRecord: IwbMainRecord);\nvar\n xesp: IwbElement;\n sig: string;\n container: IwbContainerElementRef;\nbegin\n try\n sig := aRecord.Signature;\n\n // undelete\n aRecord.IsDeleted := true;\n aRecord.IsDeleted := false;\n\n // set persistence flag depending on game\n if (wbGameMode in [gmFO3,gmFNV,gmTES5])\n and ((sig = 'ACHR') or (sig = 'ACRE')) then\n aRecord.IsPersistent := true\n else if wbGameMode = gmTES4 then\n aRecord.IsPersistent := false;\n\n // place it below the ground\n if not aRecord.IsPersistent then\n aRecord.ElementNativeValues['DATA\\Position\\Z'] := -30000;\n\n // remove elements\n aRecord.RemoveElement('Enable Parent');\n aRecord.RemoveElement('XTEL');\n\n // add enabled opposite of player (true - silent)\n xesp := aRecord.Add('XESP', True);\n if Assigned(xesp) and Supports(xesp, IwbContainerElementRef, container) then begin\n container.ElementNativeValues['Reference'] := $14; // Player ref\n container.ElementNativeValues['Flags'] := 1; // opposite of parent flag\n end;\n\n // set to disable\n aRecord.IsInitiallyDisabled := true;\n except\n on x: Exception do\n Tracker.Write(' Exception: '+x.Message);\n end;\nend;\n\n\nfunction FixErrors(const aElement: IwbElement; lastRecord: IwbMainRecord;\n var errors: TStringList): IwbMainRecord;\nconst\n cUDR = 'Record marked as deleted but contains:';\n cUnresolved = '< Error: Could not be resolved >';\n cNULL = 'Found a NULL reference, expected:';\nvar\n Error: string;\n Container: IwbContainerElementRef;\n i: Integer;\nbegin\n if Tracker.Cancel then\n exit;\n\n // update progress based on number of main records processed\n if Supports(aElement, IwbMainRecord) then\n Tracker.UpdateProgress(1);\n\n Error := aElement.Check;\n if Error <> '' then begin\n Result := aElement.ContainingMainRecord;\n // fix record marked as deleted errors (UDRs)\n if Pos(cUDR, Error) = 1 then begin\n if Assigned(Result) then begin\n Tracker.Write(' Fixing UDR: '+Result.Name);\n UndeleteAndDisable(Result);\n end;\n end\n else begin\n // fix unresolved FormID errors by NULLing them out\n if Pos(cUnresolved, Error) > 0 then begin\n Tracker.Write(' Fixing Unresolved FormID: '+aElement.Path);\n aElement.NativeValue := 0;\n // we may end up with an invalid NULL reference, so we Check again\n Error := aElement.Check;\n if Error = '' then exit;\n end;\n\n // fix invalid NULL references by removal\n if Pos(cNULL, Error) = 1 then begin\n Tracker.Write(' Removing NULL reference: '+aElement.Path);\n if RemoveSelfOrContainer(aElement) then exit;\n end;\n\n // unhandled error\n Tracker.Write(Format(' Unhandled error: %s -> %s', [aElement.Path, error]));\n if Assigned(Result) and (lastRecord <> Result) then begin\n lastRecord := Result;\n errors.Add(Result.Name);\n end;\n errors.Add(' '+aElement.Path + ' -> ' + Error);\n end;\n end;\n\n // done if element doesn't have children\n if not Supports(aElement, IwbContainerElementRef, Container) then\n exit;\n\n // recurse through children elements\n for i := Pred(Container.ElementCount) downto 0 do begin\n Result := FixErrors(Container.Elements[i], Result, errors);\n // break if container got deleted\n if not Assigned(Container) then break;\n end;\nend;\n\nfunction CheckForErrors(const aElement: IwbElement; lastRecord: IwbMainRecord;\n var errors: TStringList): IwbMainRecord;\nvar\n Error, msg: string;\n Container: IwbContainerElementRef;\n i: Integer;\nbegin\n if Tracker.Cancel then\n exit;\n\n // update progress based on number of main records processed\n if Supports(aElement, IwbMainRecord) then\n Tracker.UpdateProgress(1);\n\n Error := aElement.Check;\n // log errors\n if Error <> '' then begin\n Result := aElement.ContainingMainRecord;\n if Assigned(Result) and (Result <> LastRecord) then begin\n Tracker.Write(' '+Result.Name);\n errors.Add(Result.Name);\n end;\n msg := ' '+aElement.Path + ' -> ' + Error;\n Tracker.Write(' '+msg);\n errors.Add(msg);\n end;\n\n // recursion\n if Supports(aElement, IwbContainerElementRef, Container) then\n for i := Pred(Container.ElementCount) downto 0 do\n Result := CheckForErrors(Container.Elements[i], Result, errors);\nend;\n\n{ Comparator for sorting plugins }\nfunction LoadOrderCompare(List: TStringList; Index1, Index2: Integer): Integer;\nvar\n LO1, LO2: Integer;\nbegin\n LO1 := Integer(List.Objects[Index1]);\n LO2 := Integer(List.Objects[Index2]);\n Result := LO1 - LO2;\nend;\n\n\n{******************************************************************************}\n{ Record Prototyping Functions\n - GetElementObj\n - CreateRecordObj\n - GetRecordObj\n - GetRecordDef\n - BuildElementDef\n - BuildRecordDef\n - GetEditableFileContainer\n}\n{******************************************************************************}\n\n{\n GetElementObj:\n Gets the child json object from a node in a TSmashSetting tree\n @obj matching @name. Returns nil if a matching child is not\n found.\n}\nfunction GetElementObj(var obj: ISuperObject; name: string): ISuperObject;\nvar\n item: ISuperObject;\nbegin\n Result := nil;\n if not Assigned(obj) then\n exit;\n if not Assigned(obj['c']) then\n exit;\n for item in obj['c'] do begin\n if item.S['n'] = name then begin\n Result := item;\n exit;\n end;\n end;\nend;\n\nfunction CreateRecordObj(var tree: ISuperObject; rec: IwbMainRecord): ISuperObject;\nvar\n item: ISuperObject;\nbegin\n item := SO;\n item.S['n'] := rec.Signature;\n item.I['t'] := Ord(stRecord);\n tree.A['records'].Add(item);\n Result := item;\nend;\n\nfunction GetRecordObj(var tree: ISuperObject; name: string): ISuperObject;\nvar\n aSignature: TwbSignature;\n item: ISuperObject;\nbegin\n Result := nil;\n aSignature := StrToSignature(name);\n for item in tree['records'] do begin\n if StrToSignature(item.S['n']) = aSignature then\n Result := item;\n end;\nend;\n\nfunction GetRecordDef(sig: TwbSignature): TwbRecordDefEntry;\nvar\n i: Integer;\n def: TwbRecordDefEntry;\nbegin\n for i := Low(wbRecordDefs) to High(wbRecordDefs) do begin\n def := wbRecordDefs[i];\n if def.rdeSignature = sig then begin\n Result := def;\n exit;\n end;\n end;\nend;\n\nfunction BuildElementDef(element: IwbElement): ISuperObject;\nvar\n container: IwbContainerElementRef;\n i: Integer;\n childElement: IwbElement;\nbegin\n // release object if something goes wrong\n Result := SO;\n try\n Result.S['n'] := element.Name;\n Result.I['t'] := Ord(GetSmashType(element));\n\n // populate element children, if it supports them\n if not Supports(element, IwbContainerElementRef, container) then\n exit;\n // assign to container if it doesn't have element but can hold them\n if (container.ElementCount = 0)\n and container.CanAssign(High(Integer), nil, false) then try\n container.Assign(High(Integer), nil, false);\n except\n // oops, container assignment failed\n // this catches an assertion error when assigning to a DOBJ record\n on x: Exception do\n exit;\n end;\n\n // if we have children, make children array and recurse\n if container.ElementCount > 0 then begin\n Result.O['c'] := SA([]);\n // traverse children\n for i := 0 to Pred(container.ElementCount) do begin\n childElement := container.Elements[i];\n Result.A['c'].Add(BuildElementDef(childElement));\n end;\n end;\n except\n on x: Exception do begin\n Result._Release;\n raise x;\n end;\n end;\nend;\n\nfunction IsUnionDef(def: IwbNamedDef; out unionDef: IwbUnionDef): Boolean;\nvar\n subDef: IwbSubRecordDef;\nbegin\n if Supports(def, IwbSubRecordDef, subDef) then\n Result := Supports(subDef.GetValue, IwbUnionDef, unionDef)\n else\n Result := Supports(def, IwbUnionDef, unionDef);\nend;\n\nfunction HasDef(recObj: ISuperObject; name: String): Boolean;\nvar\n i: Integer;\nbegin\n Result := False;\n for i := 0 to Pred(recObj.A['c'].Length) do\n if recObj.A['c'].O[i].S['n'] = name then begin\n Result := True;\n exit;\n end;\nend;\n\nprocedure AddDefIfMissing(recObj: ISuperObject; def: IwbNamedDef; name: String);\nbegin\n if not HasDef(recObj, name) then\n recObj.A['c'].Add(BuildDef(def, name));\nend;\n\nfunction SigToStr(sig: TwbSignature): String;\nvar\n i: Integer;\nbegin\n for i := Low(sig) to High(sig) do\n if Ord(sig[i]) < 32 then\n sig[i] := AnsiChar(Ord('a') + Ord(sig[i]));\n Result := sig;\nend;\n\nprocedure BuildChildDef(def: IwbNamedDef; recObj: ISuperObject);\nvar\n i: Integer;\n unionDef: IwbUnionDef;\n sigDef: IwbSignatureDef;\n recDef: IwbRecordDef;\n name: String;\nbegin\n if IsUnionDef(def, unionDef) then begin\n for i := 0 to Pred(unionDef.MemberCount) do\n BuildChildDef(unionDef.Members[i] as IwbNamedDef, recObj);\n end\n else if Supports(def, IwbSubRecordUnionDef) and Supports(def, IwbRecordDef, recDef) then begin\n for i := 0 to Pred(recDef.MemberCount) do\n BuildChildDef(recDef.Members[i] as IwbNamedDef, recObj);\n end\n else if Supports(def, IwbSignatureDef, sigDef) then begin\n name := SigToStr(sigDef.DefaultSignature) + ' - ' + sigDef.Name;\n AddDefIfMissing(recObj, def, name);\n end\n else\n AddDefIfMissing(recObj, def, def.Name);\nend;\n\nprocedure BuildChildDefs(obj: ISuperObject; def: IwbNamedDef);\nvar\n i: Integer;\n subDef: IwbSubRecordDef;\n recDef: IwbRecordDef;\n unionDef: IwbUnionDef;\n structDef: IwbStructDef;\n intDef: IwbIntegerDefFormaterUnion;\n sraDef: IwbSubRecordArrayDef;\n aDef: IwbArrayDef;\nbegin\n // try SubRecordDef ValueDef\n if Supports(def, IwbSubRecordDef, subDef) then\n BuildChildDefs(obj, subDef.GetValue as IwbNamedDef)\n // try IwbRecordDef\n else if Supports(def, IwbRecordDef, recDef) then begin\n if recDef.MemberCount = 0 then exit;\n obj.O['c'] := SA([]);\n for i := 0 to Pred(recDef.MemberCount) do\n BuildChildDef(recDef.Members[i] as IwbNamedDef, obj);\n end\n // try IwbUnionDef\n else if Supports(def, IwbUnionDef, unionDef) then begin\n if unionDef.MemberCount = 0 then exit;\n obj.O['c'] := SA([]);\n for i := 0 to Pred(unionDef.MemberCount) do\n BuildChildDef(unionDef.Members[i] as IwbNamedDef, obj);\n end\n // try IwbStructDef\n else if Supports(def, IwbStructDef, structDef) then begin\n if structDef.MemberCount = 0 then exit;\n obj.O['c'] := SA([]);\n for i := 0 to Pred(structDef.MemberCount) do\n BuildChildDef(structDef.Members[i] as IwbNamedDef, obj);\n end\n // try IwbIntegerDefFormaterUnion\n else if Supports(def, IwbIntegerDefFormaterUnion, intDef) then begin\n if intDef.MemberCount = 0 then exit;\n obj.O['c'] := SA([]);\n for i := 0 to Pred(intDef.MemberCount) do\n BuildChildDef(intDef.Members[i] as IwbNamedDef, obj);\n end\n // try IwbSubRecordArrayDef\n else if Supports(def, IwbSubRecordArrayDef, sraDef) then begin\n obj.O['c'] := SA([]);\n BuildChildDef(sraDef.Element as IwbNamedDef, obj);\n end\n // try IwbArrayDef\n else if Supports(def, IwbArrayDef, aDef) then begin\n obj.O['c'] := SA([]);\n BuildChildDef(aDef.Element as IwbNamedDef, obj);\n end;\nend;\n\nfunction BuildDef(def: IwbNamedDef; name: string): ISuperObject;\nbegin\n // release object if something goes wrong\n Result := SO;\n try\n Result.S['n'] := name;\n Result.I['t'] := Ord(SmashType(def));\n BuildChildDefs(Result, def);\n except\n on x: Exception do begin\n Result._Release;\n raise x;\n end;\n end;\nend;\n\nfunction BuildRecordDef(sName: string; mrDef: IwbRecordDef; out recObj: ISuperObject): boolean; overload;\nvar\n i: Integer;\nbegin\n recObj := SO;\n try\n recObj.S['n'] := sName;\n recObj.I['t'] := Ord(stRecord);\n recObj.O['c'] := SA([]);\n for i := 0 to Pred(mrDef.MemberCount) do\n BuildChildDef(mrDef.Members[i] as IwbNamedDef, recObj);\n except\n on x: Exception do begin\n recObj._Release;\n raise x;\n end;\n end;\n\n // if everything completed, result is object we made\n Result := true;\nend;\n\nfunction BuildRecordDef(sName: string; out recObj: ISuperObject): boolean;\nvar\n def: TwbRecordDefEntry;\nbegin\n def := GetRecordDef(StrToSignature(sName));\n Result := BuildRecordDef(sName, def.rdeDef, recObj);\nend;\n\nfunction GetEditableFileContainer: IwbContainerElementRef;\nvar\n i: Integer;\n aPlugin: TBasePlugin;\n aFile: IwbFile;\n Container: IwbContainerElementRef;\nbegin\n Result := nil;\n i := 0;\n repeat\n // exit if max index reached\n if i > Pred(PluginsList.Count) then\n exit;\n\n // get next plugin\n aPlugin := TBasePlugin(PluginsList[i]);\n Inc(i);\n\n // exit if file is invalid\n aFile := aPlugin._File;\n if not Supports(aFile, IwbContainerElementRef, Container) then\n exit;\n until Container.IsElementEditable(nil);\n Result := Container;\nend;\n\nprocedure PopulateAddList(var AddItem: TMenuItem; Event: TNotifyEvent);\nvar\n i: Integer;\n RecordDef: PwbRecordDef;\n item: TMenuItem;\nbegin\n // populate wbGroupOrder to additem\n with TStringList.Create do try\n Sorted := True;\n Duplicates := dupIgnore;\n\n // initialize list contents\n AddStrings(wbGroupOrder);\n Sorted := False;\n\n // get record def names, if available\n for i := Pred(Count) downto 0 do\n if wbFindRecordDef(AnsiString(Strings[i]), RecordDef) then\n Strings[i] := Strings[i] + ' - ' + RecordDef.Name\n else\n Delete(i);\n\n // populate menu items\n for i := 0 to Pred(Count) do begin\n if Length(Strings[i]) < 4 then\n continue;\n item := TMenuItem.Create(AddItem);\n item.Caption := Strings[i];\n item.OnClick := Event;\n AddItem.Add(item);\n end;\n finally\n Free;\n end;\nend;\n\ninitialization\nbegin\n PluginsList := TList.Create;\nend;\n\nfinalization\nbegin\n FreeList(PluginsList);\nend;\n\nend.\n"
},
{
"path": "lib/mte/mteChangeLogForm.dfm",
"content": "object ChangeLogForm: TChangeLogForm\n Left = 0\n Top = 0\n Caption = 'Update Available'\n ClientHeight = 342\n ClientWidth = 366\n Color = clBtnFace\n Constraints.MaxHeight = 1000\n Constraints.MaxWidth = 382\n Constraints.MinHeight = 300\n Constraints.MinWidth = 382\n Font.Charset = DEFAULT_CHARSET\n Font.Color = clWindowText\n Font.Height = -11\n Font.Name = 'Tahoma'\n Font.Style = []\n OldCreateOrder = False\n Position = poScreenCenter\n OnCreate = FormCreate\n PixelsPerInch = 96\n TextHeight = 13\n object LabelPrompt: TLabel\n Left = 8\n Top = 8\n Width = 51\n Height = 13\n Caption = 'Changelog'\n WordWrap = True\n end\n object ScrollBox: TScrollBox\n Left = 8\n Top = 27\n Width = 350\n Height = 276\n HorzScrollBar.Visible = False\n VertScrollBar.Tracking = True\n Align = alCustom\n Anchors = [akLeft, akTop, akRight, akBottom]\n TabOrder = 0\n end\n object ButtonInstall: TButton\n Left = 202\n Top = 309\n Width = 75\n Height = 25\n Align = alCustom\n Anchors = [akRight, akBottom]\n Caption = 'Install'\n ModalResult = 1\n TabOrder = 1\n end\n object ButtonSkip: TButton\n Left = 283\n Top = 309\n Width = 75\n Height = 25\n Align = alCustom\n Anchors = [akRight, akBottom]\n Caption = 'Skip'\n ModalResult = 2\n TabOrder = 2\n end\nend\n"
},
{
"path": "lib/mte/mteChangeLogForm.pas",
"content": "unit mteChangeLogForm;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\n Dialogs, StdCtrls,\n // mte units\n mteHelpers, RttiTranslation, mteLogger;\n\ntype\n TChangeLogForm = class(TForm)\n [FormPrefix('mpCha')]\n ScrollBox: TScrollBox;\n LabelPrompt: TLabel;\n ButtonInstall: TButton;\n ButtonSkip: TButton;\n\n procedure FormCreate(Sender: TObject);\n procedure CreateVersionLabel(line: string; var top: Integer);\n procedure CreateLabel(line: string; var top: Integer);\n procedure DisplayChangelog;\n private\n { Private declarations }\n public\n { Public declarations }\n end;\n\n // public entry point\n function ChangeLogPrompt(AOwner: TComponent): boolean;\n\nconst\n spacing = 5;\n bTranslationDump = false;\n\nvar\n clChangeLogForm: TChangeLogForm;\n clChangelog: TStringList;\n clProgramVersion: string;\n\nimplementation\n\n{$R *.dfm}\n\nprocedure TChangeLogForm.FormCreate(Sender: TObject);\nbegin\n {// do a translation dump?\n if bTranslationDump then\n TRttiTranslation.Save('lang\\english.lang', self);\n\n // load translation\n TRttiTranslation.Load(language, self);}\n\n // display changelog\n DisplayChangelog;\nend;\n\nfunction IsVersionLine(line: string): boolean;\nbegin\n Result := Pos('Version ', line) = 1;\nend;\n\nprocedure TChangeLogForm.CreateVersionLabel(line: string; var top: Integer);\nvar\n lbl: TLabel;\nbegin\n // make version label\n lbl := TLabel.Create(ScrollBox);\n lbl.Parent := ScrollBox;\n lbl.Autosize := true;\n lbl.Top := top;\n lbl.Left := 8;\n lbl.Caption := line;\n lbl.Font.Style := [fsBold];\n\n // increment top for next label\n Inc(top, lbl.Height + spacing);\nend;\n\nprocedure TChangeLogForm.CreateLabel(line: string; var top: Integer);\nvar\n lbl: TLabel;\nbegin\n // make label\n lbl := TLabel.Create(ScrollBox);\n lbl.Parent := ScrollBox;\n lbl.AutoSize := true;\n lbl.WordWrap := true;\n lbl.Top := top;\n lbl.Left := 20;\n lbl.Width := ScrollBox.ClientWidth - 36;\n lbl.Caption := Trim(line);\n\n // increment top for next label\n Inc(top, lbl.Height + spacing);\nend;\n\nprocedure TChangeLogForm.DisplayChangelog;\nvar\n i, top, start: Integer;\n line, lineVersion: string;\nbegin\n // find start line\n start := 0;\n if not Assigned(clChangelog) then\n exit;\n for i := 0 to Pred(clChangelog.Count) do begin\n line := clChangelog[i];\n if not IsVersionLine(line) then\n continue;\n\n // identify start of changelog as first version newer than current version\n lineVersion := Copy(line, 9, Length(line));\n if VersionCompare(clProgramVersion, lineVersion) then begin\n start := i;\n break;\n end;\n end;\n\n // loop through the changelog, creating labels in scrollbox\n // as necessary to render text\n top := 8;\n for i := start to Pred(clChangelog.Count) do begin\n line := clChangelog[i];\n if IsVersionLine(line) then\n CreateVersionLabel(line, top)\n else\n CreateLabel(line, top);\n end;\nend;\n\nprocedure LoadChangelog(var changelog: TStringList);\nbegin\n // load changelog\n if not Assigned(changelog) then\n changelog := TStringList.Create;\n\n // don't attempt to load changelog if it doesn't exist\n if not FileExists('changelog.txt') then begin\n Logger.Write('GENERAL', 'Changelog', 'No changelog found');\n exit;\n end;\n\n // load changelog\n changelog.LoadFromFile('changelog.txt');\nend;\n\nfunction ChangeLogPrompt(AOwner: TComponent): boolean;\nvar\n clForm: TChangeLogForm;\nbegin\n Result := false;\n\n // if we don't have a changelog, exit returning false\n if not FileExists('changelog.txt') then\n exit;\n\n // create change log form\n LoadChangelog(clChangelog);\n clForm := TChangeLogForm.Create(AOwner);\n Result := clForm.ShowModal = mrOK;\n clForm.Free;\nend;\n\nend.\n"
},
{
"path": "lib/mte/mteHelpers.pas",
"content": "unit mteHelpers;\n\ninterface\n\nuses\n Windows, SysUtils, Forms, Classes, ComCtrls, Grids, StdCtrls, Types;\n\ntype\n TCallback = procedure of object;\n TAppHelpers = class\n class procedure GetHelp(var Msg: TMsg; var Handled: Boolean);\n class function HandleHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean;\n end;\n\n { General functions }\n function ShortenVersion(vs: string; numClauses: Integer): string;\n function IfThenInt(AValue: boolean; ATrue: Integer = 1; AFalse: Integer = 0): Integer;\n function TitleCase(sText: String): String;\n function SentenceCase(sText: string): string;\n function csvText(s: string): string;\n function CopyFromTo(str: string; first, last: Integer): string;\n function GetTextIn(str: string; open, close: char): string;\n function FormatByteSize(const bytes: Int64): string;\n function DateBuiltString(date: TDateTime): string;\n function DateTimeToSQL(date: TDateTime): string;\n function SQLToDateTime(date: string): TDateTime;\n function RateStr(date: TDateTime): string;\n function TimeStr(date: TDateTime): string;\n function AppendIfMissing(str, substr: string): string;\n function StrEndsWith(s1, s2: string): boolean;\n function RemoveFromEnd(s1, s2: string): string;\n function IntegerListSum(list: TStringList; maxIndex: integer): integer;\n function Wordwrap(s: string; charCount: integer): string;\n function ExtractPath(path: string; levels: integer): string;\n function ContainsMatch(var sl: TStringList; const s: string): boolean;\n procedure DeleteMatchingItems(item: string; var sl: TStringList);\n function IsURL(s: string): boolean;\n function IsDotFile(fn: string): boolean;\n procedure SaveStringToFile(s: string; fn: string);\n function ApplyTemplate(const template: string; var map: TStringList): string;\n function VersionCompare(v1, v2: string): boolean;\n procedure TryToFree(obj: TObject);\n procedure FreeList(var lst: TList);\n { Windows API functions }\n procedure ForceForeground(hWnd: THandle);\n function GetDriveList: TStringDynArray;\n function DOSDrive(const sDrive: String ): Integer;\n function DriveReady(const sDrive: String): Boolean;\n function TryRegistryKeys(var keys: TStringList): string;\n function FileNameValid(filename: string): boolean;\n function DirectoryValid(dir: string): boolean;\n function UpDirectory(sPath: string): string;\n function DeleteToRecycleBin(const path: string; Confirm: Boolean): Boolean;\n procedure ExecNewProcess(ProgramName: string; synchronous: Boolean);\n procedure BrowseForFile(var ed: TEdit; filter, initDir: string);\n procedure BrowseForFolder(var ed: TEdit; initDir: string);\n function GetCSIDLShellFolder(CSIDLFolder: integer): string;\n function GetFileSize(const aFilename: String): Int64;\n function GetLastModified(const aFileName: String): TDateTime;\n function SearchPathsForFile(sPaths, sFileName: string): string;\n function MultFileSearch(paths, filenames, ignore: array of string;\n maxDepth: integer): string;\n function RecursiveFileSearch(aPath: string; filenames, ignore: array of string;\n maxDepth: integer): string;\n procedure CopyDirectory(src, dst: string; fIgnore, dIgnore: TStringList);\n procedure GetFilesList(path: string; var fIgnore, dIgnore, list: TStringList);\n procedure CopyFiles(src, dst: string; var list: TStringList);\n function GetVersionMem: string;\n function FileVersion(const FileName: string): String;\n procedure DeleteDirectory(const path: string);\n procedure PerformFileSystemTests(sBasePath: string);\n { GUI Helper Functions }\n procedure StringGrid_CorrectWidth(var sg: TStringGrid);\n procedure ListView_CorrectWidth(var lv: TListView);\n function ListView_NextMatch(ListView: TListView; sSearch: string;\n iIndex: Integer): Integer;\n procedure ListView_HandleMatch(ListView: TListView; iFoundIndex: Integer;\n var sBuffer: string; sTempBuffer: string);\n\nconst\n wndBorderSide = 8;\n wndBorderTop = 30;\n\n // TIME TRACKING\n days = 1.0;\n hours = 1.0 / 24.0;\n minutes = hours / 60.0;\n seconds = minutes / 60.0;\n\nvar\n bAllowHelp: boolean;\n enFormatSettings: TFormatSettings;\n\nimplementation\n\nuses\n Controls, Masks, Dialogs, StrUtils, FileCtrl, ShellApi,\n Messages, CommCtrl, DateUtils, shlObj, IOUtils, Registry;\n\n\n{******************************************************************************}\n{ Application Helpers\n General helpers for applications\n}\n{******************************************************************************}\n\nclass procedure TAppHelpers.GetHelp(var Msg: TMsg; var Handled: Boolean);\nvar\n control: TControl;\n sKeyword: string;\nbegin\n if (Msg.message = WM_KEYDOWN) and (LoWord(Msg.wParam) = VK_F1) then begin\n Screen.Cursor := crHelp;\n Handled := true;\n end\n else if (Msg.message = WM_LBUTTONDOWN) and (Screen.Cursor = crHelp) then begin\n // get control the user clicked on\n control := FindVCLWindow(Mouse.CursorPos);\n // if we found a control, jump to help keyword for that control\n if Assigned(control) then begin\n bAllowHelp := true;\n sKeyword := control.HelpKeyword;\n while (sKeyword = '') and Assigned(control.Parent) do begin\n control := control.Parent;\n sKeyword := control.HelpKeyword;\n end;\n Application.HelpKeyword(sKeyword);\n Screen.Cursor := crDefault;\n Handled := true;\n end;\n end;\nend;\n\nclass function TAppHelpers.HandleHelp(Command: Word; Data: Integer;\n var CallHelp: Boolean): Boolean;\nbegin\n CallHelp := bAllowHelp;\n bAllowHelp := false;\n Result := true;\nend;\n\n\n{******************************************************************************}\n{ General functions\n Set of functions that help with converting data types and handling strings.\n\n List of functions:\n - IfThenInt\n - TitleCase\n - SentenceCase\n - csvText\n - CopyFromTo\n - GetTextIn\n - FormatByteSize\n - DateBuiltString\n - DateTimeToSQL\n - SQLToDateTime\n - RateStr\n - TimeStr\n - AppendIfMissing\n - StrEndsWith\n - RemoveFromEnd\n - IntegerListSum\n - Wordwrap\n - ExtractPath\n - ContainsMatch\n - IsURL\n - IsDotFile\n - SaveStringToFile\n - ApplyTemplate\n}\n{*****************************************************************************}\n\nfunction ShortenVersion(vs: string; numClauses: Integer): string;\nvar\n i, numDots: Integer;\nbegin\n Result := '';\n numDots := 0;\n for i := 1 to Pred(Length(vs)) do begin\n if vs[i] = '.' then\n Inc(numDots);\n if numDots = numClauses then\n break;\n Result := Result + vs[i];\n end;\nend;\n\n{ Returns one of two integers based on a boolean argument.\n Like IfThen from StrUtils, but returns an Integer. }\nfunction IfThenInt(AValue: boolean; ATrue: Integer = 1; AFalse: Integer = 0): Integer;\nbegin\n if AValue then\n Result := ATrue\n else\n Result := AFalse;\nend;\n\n{ Capitalizes the first letter of each word }\nfunction TitleCase(sText: String): String;\nconst\n cDelimiters = [#9, #10, #13, ' ', ',', '.', ':', ';', '\"',\n '\\', '/', '(', ')', '[', ']', '{', '}'];\nvar\n iLoop: Integer;\nbegin\n Result := sText;\n if (Result <> '') then begin\n Result := LowerCase(Result);\n\n Result[1] := UpCase(Result[1]);\n for iLoop := 2 to Length(Result) do\n if (Result[iLoop - 1] in cDelimiters) then\n Result[iLoop] := UpCase(Result[iLoop]);\n end;\nend;\n\n{ Capitalizes first character of each sentence }\nfunction SentenceCase(sText: string): string;\nconst\n cTerminators = ['!', '.', '?'];\nvar\n iLoop: Integer;\n bTerminated: boolean;\nbegin\n Result := sText;\n if (Result <> '') then begin\n Result := LowerCase(Result);\n\n Result[1] := UpCase(Result[1]);\n bTerminated := false;\n for iLoop := 2 to Length(Result) do begin\n if (Result[iLoop - 1] in cTerminators) then\n bTerminated := true;\n if bTerminated and (Result[iLoop] <> ' ') then\n Result[iLoop] := UpCase(Result[iLoop]);\n end;\n end;\nend;\n\n{ Replaces newlines with a comma and space }\nfunction csvText(s: string): string;\nbegin\n result := StringReplace(Trim(s), #13, ', ', [rfReplaceAll]);\nend;\n\n{ Copies a substring in a string between two indexes }\nfunction CopyFromTo(str: string; first, last: Integer): string;\nbegin\n Result := Copy(str, first, (last - first) + 1);\nend;\n\n{ Returns a substring of @str between characters @open and @close }\nfunction GetTextIn(str: string; open, close: char): string;\nvar\n i, openIndex: integer;\n bOpen: boolean;\nbegin\n Result := '';\n bOpen := false;\n openIndex := 0;\n for i := 0 to Length(str) do begin\n if not bOpen and (str[i] = open) then begin\n openIndex := i;\n bOpen := true;\n end;\n if bOpen and (str[i] = close) then begin\n Result := CopyFromTo(str, openIndex + 1, i - 1);\n break;\n end;\n end;\nend;\n\n{ Format file byte size }\nfunction FormatByteSize(const bytes: Int64): string;\nconst\n B = 1; //byte\n KB = 1024 * B; //kilobyte\n MB = 1024 * KB; //megabyte\n GB = 1024 * MB; //gigabyte\nbegin\n if bytes > GB then\n result := FormatFloat('#.## GB', bytes / GB)\n else\n if bytes > MB then\n result := FormatFloat('#.## MB', bytes / MB)\n else\n if bytes > KB then\n result := FormatFloat('#.## KB', bytes / KB)\n else\n if bytes > 0 then\n result := FormatFloat('#.## bytes', bytes)\n else\n result := '0 bytes';\nend;\n\n{ Converts a TDateTime to a string, with 0 being the string 'Never' }\nfunction DateBuiltString(date: TDateTime): string;\nbegin\n if date = 0 then\n Result := 'Never'\n else begin\n Result := DateTimeToStr(date);\n end;\nend;\n\nfunction DateTimeToSQL(date: TDateTime): string;\nbegin\n Result := FormatDateTime('yyyy-mm-dd hh:mm:ss', date);\nend;\n\nfunction SQLToDateTime(date: string): TDateTime;\nvar\n fs: TFormatSettings;\nbegin\n GetLocaleFormatSettings(GetThreadLocale, fs);\n fs.DateSeparator := '-';\n fs.ShortDateFormat := 'yyyy-mm-dd';\n fs.TimeSeparator := ':';\n fs.LongTimeFormat := 'hh:nn:ss';\n Result := StrToDateTime(date, fs);\nend;\n\n{ Converts a TDateTime to a rate string, e.g. Every 24.0 hours }\nfunction RateStr(date: TDateTime): string;\nbegin\n if date > 1.0 then\n Result := Format('Every %0.2f days', [date])\n else if date * 24.0 > 1.0 then\n Result := Format('Every %0.1f hours', [date * 24.0])\n else if date * 24.0 * 60.0 > 1.0 then\n Result := Format('Every %0.1f minutes', [date * 24.0 * 60.0])\n else\n Result := Format('Every %0.1f seconds', [date * 24.0 * 60.0 * 60.0]);\nend;\n\n{ Converts a TDateTime to a time string, e.g. 19d 20h 3m 30s }\nfunction TimeStr(date: TDateTime): string;\nbegin\n Result := Format('%dd %dh %dm', [Trunc(date), HourOf(date), MinuteOf(date)]);\nend;\n\n{\n StrEndsWith:\n Checks to see if a string ends with an entered substring.\n\n Example usage:\n s := 'This is a sample string.';\n if StrEndsWith(s, 'string.') then\n AddMessage('It works!');\n}\nfunction StrEndsWith(s1, s2: string): boolean;\nvar\n n1, n2: integer;\nbegin\n Result := false;\n\n n1 := Length(s1);\n n2 := Length(s2);\n if n1 < n2 then exit;\n\n Result := (Copy(s1, n1 - n2 + 1, n2) = s2);\nend;\n\n{\n AppendIfMissing:\n Appends substr to the end of str if it's not already there.\n\n Example usage:\n s := 'This is a sample string.';\n Logger.Write(AppendIfMissing(s, 'string.')); //'This is a sample string.'\n Logger.Write(AppendIfMissing(s, ' Hello.')); //'This is a sample string. Hello.'\n}\nfunction AppendIfMissing(str, substr: string): string;\nbegin\n Result := str;\n if not StrEndsWith(str, substr) then\n Result := str + substr;\nend;\n\n{\n RemoveFromEnd:\n Creates a new string with s1 removed from the end of s2, if found.\n\n Example usage:\n s := 'This is a sample string.';\n AddMessage(RemoveFromEnd(s, 'string.')); //'This is a sample '\n}\nfunction RemoveFromEnd(s1, s2: string): string;\nbegin\n Result := s1;\n if StrEndsWith(s1, s2) then\n Result := Copy(s1, 1, Length(s1) - Length(s2));\nend;\n\n{ Calculates the integer sum of all values in a TStringList to maxIndex }\nfunction IntegerListSum(list: TStringList; maxIndex: integer): integer;\nvar\n i: Integer;\nbegin\n Result := 0;\n for i := 0 to maxIndex do\n Inc(result, StrToInt(list[i]));\nend;\n\n{ Inserts line breaks in string @s before @charCount has been exceeded }\nfunction Wordwrap(s: string; charCount: integer): string;\nvar\n i, lastSpace, counter: Integer;\nbegin\n counter := 0;\n lastSpace := 0;\n for i := 1 to Length(s) - 1 do begin\n Inc(counter);\n if (s[i] = ' ') or (s[i] = ',') then\n lastSpace := i;\n if (s[i] = #13) or (s[i] = #10)\n or (s[i + 1] = #13) or (s[i + 1] = #10) then begin\n lastSpace := 0;\n counter := 0;\n end;\n if (counter = charCount) and (lastSpace > 0) then begin\n Insert(#13#10, s, lastSpace + 1);\n lastSpace := 0;\n counter := 0;\n end;\n end;\n Result := s;\nend;\n\n{ Like ExtractFilePath, but will allow the user to specify how many @levels\n they want to traverse back. Specifying @levels = 0 is equivalent to\n ExtractFilePath.\n\n Example usage:\n path := 'C:\\Program Files (x86)\\Test\\Test.exe';\n ShowMessage(ExtractPath(path, 0)); // 'C:\\Program Files (x86)\\Test\\'\n ShowMessage(ExtractPath(path, 1)); // 'C:\\Program Files (x86)\\'\n ShowMessage(ExtractPath(path, 2)); // 'C:\\'\n}\nfunction ExtractPath(path: string; levels: integer): string;\nvar\n i, n: integer;\nbegin\n n := 0;\n for i := Length(path) downto 1 do\n if IsPathDelimiter(path, i) then begin\n if n = levels then\n break\n else\n Inc(n);\n end;\n Result := Copy(path, 1, i);\nend;\n\n{ Checks to see if any mask in @sl matches the string @s }\nfunction ContainsMatch(var sl: TStringList; const s: string): boolean;\nvar\n i: Integer;\nbegin\n Result := false;\n for i := 0 to Pred(sl.Count) do\n if MatchesMask(s, sl[i]) then begin\n Result := true;\n break;\n end;\nend;\n\n{ Deletes items from @sl that match the input string @item }\nprocedure DeleteMatchingItems(item: string; var sl: TStringList);\nvar\n i: Integer;\nbegin\n for i := Pred(sl.Count) downto 0 do begin\n if sl[i] = item then\n sl.Delete(i);\n end;\nend;\n\n{ Returns true if the string is an http:// or https:// url }\nfunction IsURL(s: string): boolean;\nbegin\n Result := (Pos('http://', s) = 1) or (Pos('https://', s) = 1);\nend;\n\n{ Returns true if @fn is . or .. }\nfunction IsDotFile(fn: string): boolean;\nbegin\n Result := (fn = '.') or (fn = '..');\nend;\n\n{ Saves a string @s to a file at @fn }\nprocedure SaveStringToFile(s: string; fn: string);\nvar\n sl: TStringList;\nbegin\n sl := TStringList.Create;\n sl.Text := s;\n sl.SaveToFile(fn);\n sl.Free;\nend;\n\nfunction ApplyTemplate(const template: string; var map: TStringList): string;\nconst\n openTag = '{{';\n closeTag = '}}';\nvar\n i: Integer;\n name, value: string;\nbegin\n Result := template;\n for i := 0 to Pred(map.Count) do begin\n name := map.Names[i];\n value := map.ValueFromIndex[i];\n Result := StringReplace(Result, openTag + name + closeTag, value, [rfReplaceAll]);\n end;\nend;\n\nfunction VersionCompare(v1, v2: string): boolean;\nvar\n sl1, sl2: TStringList;\n i, c1, c2: integer;\nbegin\n Result := false;\n\n // parse versions with . as delimiter\n sl1 := TStringList.Create;\n sl1.LineBreak := '.';\n sl1.Text := v1;\n sl2 := TStringList.Create;\n sl2.LineBreak := '.';\n sl2.Text := v2;\n\n // look through each version clause and perform comparisons\n i := 0;\n while (i < sl1.Count) and (i < sl2.Count) do begin\n c1 := StrToInt(sl1[i]);\n c2 := StrToInt(sl2[i]);\n if (c1 < c2) then begin\n Result := true;\n break;\n end\n else if (c1 > c2) then begin\n Result := false;\n break;\n end;\n Inc(i);\n end;\n\n // free ram\n sl1.Free;\n sl2.Free;\nend;\n\nprocedure TryToFree(obj: TObject);\nbegin\n if Assigned(obj) then try\n obj.Free;\n except\n on x: Exception do // nothing\n end;\nend;\n\nprocedure FreeList(var lst: TList);\nvar\n i: Integer;\n obj: TObject;\nbegin\n for i := Pred(lst.Count) downto 0 do begin\n obj := TObject(lst[i]);\n TryToFree(obj);\n end;\n lst.Free;\nend;\n\n\n{******************************************************************************}\n{ Windows API functions\n Set of functions that help deal with the Windows File System.\n\n List of functions:\n - ForceForeground\n - FileNameValid\n - RecycleDirectory\n - ExecNewProcess\n - BrowseForFile\n - BrowseForFolder\n - GetCSIDLShellFolder\n - GetFileSize\n - GetLastModified\n - MultFileSearch\n - RecursiveFileSearch\n - CopyDirectory\n - GetFilesList\n - CopyFiles\n - CorrectListViewWidth\n - GetVersionMem\n - FileVersion\n - DeleteDirectory\n}\n{******************************************************************************}\n\n{\n ForceForeground:\n Forces a hWnd to the foreground.\n}\nprocedure ForceForeground(hWnd: THandle);\nbegin\n SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOMOVE);\n SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOMOVE);\nend;\n\n{\n GetDriveList:\n Returns an array filled wit the assigned\n drive letters on the current computer.\n}\n\nfunction GetDriveList: TStringDynArray;\nvar\n Buff: array[0..128] of Char;\n ptr: PChar;\n Idx: Integer;\nbegin\n if (GetLogicalDriveStrings(Length(Buff), Buff) = 0) then\n RaiseLastOSError;\n // There can't be more than 26 lettered drives (A..Z).\n SetLength(Result, 26);\n\n Idx := 0;\n ptr := @Buff;\n while StrLen(ptr) > 0 do\n begin\n Result[Idx] := ptr;\n ptr := StrEnd(ptr);\n Inc(ptr);\n Inc(Idx);\n end;\n SetLength(Result, Idx);\nend;\n\n{\n DOSDrive:\n Converts a drive letter into the integer drive #\n required by DiskSize().\n}\nfunction DOSDrive( const sDrive: String ): Integer;\nbegin\n if (Length(sDrive) < 1) then\n Result := -1\n else\n Result := (Ord(UpCase(sDrive[1])) - 64);\nend;\n\n{\n DriveReady:\n Tests the status of a drive to see if it's ready\n to access.\n}\nfunction DriveReady(const sDrive: String): Boolean;\nvar\n ErrMode: Word;\nbegin\n ErrMode := SetErrorMode(0);\n SetErrorMode(ErrMode or SEM_FAILCRITICALERRORS);\n try\n Result := (DiskSize(DOSDrive(sDrive)) > -1);\n finally\n SetErrorMode(ErrMode);\n end;\nend;\n\n{\n TryRegistryKeys:\n Tries to load various registry keys.\n}\nfunction TryRegistryKeys(var keys: TStringList): string;\nvar\n i: Integer;\n path, name: string;\nbegin\n Result := '';\n with TRegistry.Create do try\n RootKey := HKEY_LOCAL_MACHINE;\n\n // try all keys\n for i := 0 to Pred(keys.Count) do begin\n path := ExtractFilePath(keys[i]);\n name := ExtractFileName(keys[i]);\n if OpenKeyReadOnly(path) then begin\n Result := ReadString(name);\n break;\n end;\n end;\n finally\n Free;\n end;\nend;\n\n{\n DirectoryValid:\n Returns true if the input directory path is valid.\n}\nfunction DirectoryValid(dir: string): boolean;\nbegin\n Result := false;\n if (dir = '') then\n exit;\n\n dir := ExcludeTrailingPathDelimiter(dir);\n{$IFDEF MSWINDOWS}\n if (Length(dir) < 3) or (ExtractFilePath(dir) = dir) then\n exit; // avoid 'xyz:\\' problem.\n{$ENDIF}\n{$IFDEF POSIX}\n if (dir = '') then\n exit;\n{$ENDIF POSIX};\n Result := true;\nend;\n\n{\n UpDirectory:\n Returns the path of the directory holding a directory.\n}\nfunction UpDirectory(sPath: string): string;\nbegin\n if not StrEndsWith(sPath, '\\') then\n sPath := ExtractFilePath(sPath);\n Result := ExtractFilePath(RemoveFromEnd(sPath, '\\'));\nend;\n\n{\n FileNameValid:\n Returns true if the input filename is valid.\n}\nfunction FileNameValid(filename: string): boolean;\nbegin\n Result := (Length(Trim(filename)) > 0) and\n TPath.HasValidFileNameChars(filename, false);\nend;\n\n{\n ExecNewProcess:\n Create a new synchronous or asynchronous process.\n}\nprocedure ExecNewProcess(ProgramName: string; synchronous: Boolean);\nvar\n StartInfo : TStartupInfo;\n ProcInfo : TProcessInformation;\n CreateOK : Boolean;\nbegin\n { fill with known state }\n FillChar(StartInfo, SizeOf(TStartupInfo), #0);\n FillChar(ProcInfo, SizeOf(TProcessInformation), #0);\n StartInfo.cb := SizeOf(TStartupInfo);\n CreateOK := CreateProcess(PChar(ProgramName), nil, nil, nil,False,\n CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,\n nil, nil, StartInfo, ProcInfo);\n\n // check if successful\n if CreateOK then begin\n if synchronous then\n WaitForSingleObject(ProcInfo.hProcess, INFINITE);\n end\n else\n ShowMessage('Unable to run '+ProgramName);\n\n // close handles\n CloseHandle(ProcInfo.hProcess);\n CloseHandle(ProcInfo.hThread);\nend;\n\n{\n BrowseForFile:\n Links a file selection through a TOpenDialog to the text stored in @ed,\n applying filter @filter.\n}\nprocedure BrowseForFile(var ed: TEdit; filter, initDir: string);\nvar\n openDialog: TOpenDialog;\nbegin\n openDialog := TOpenDialog.Create(ed.Parent);\n\n if FileExists(ed.Text) then\n openDialog.InitialDir := ExtractFilePath(ed.Text)\n else if DirectoryExists(ed.Text) then\n openDialog.InitialDir := ed.Text\n else\n openDialog.InitialDir := initDir;\n\n openDialog.Filter := filter;\n if openDialog.Execute then\n ed.Text := openDialog.FileName;\nend;\n\n{\n BrowseForFolder:\n Links a file selection through a TOpenDialog to the text stored in @ed,\n applying filter @filter\n}\nprocedure BrowseForFolder(var ed: TEdit; initDir: string);\nvar\n s: string;\nbegin\n // start in current directory value if valid\n if DirectoryExists(ed.Text) then\n s := ed.Text\n else\n s := initDir;\n // prompt user to select a directory\n SelectDirectory('Select a directory', '', s, []);\n\n // save text to TEdit\n if s <> '' then\n ed.Text := AppendIfMissing(s, '\\');\nend;\n\n{\n GetCSIDLShellFolder:\n Gets a folder by its integer CSID.\n}\nfunction GetCSIDLShellFolder(CSIDLFolder: integer): string;\nbegin\n SetLength(Result, MAX_PATH);\n SHGetSpecialFolderPath(0, PChar(Result), CSIDLFolder, True);\n SetLength(Result, StrLen(PChar(Result)));\n if (Result <> '') then\n Result := IncludeTrailingBackslash(Result);\nend;\n\n{\n GetFileSize:\n Gets the size of a file at @aFilename through the windows API.\n}\nfunction GetFileSize(const aFilename: String): Int64;\nvar\n info: TWin32FileAttributeData;\nbegin\n result := -1;\n\n if NOT GetFileAttributesEx(PWideChar(aFileName), GetFileExInfoStandard, @info) then\n EXIT;\n\n result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);\nend;\n\n{\n GetLastModified:\n Gets the last time a file was modified.\n}\nfunction GetLastModified(const aFileName: String): TDateTime;\nvar\n info: TWin32FileAttributeData;\n FileTime: TFileTime;\n LocalTime, SystemTime: TSystemTime;\nbegin\n result := 0;\n // exit if can't get attributes\n if not GetFileAttributesEx(PWideChar(aFileName), GetFileExInfoStandard, @info) then\n exit;\n\n // get last modified\n FileTime := info.ftLastWriteTime;\n\n // convert to system time\n if not FileTimeToSystemTime(FileTime, SystemTime) then\n RaiseLastOSError;\n if not SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime) then\n RaiseLastOSError;\n\n Result := SystemTimeToDateTime(LocalTime);\nend;\n\n{\n SearchPathsForFile:\n Searches for a file @sFileName in each path in @sPaths.\n}\nfunction SearchPathsForFile(sPaths, sFileName: string): string;\nvar\n slPaths: TStringList;\n i: Integer;\n info: TSearchRec;\nbegin\n slPaths := TStringList.Create;\n try\n while (Pos(';', sPaths) > 0) do begin\n slPaths.Add(Copy(sPaths, 1, Pos(';', sPaths) - 1));\n sPaths := Copy(sPaths, Pos(';', sPaths) + 1, Length(sPaths));\n end;\n for i := 0 to slPaths.Count - 1 do begin\n if FindFirst(slPaths[i] + '\\*', faDirectory, info) = 0 then begin\n repeat\n Result := FileSearch(sFileName, slPaths[i] + '\\' + info.Name);\n if (Result <> '') then\n break;\n until FindNext(info) <> 0;\n FindClose(info);\n // break if we found it\n if (Result <> '') then\n break;\n end;\n end;\n finally\n slPaths.Free;\n end;\nend;\n\n{\n MultFileSearch:\n Wraps around RecursiveFileSearch, allowing the searching of multiple paths.\n}\nfunction MultFileSearch(paths, filenames, ignore: array of string; maxDepth: integer): string;\nvar\n i: Integer;\n path: string;\nbegin\n for i := Low(paths) to High(paths) do begin\n path := RecursiveFileSearch(paths[i], filenames, ignore, maxDepth);\n if path <> '' then\n break;\n end;\n Result := path;\nend;\n\n{\n RecursiveFileSearch:\n Recursively searches a path for a file matching @filenames, ignoring\n directories in @ignore, and not traversing deeper than maxDepth.\n\n Example usage:\n p := RecursiveFileSearch(GamePath, filenames, ignore, 1);\n AddMessage(p);\n}\nfunction RecursiveFileSearch(aPath: string; filenames, ignore: array of string;\n maxDepth: integer): string;\nvar\n skip: boolean;\n i: integer;\n info: TSearchRec;\nbegin\n Result := '';\n aPath := AppendIfMissing(aPath, PathDelim);\n if Result <> '' then exit;\n\n // exit if no files in path\n if FindFirst(aPath + '*', faAnyFile, info) <> 0 then\n exit;\n // else loop through all files in path\n repeat\n if IsDotFile(info.Name) then\n continue; // skip . and ..\n skip := false;\n for i := Low(ignore) to High(ignore) do begin\n skip := Lowercase(info.Name) = ignore[i];\n if skip then\n break;\n end;\n if not skip then begin\n if ((info.attr and faDirectory) = faDirectory) and (maxDepth > 0) then begin\n Result := RecursiveFileSearch(aPath+info.Name, filenames, ignore, maxDepth - 1);\n end\n else if MatchStr(info.Name, filenames) then\n Result := aPath + info.Name;\n end;\n if (Result <> '') then break;\n until FindNext(info) <> 0;\n FindClose(info);\nend;\n\n{\n CopyDirectory:\n Recursively copies all of the contents of a directory.\n\n Example usage:\n slIgnore := TStringList.Create;\n slIgnore.Add('mteFunctions.pas');\n CopyDirectory(ScriptsPath, 'C:\\ScriptsBackup', slIgnore);\n}\nprocedure CopyDirectory(src, dst: string; fIgnore, dIgnore: TStringList);\nvar\n info: TSearchRec;\n isDirectory: boolean;\nbegin\n src := AppendIfMissing(src, PathDelim);\n dst := AppendIfMissing(dst, PathDelim);\n\n // if no files in source path, exit\n if (FindFirst(src + '*', faAnyFile, info) <> 0) then\n exit;\n repeat\n isDirectory := (info.Attr and faDirectory = faDirectory);\n // skip . and ..\n if (info.Name = '.') or (info.Name = '..') then\n continue;\n\n // skip if ignored\n if isDirectory and ContainsMatch(dIgnore, info.Name) then\n continue\n else if ContainsMatch(fIgnore, info.Name) then\n continue;\n\n // copy the file or recurse\n ForceDirectories(dst);\n if isDirectory then\n CopyDirectory(src+info.Name, dst+info.Name, fIgnore, dIgnore)\n else\n CopyFile(PChar(src+info.Name), PChar(dst+info.Name), false);\n until FindNext(info) <> 0;\n\n FindClose(info);\nend;\n\n{\n GetFilesList:\n Searches @path, recursively traversing subdirectories that don't match a mask\n in @dIgnore, adding files that don't match a mask in @fIgnore to @list.\n\n Example usage:\n FilesList := TStringList.Create;\n fileIgnore := TStringList.Create;\n fileIgnore.Add('*.esp');\n dirIgnore := TStringList.Create;\n dirIgnore.Add('translations');\n GetFilesList(wbDataPath, fileIgnore, dirIgnore, FilesList);\n}\nprocedure GetFilesList(path: string; var fIgnore, dIgnore, list: TStringList);\nvar\n info: TSearchRec;\n isDirectory: boolean;\nbegin\n path := AppendIfMissing(path, PathDelim);\n\n // if no files in source path, exit\n if (FindFirst(path + '*', faAnyFile, info) <> 0) then\n exit;\n repeat\n isDirectory := (info.Attr and faDirectory = faDirectory);\n // skip . and ..\n if (info.Name = '.') or (info.Name = '..') then\n continue;\n\n // skip if ignored\n if isDirectory then begin\n if ContainsMatch(dIgnore, info.Name) then\n continue;\n end\n else if ContainsMatch(fIgnore, info.Name) then\n continue;\n\n // copy the file or recurse\n if isDirectory then\n GetFilesList(path + info.Name, fIgnore, dIgnore, list)\n else\n list.Add(path + info.Name);\n until FindNext(info) <> 0;\n\n FindClose(info);\nend;\n\n{ Copies files in @list from @src to @dst }\nprocedure CopyFiles(src, dst: string; var list: TStringList);\nvar\n i: Integer;\n srcFile, dstFile: string;\nbegin\n src := AppendIfMissing(src, PathDelim);\n dst := AppendIfMissing(dst, PathDelim);\n for i := 0 to Pred(list.Count) do begin\n srcFile := list[i];\n dstFile := StringReplace(srcFile, src, dst, []);\n ForceDirectories(ExtractFilePath(dstFile));\n CopyFile(PChar(srcFile), PChar(dstFile), false);\n end;\nend;\n\n{ Get program version from memory }\nfunction GetVersionMem: string;\nvar\n verblock: PVSFIXEDFILEINFO;\n versionMS, versionLS, verlen: cardinal;\n rs: TResourceStream;\n m: TMemoryStream;\nbegin\n m := TMemoryStream.Create;\n try\n rs := TResourceStream.CreateFromID(HInstance, 1, RT_VERSION);\n try\n m.CopyFrom(rs, rs.Size);\n finally\n rs.Free;\n end;\n m.Position := 0;\n if VerQueryValue(m.Memory, '\\', Pointer(verblock), verlen) then begin\n VersionMS := verblock.dwFileVersionMS;\n VersionLS := verblock.dwFileVersionLS;\n Result := Format('%s.%s.%s.%s', [IntToStr(versionMS shr 16),\n IntToStr(versionMS and $FFFF), IntToStr(VersionLS shr 16),\n IntToStr(VersionLS and $FFFF)]);\n end;\n finally\n m.Free;\n end;\nend;\n\n{ Get program version from disk }\nfunction FileVersion(const FileName: string): String;\nvar\n VerInfoSize: Cardinal;\n VerValueSize: Cardinal;\n Dummy: Cardinal;\n PVerInfo: Pointer;\n PVerValue: PVSFixedFileInfo;\nbegin\n Result := '';\n VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);\n GetMem(PVerInfo, VerInfoSize);\n try\n if GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, PVerInfo) then\n if VerQueryValue(PVerInfo, '\\', Pointer(PVerValue), VerValueSize) then\n with PVerValue^ do\n Result := Format('%d.%d.%d.%d', [\n HiWord(dwFileVersionMS), //Major\n LoWord(dwFileVersionMS), //Minor\n HiWord(dwFileVersionLS), //Release\n LoWord(dwFileVersionLS)]); //Build\n finally\n FreeMem(PVerInfo, VerInfoSize);\n end;\nend;\n\n{ Sends the file/directory at @path to the recycle bin }\nfunction DeleteToRecycleBin(const path: string; Confirm: Boolean): Boolean;\nvar\n sh: TSHFileOpStruct;\nbegin\n FillChar(sh, SizeOf(sh), 0);\n with sh do begin\n Wnd := 0;\n wFunc := FO_DELETE;\n pFrom := PChar(path + #0);\n fFlags := FOF_SILENT or FOF_ALLOWUNDO;\n if not Confirm then\n fFlags := fFlags or FOF_NOCONFIRMATION;\n end;\n Result := SHFileOperation(sh) = 0;\nend;\n\n{ Deletes the directory at @path and all files it contains }\nprocedure DeleteDirectory(const path: string);\nvar\n ShOp: TSHFileOpStruct;\nbegin\n ShOp.Wnd := 0;\n ShOp.wFunc := FO_DELETE;\n ShOp.pFrom := PChar(path + #0);\n ShOp.pTo := nil;\n ShOp.fFlags := FOF_NOCONFIRMATION or FOF_ALLOWUNDO or FOF_NO_UI;\n SHFileOperation(ShOp);\nend;\n\n{ Performs tests of directory creation and deletion, and file creation,\n reading, writing, and deletion at the specified @sBasePath }\nprocedure PerformFileSystemTests(sBasePath: string);\nvar\n sl1, sl2: TStringList;\n sExceptionBase, sPath, sTask: string;\nbegin\n // initialize stringlists\n sl1 := TStringList.Create;\n sl2 := TStringList.Create;\n sExceptionBase := 'Could not %s at path \"%s\"';\n\n try\n // try to create a new directory\n sTask := 'create directory';\n sPath := sBasePath + 'test\\';\n ForceDirectories(sPath);\n if not DirectoryExists(sPath) then\n raise Exception.Create(Format(sExceptionBase, [sTask, sPath]));\n\n // try to create a new file\n sTask := 'create file';\n sPath := sBasePath + 'test\\Test.txt';\n sl1.Text := sBasePath;\n sl1.SaveToFile(sPath);\n\n // if file doesn't exist after saving, raise an exception\n if not FileExists(sPath) then\n raise Exception.Create(Format(sExceptionBase, [sTask, sPath]));\n\n // try to read the file\n sTask := 'read file';\n sl2.LoadFromFile(sPath);\n if sl2.Text <> sl1.Text then\n raise Exception.Create(Format(sExceptionBase, [sTask, sPath]));\n\n // try to write to the file\n sTask := 'write to file';\n sl1.Text := 'Testing 123abc';\n sl1.SaveToFile(sPath);\n sl2.LoadFromFile(sPath);\n if sl2.Text <> sl1.Text then\n raise Exception.Create(Format(sExceptionBase, [sTask, sPath]));\n\n // try to delete the file\n sTask := 'delete file';\n DeleteFile(sPath);\n if FileExists(sPath) then\n raise Exception.Create(Format(sExceptionBase, [sTask, sPath]));\n\n // try to delete the directory\n sTask := 'delete directory';\n sPath := sBasePath + 'test\\';\n DeleteDirectory(sPath);\n if DirectoryExists(sPath) then\n raise Exception.Create(Format(sExceptionBase, [sTask, sPath]));\n finally\n // always free memory\n sl1.Free;\n sl2.Free;\n end;\nend;\n\n\n{******************************************************************************}\n{ GUI Helper Functions\n - ListView_CorrectWidth\n - ListView_FindNextMatch\n - ListView_HandleMatch\n}\n{******************************************************************************}\n\nprocedure StringGrid_CorrectWidth(var sg: TStringGrid);\nvar\n w: Integer;\nbegin\n w := sg.ClientWidth;\n Dec(w, sg.ColWidths[0]);\n sg.ColWidths[1] := w;\nend;\n\n{ Fixes @lv's width to fit client width if it has autosizable columns,\n which resolves an issue where autosize doesn't work on virtual vsReport\n TListViews when a scroll bar becomes visible. }\nprocedure ListView_CorrectWidth(var lv: TListView);\nvar\n i, w: Integer;\n col: TListColumn;\n AutoSizedColumns: TList;\nbegin\n AutoSizedColumns := TList.Create;\n w := lv.ClientWidth;\n\n // loop through columns keeping track of remaining width\n for i := 0 to Pred(lv.Columns.Count) do begin\n col := lv.Columns[i];\n if col.AutoSize then\n AutoSizedColumns.Add(col)\n else\n Dec(w, ListView_GetColumnWidth(lv.Handle, i));\n end;\n\n // set auotsized columns to fit client width\n for i := 0 to Pred(AutoSizedColumns.Count) do begin\n col := TListColumn(AutoSizedColumns[i]);\n col.Width := w div AutoSizedColumns.Count;\n end;\n\n // clean up\n AutoSizedColumns.Free;\nend;\n\n{ If @iIndex = 0, returns the index of the next @ListView item\n matching the input @sSearch string. Else returns the index\n of the next @ListView subitem at index @iIndex - 1 matching\n the input @sSearch string. }\nfunction ListView_NextMatch(ListView: TListView; sSearch: string;\n iIndex: Integer): Integer;\nvar\n i, iStart: Integer;\n ListItem: TListITem;\n sCaption, sCompare: string;\nbegin\n Result := -1;\n\n // Start at selected item's index, if there\n // is an item selected\n if Assigned(ListView.Selected) then\n iStart := ListView.Selected.Index\n // Else start at 0, the first item\n else\n iStart := 0;\n\n // Loop through items looking for a match\n for i := iStart to Pred(ListView.Items.Count) do begin\n ListItem := ListView.Items[i];\n if iIndex = 0 then\n sCaption := ListItem.Caption\n else\n sCaption := ListItem.SubItems[iIndex - 1];\n sCompare := Copy(sCaption, 1, Length(sSearch));\n if SameText(sSearch, sCompare) then begin\n Result := i;\n break;\n end;\n end;\nend;\n\n{ Sets @sBuffer to @sTempBuffer, then selects and jumps to the item\n at @iFoundIndex in @ListView }\nprocedure ListView_HandleMatch(ListView: TListView; iFoundIndex: Integer;\n var sBuffer: string; sTempBuffer: string);\nbegin\n // Set the actual buffer to our temporary buffer\n // and jump to the item we found\n sBuffer := sTempBuffer;\n if Assigned(ListView.Selected) then\n ListView.ClearSelection;\n ListView.Selected := ListView.Items[iFoundIndex];\n ListView.Items[iFoundIndex].MakeVisible(false);\nend;\n\ninitialization\nbegin\n bAllowHelp := false;\n enFormatSettings := TFormatSettings.Create('en-us');\n enFormatSettings.DecimalSeparator := '.';\n enFormatSettings.ThousandSeparator := ',';\nend;\n\nend."
},
{
"path": "lib/mte/mteLogger.pas",
"content": "unit mteLogger;\n\ninterface\n\nuses Classes, SysUtils;\n\ntype\n TLogEvent = procedure(const group, &label, text: string) of object;\n\n TLogger = class\n private\n FLogEvent : TLogEvent;\n public\n procedure Write(const group, &label, text: string);\n property OnLogEvent: TLogEvent read FLogEvent write FLogEvent;\n end;\n\nvar Logger : TLogger;\n\nimplementation\n\nprocedure TLogger.Write(const group, &label, text: string);\nbegin\n if Assigned(FLogEvent) then\n FLogEvent(group, &label, text);\nend;\n\ninitialization\n Logger := TLogger.Create;\n\nfinalization\n FreeAndNil(Logger);\n\nend.\n"
},
{
"path": "lib/mte/mteLogging.pas",
"content": "{\n mteLogging\n created by matortheeternal\n\n This unit contains the TFilter and TLogMessage types which offer filterable\n logging for Delphi VCL applications. Log messages have a group and a label,\n and filters can apply to groups or labels.\n}\n\nunit mteLogging;\n\ninterface\n\nuses\n Classes, SysUtils, Forms,\n // mte units\n mteProgressForm, mteHelpers;\n\ntype\n TFilter = class(TObject)\n public\n group: string;\n &label: string;\n enabled: boolean;\n constructor Create(group: string; enabled: boolean); Overload;\n constructor Create(group, &label: string; enabled: boolean); Overload;\n end;\n TLogMessage = class (TObject)\n public\n time: string;\n appTime: string;\n group: string;\n &label: string;\n text: string;\n constructor Create(time, appTime, group, &label, text: string); Overload;\n end;\n\n { Log methods }\n procedure RebuildLog;\n procedure SaveLog(var Log: TList);\n function MessageEnabled(msg: TLogMessage): boolean;\n procedure ShowProgressForm(parent: TForm; var pf: TProgressForm;\n sCaption, sLogSubPath: string);\n\nvar\n BaseLog, Log, LabelFilters, GroupFilters: TList;\n LogPath: string;\n TimeCosts: TStringList;\n AppStartTime: TDateTime;\n\nimplementation\n\n{ TFilter }\nconstructor TFilter.Create(group: string; enabled: boolean);\nbegin\n self.group := group;\n self.enabled := enabled;\nend;\n\nconstructor TFilter.Create(group, &label: string; enabled: boolean);\nbegin\n self.group := group;\n self.&label := &label;\n self.enabled := enabled;\nend;\n\n{ TLogMessage }\nconstructor TLogMessage.Create(time, appTime, group, &label, text: string);\nbegin\n self.time := time;\n self.appTime := appTime;\n self.group := group;\n self.&label := &label;\n self.text := text;\nend;\n\n{******************************************************************************}\n{ Log methods\n Set of methods for logging\n\n List of methods:\n - InitLog\n - RebuildLog\n - SaveLog\n - MessageGroupEnabled\n}\n{******************************************************************************}\n\nprocedure RebuildLog;\nvar\n i: Integer;\n msg: TLogMessage;\nbegin\n Log.Clear;\n for i := 0 to Pred(BaseLog.Count) do begin\n msg := TLogMessage(BaseLog[i]);\n if MessageEnabled(msg) then\n Log.Add(msg);\n end;\nend;\n\nprocedure SaveLog(var Log: TList);\nvar\n sl: TStringList;\n i: Integer;\n msg: TLogMessage;\n fdt: string;\nbegin\n sl := TStringList.Create;\n for i := 0 to Pred(Log.Count) do begin\n msg := TLogMessage(Log[i]);\n sl.Add(Format('[%s] (%s) %s: %s', [msg.time, msg.group, msg.&label, msg.text]));\n end;\n fdt := FormatDateTime('mmddyy_hhnnss', TDateTime(Now));\n ForceDirectories(LogPath+'main\\');\n sl.SaveToFile(LogPath+'main\\log_'+fdt+'.txt');\n sl.Free;\nend;\n\nfunction GetGroupFilter(msg: TLogMessage): TFilter;\nvar\n i: Integer;\n filter: TFilter;\nbegin\n Result := nil;\n for i := 0 to Pred(GroupFilters.Count) do begin\n filter := TFilter(GroupFilters[i]);\n if filter.group = msg.group then begin\n Result := filter;\n exit;\n end;\n end;\nend;\n\nfunction GetLabelFilter(msg: TLogMessage): TFilter;\nvar\n i: Integer;\n filter: TFilter;\nbegin\n Result := nil;\n for i := 0 to Pred(LabelFilters.Count) do begin\n filter := TFilter(LabelFilters[i]);\n if (filter.&label = msg.&label) and (filter.group = msg.group) then begin\n Result := filter;\n exit;\n end;\n end;\nend;\n\nfunction MessageEnabled(msg: TLogMessage): boolean;\nvar\n GroupFilter, LabelFilter: TFilter;\nbegin\n Result := true;\n GroupFilter := GetGroupFilter(msg);\n LabelFilter := GetLabelFilter(msg);\n if GroupFilter <> nil then\n Result := Result and GroupFilter.enabled;\n if LabelFilter <> nil then\n Result := Result and LabelFilter.enabled;\nend;\n\nprocedure ShowProgressForm(parent: TForm; var pf: TProgressForm;\n sCaption, sLogSubPath: string);\nbegin\n pf := TProgressForm.Create(parent);\n pf.pfLogPath := LogPath + sLogSubPath + '\\';\n pf.PopupParent := parent;\n pf.Caption := sCaption;\n pf.SetMaxProgress(IntegerListSum(timeCosts, Pred(timeCosts.Count)));\n pf.Show;\nend;\n\ninitialization\nbegin\n BaseLog := TList.Create;\n Log := TList.Create;\n LabelFilters := TList.Create;\n GroupFilters := TList.Create;\nend;\n\nfinalization\nbegin\n FreeList(BaseLog);\n Log.Free;\nend;\n\nend.\n"
},
{
"path": "lib/mte/mtePluginSelectionForm.dfm",
"content": "object PluginSelectionForm: TPluginSelectionForm\n Left = 0\n Top = 0\n HelpType = htKeyword\n HelpKeyword = 'Plugin Selection Window'\n Caption = 'Plugin Selection'\n ClientHeight = 647\n ClientWidth = 504\n Color = clBtnFace\n Constraints.MinHeight = 400\n Constraints.MinWidth = 400\n Font.Charset = DEFAULT_CHARSET\n Font.Color = clWindowText\n Font.Height = -11\n Font.Name = 'Tahoma'\n Font.Style = []\n OldCreateOrder = False\n Position = poScreenCenter\n OnClose = FormClose\n OnShow = FormShow\n PixelsPerInch = 96\n TextHeight = 13\n object lvPlugins: TListView\n Left = 8\n Top = 8\n Width = 488\n Height = 600\n HelpType = htKeyword\n HelpKeyword = 'Plugin Selection Styles'\n Align = alCustom\n Anchors = [akLeft, akTop, akRight, akBottom]\n Columns = <>\n ColumnClick = False\n DoubleBuffered = True\n MultiSelect = True\n OwnerData = True\n OwnerDraw = True\n ReadOnly = True\n RowSelect = True\n ParentDoubleBuffered = False\n ParentShowHint = False\n PopupMenu = PluginsPopupMenu\n ShowHint = False\n StateImages = StateImages\n TabOrder = 0\n ViewStyle = vsReport\n OnChange = lvPluginsChange\n OnData = lvPluginsData\n OnDrawItem = lvPluginsDrawItem\n OnKeyPress = lvPluginsKeyPress\n OnMouseDown = lvPluginsMouseDown\n OnMouseMove = lvPluginsMouseMove\n end\n object btnCancel: TButton\n Left = 421\n Top = 614\n Width = 75\n Height = 25\n HelpType = htKeyword\n HelpKeyword = 'Plugin Selection Actions'\n Align = alCustom\n Anchors = [akRight, akBottom]\n Caption = 'Cancel'\n ModalResult = 2\n TabOrder = 1\n end\n object btnOK: TButton\n Left = 340\n Top = 614\n Width = 75\n Height = 25\n HelpType = htKeyword\n HelpKeyword = 'Plugin Selection Actions'\n Align = alCustom\n Anchors = [akRight, akBottom]\n Caption = 'OK'\n Default = True\n ModalResult = 1\n TabOrder = 2\n OnClick = btnOKClick\n end\n object PluginsPopupMenu: TPopupMenu\n OnPopup = PluginsPopupMenuPopup\n Left = 48\n Top = 24\n object CheckAllItem: TMenuItem\n Caption = 'Check all'\n OnClick = CheckAllItemClick\n end\n object UncheckAllItem: TMenuItem\n Caption = 'Uncheck all'\n OnClick = UncheckAllItemClick\n end\n object ToggleAllItem: TMenuItem\n Caption = 'Toggle all'\n OnClick = ToggleAllItemClick\n end\n object N1: TMenuItem\n Caption = '-'\n end\n object MastersItem: TMenuItem\n Caption = 'Masters'\n object CheckMastersItem: TMenuItem\n Caption = 'Check masters'\n OnClick = CheckMastersItemClick\n end\n object UncheckMastersItem: TMenuItem\n Caption = 'Uncheck masters'\n OnClick = UncheckMastersItemClick\n end\n end\n object DependenciesItem: TMenuItem\n Caption = 'Dependencies'\n object CheckDependenciesItem: TMenuItem\n Caption = 'Check dependencies'\n OnClick = CheckDependenciesItemClick\n end\n object UncheckDependenciesItem: TMenuItem\n Caption = 'Uncheck dependencies'\n OnClick = UncheckDependenciesItemClick\n end\n end\n end\n object StateImages: TImageList\n Height = 17\n Width = 17\n Left = 136\n Top = 24\n Bitmap = {\n 494C010103003400600011001100FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600\n 0000000000003600000028000000440000001100000001002000000000001012\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E00000000000000000000000000000000008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E000000000000000000000000000000\n 00008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 000000000000000000008F8F8E00F4F4F400F4F4F400F4F4F400F5F5F500F9F9\n F900F8F8F800F5F5F500F4F4F400F4F4F400F4F4F400F4F4F4008F8F8E000000\n 00000000000000000000000000008F8F8E00F4F4F400F4F4F400F4F4F400F5F5\n F500F9F9F900F8F8F800F5F5F500F4F4F400F4F4F400F4F4F400F4F4F4008F8F\n 8E00000000000000000000000000000000008F8F8E00F4F4F400F4F4F400F4F4\n F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4\n F4008F8F8E000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E00F4F4\n F400CCCBCA00DBDADA00E9E2DF00BA998C00BD9D9000F6F3F200EDEDEC00ECEB\n EB00EAE9E900F4F4F4008F8F8E00000000000000000000000000000000008F8F\n 8E00F4F4F400CCCBCA00DBDADA00E9E2DF00BA998C00BD9D9000F6F3F200EDED\n EC00ECEBEB00EAE9E900F4F4F4008F8F8E000000000000000000000000000000\n 00008F8F8E00F4F4F400CCCBCA00D5D4D400DCDBDB00E1E1E000E7E7E600EBEB\n EA00ECECEB00ECEBEB00EAE9E900F4F4F4008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 000000000000000000008F8F8E00F4F4F400CAC8C600F0ECEA00BB998B00975F\n 4A0098614C00D1B9B000F9F9F900F6F6F600E6E6E600F4F4F4008F8F8E000000\n 00000000000000000000000000008F8F8E00F4F4F400CAC8C600F0ECEA00BB99\n 8B00975F4A0098614C00D1B9B000F9F9F900F6F6F600E6E6E600F4F4F4008F8F\n 8E00000000000000000000000000000000008F8F8E00F4F4F400C6C4C200E9E9\n E900EDEDED00F0F0F000F4F4F400F6F6F600F6F6F600F6F6F600E6E6E600F4F4\n F4008F8F8E000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E00F4F4\n F400D1CFCD00E9E1DE00955D4800965F490097604B00A4736100FAF9F800F4F4\n F400E2E2E100F4F4F4008F8F8E00000000000000000000000000000000008F8F\n 8E00F4F4F400D1CFCD00E9E1DE00955D4800965F490097604B00A4736100FAF9\n F800F4F4F400E2E2E100F4F4F4008F8F8E000000000000000000000000000000\n 00008F8F8E00F4F4F400C2BFBC00E5E4E300E9E9E900EDEDED00F2F2F200F4F4\n F400F5F5F500F4F4F400E2E2E100F4F4F4008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 000000000000000000008F8F8E00F4F4F400E1E0DE00AA7F6E00945C4700E2D4\n CF00A778670097604B00D5BFB700F6F6F600DEDDDC00F4F4F4008F8F8E000000\n 00000000000000000000000000008F8F8E00F4F4F400E1E0DE00AA7F6E00945C\n 4700E2D4CF00A778670097604B00D5BFB700F6F6F600DEDDDC00F4F4F4008F8F\n 8E00000000000000000000000000000000008F8F8E00F4F4F400BFBBB800E1DF\n DD00E5E5E400EAEAEA00EFEFEF00F2F2F200F2F2F200F2F2F200DEDDDC00F4F4\n F4008F8F8E000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E00F4F4\n F400CDC9C500DDCFC900C8AEA300EEEEED00D5C1BA00965E4900A5766400F8F8\n F800D6D5D500F4F4F4008F8F8E00000000000000000000000000000000008F8F\n 8E00F4F4F400CDC9C500DDCFC900C8AEA300EEEEED00D5C1BA00965E4900A576\n 6400F8F8F800D6D5D500F4F4F4008F8F8E000000000000000000000000000000\n 00008F8F8E00F4F4F400BCB7B200DCD8D500DFDCDA00E3E1E000E8E8E800ECEC\n EC00EDEDED00EDEDED00D6D5D400F4F4F4008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 000000000000000000008F8F8E00F4F4F400B9B3AE00DDD9D500E5E2DF00DCD8\n D500F4F3F200A1715E00945C4700D6C3BC00DCDCDB00F4F4F4008F8F8E000000\n 00000000000000000000000000008F8F8E00F4F4F400B9B3AE00DDD9D500E5E2\n DF00DCD8D500F4F3F200A1715E00945C4700D6C3BC00DCDCDB00F4F4F4008F8F\n 8E00000000000000000000000000000000008F8F8E00F4F4F400B9B3AE00D7D1\n CD00D9D4D000DBD7D400DFDDDB00E3E2E100E6E6E500E8E8E800CDCDCC00F4F4\n F4008F8F8E000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E00F4F4\n F400B9B3AE00D5CFCB00D5CFCB00D6D1CD00E6E2E000CFB8AF00925A4500A577\n 6500E8E7E700F4F4F4008F8F8E00000000000000000000000000000000008F8F\n 8E00F4F4F400B9B3AE00D5CFCB00D5CFCB00D6D1CD00E6E2E000CFB8AF00925A\n 4500A5776500E8E7E700F4F4F4008F8F8E000000000000000000000000000000\n 00008F8F8E00F4F4F400B9B3AE00D5CFCB00D5CFCB00D6D1CD00DAD5D200DEDB\n D800E1DFDD00E4E3E200C8C7C600F4F4F4008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 000000000000000000008F8F8E00F4F4F400B9B3AE00D5CFCB00D5CFCB00D5CF\n CB00D6D0CC00F1EEED009D6A5700925A4400D0BFB900F6F6F6008F8F8E000000\n 00000000000000000000000000008F8F8E00F4F4F400B9B3AE00D5CFCB00D5CF\n CB00D5CFCB00D6D0CC00F1EEED009D6A5700925A4400D0BFB900F6F6F6008F8F\n 8E00000000000000000000000000000000008F8F8E00F4F4F400B9B3AE00D5CF\n CB00D5CFCB00D5CFCB00D5CFCB00D8D3D000DCD8D500DFDDDB00C5C3C100F4F4\n F4008F8F8E000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E00F4F4\n F400B9B3AE00B9B3AE00B9B3AE00B9B3AE00B9B3AE00D0CCC900C0A79D00AB86\n 7700E4DFDC00F5F5F5008F8F8E00000000000000000000000000000000008F8F\n 8E00F4F4F400B9B3AE00B9B3AE00B9B3AE00B9B3AE00B9B3AE00D0CCC900C0A7\n 9D00AB867700E4DFDC00F5F5F5008F8F8E000000000000000000000000000000\n 00008F8F8E00F4F4F400B9B3AE00B9B3AE00B9B3AE00B9B3AE00B9B3AE00B9B3\n AE00BAB4AF00BDB9B400C1BEBB00F4F4F4008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 000000000000000000008F8F8E00F4F4F400F4F4F400F4F4F400F4F4F400F4F4\n F400F4F4F400F4F4F400F8F8F800F9F9F900F6F6F600F4F4F4008F8F8E000000\n 00000000000000000000000000008F8F8E00F4F4F400F4F4F400F4F4F400F4F4\n F400F4F4F400F4F4F400F4F4F400F8F8F800F9F9F900F6F6F600F4F4F4008F8F\n 8E00000000000000000000000000000000008F8F8E00F4F4F400F4F4F400F4F4\n F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4F400F4F4\n F4008F8F8E000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 00000000000000000000000000000000000000000000000000008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E00000000000000000000000000000000008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E000000000000000000000000000000\n 00008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F\n 8E008F8F8E008F8F8E008F8F8E008F8F8E008F8F8E0000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000000000000000000000000000000000000000000000000000000000000000\n 0000424D3E000000000000003E00000028000000440000001100000001000100\n 00000000CC0000000000000000000000000000000000000000000000FFFFFF00\n FFFFFFFFFFFFE00000000000FFFFFFFFFFFFE00000000000C001E000F0006000\n 00000000C001E000F000600000000000C001E000F000600000000000C001E000\n F000600000000000C001E000F000600000000000C001E000F000600000000000\n C001E000F000600000000000C001E000F000600000000000C001E000F0006000\n 00000000C001E000F000600000000000C001E000F000600000000000C001E000\n F000600000000000C001E000F000600000000000FFFFFFFFFFFFE00000000000\n FFFFFFFFFFFFE000000000000000000000000000000000000000000000000000\n 0000}\n end\nend\n"
},
{
"path": "lib/mte/mtePluginSelectionForm.pas",
"content": "unit mtePluginSelectionForm;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\n Dialogs, StdCtrls, CommCtrl, Menus, ComCtrls, ImgList;\n\ntype\n TPluginListItem = class(TObject)\n public\n StateIndex: Integer;\n Fields: TStringList;\n constructor Create; virtual;\n destructor Destroy; override;\n end;\n TStringFunction = function(s: string): string of object;\n TStringListProcedure = procedure(fn: string; var sl: TStringList) of object;\n TPluginSelectionForm = class(TForm)\n lvPlugins: TListView;\n btnCancel: TButton;\n btnOK: TButton;\n PluginsPopupMenu: TPopupMenu;\n CheckAllItem: TMenuItem;\n UncheckAllItem: TMenuItem;\n ToggleAllItem: TMenuItem;\n StateImages: TImageList;\n MastersItem: TMenuItem;\n N1: TMenuItem;\n CheckMastersItem: TMenuItem;\n UncheckMastersItem: TMenuItem;\n CheckDependenciesItem: TMenuItem;\n UncheckDependenciesItem: TMenuItem;\n DependenciesItem: TMenuItem;\n procedure LoadFields(aListItem: TPluginListItem; sPlugin: string);\n procedure UpdateDisabled;\n procedure FormShow(Sender: TObject);\n procedure btnOKClick(Sender: TObject);\n procedure CheckAllItemClick(Sender: TObject);\n procedure UncheckAllItemClick(Sender: TObject);\n procedure ToggleAllItemClick(Sender: TObject);\n procedure lvPluginsMouseDown(Sender: TObject; Button: TMouseButton;\n Shift: TShiftState; X, Y: Integer);\n procedure lvPluginsChange(Sender: TObject; Item: TListItem;\n Change: TItemChange);\n procedure lvPluginsKeyPress(Sender: TObject; var Key: Char);\n procedure DrawCheckbox(aCanvas: TCanvas; var x, y: Integer; state: Integer);\n procedure DrawSubItems(ListView: TListView; var R: TRect; Item: TListItem);\n procedure DrawItem(ListView: TListView; var R: TRect; Item: TListItem);\n procedure lvPluginsDrawItem(Sender: TCustomListView; Item: TListItem;\n Rect: TRect; State: TOwnerDrawState);\n procedure lvPluginsMouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\n function GetMasterStatus(filename: string): Integer;\n procedure lvPluginsData(Sender: TObject; Item: TListItem);\n procedure FormClose(Sender: TObject; var Action: TCloseAction);\n procedure CheckMastersItemClick(Sender: TObject);\n procedure UncheckMastersItemClick(Sender: TObject);\n procedure CheckDependenciesItemClick(Sender: TObject);\n procedure UncheckDependenciesItemClick(Sender: TObject);\n procedure PluginsPopupMenuPopup(Sender: TObject);\n private\n { Private declarations }\n slMasters, slDependencies, slMissing, slDisabled: TStringList;\n ListItems: TList;\n sLastHint: string;\n sBuffer: string;\n fLastBufferTime: TDateTime;\n public\n { Public declarations }\n GetPluginInfo: TStringFunction;\n GetPluginMasters: TStringListProcedure;\n GetPluginDependencies: TStringListProcedure;\n sColumns: string;\n slAllPlugins, slCheckedPlugins: TStringList;\n end;\n\nvar\n PluginSelectionForm: TPluginSelectionForm;\n\nimplementation\n\nuses\n mteHelpers;\n\nconst\n // delay for clearing keystroke buffer when\n // performing a text search on a list view\n fBufferDelay = 1.1 * seconds;\n // checkbox states\n cChecked = 1;\n cUnChecked = 2;\n // master states\n mstNone = 0;\n mstMaster = 1;\n mstDependency = 2;\n mstBoth = 3;\n mstMissing = 4;\n mstDisabled = 5;\n\n{$R *.dfm}\n\nconstructor TPluginListItem.Create;\nbegin\n StateIndex := cUnChecked;\n Fields := TStringList.Create;\nend;\n\ndestructor TPluginListItem.Destroy;\nbegin\n Fields.Free;\nend;\n\nprocedure TPluginSelectionForm.btnOKClick(Sender: TObject);\nvar\n i: Integer;\n ListItem: TListItem;\nbegin\n // clear checked plugins list\n slCheckedPlugins.Clear;\n // add checked plugins to slCheckedPlugins\n for i := 0 to Pred(lvPlugins.Items.Count) do begin\n ListItem := lvPlugins.Items[i];\n if ListItem.StateIndex = cChecked then\n slCheckedPlugins.Add(ListItem.Caption);\n end;\nend;\n\nprocedure TPluginSelectionForm.LoadFields(aListItem: TPluginListItem;\n sPlugin: string);\nvar\n sl: TStringList;\n i: Integer;\nbegin\n // add plugin filename\n aListItem.fields.Add(sPlugin);\n\n // get comma separated plugin info in a TStringList\n sl := TStringList.Create;\n sl.StrictDelimiter := true;\n try\n sl.CommaText := GetPluginInfo(sPlugin);\n for i := 0 to Pred(sl.Count) do\n aListItem.Fields.Add(sl[i]);\n finally\n sl.Free;\n end;\nend;\n\nprocedure TPluginSelectionForm.UpdateDisabled;\nvar\n i, j, index: Integer;\n filename: string;\n ListItem, MasterItem: TPluginListItem;\n sl: TStringList;\nbegin\n // update slDisabled\n slDisabled.Clear;\n sl := TStringList.Create;\n try\n for i := 0 to Pred(lvPlugins.Items.Count) do begin\n ListItem := TPluginListItem(ListItems[i]);\n filename := ListItem.Fields[0];\n // if unchecked, skip\n if ListItem.StateIndex = cUnChecked then\n continue;\n // if checked, make sure its masters are checked\n GetPluginMasters(filename, sl);\n for j := 0 to Pred(sl.Count) do begin\n index := slAllPlugins.IndexOf(sl[j]);\n // if master is not found, continue\n if (index = -1) then\n continue;\n // if master is unchecked, add to slDisabled\n MasterItem := TPluginListItem(ListItems[index]);\n if MasterItem.StateIndex = cUnChecked then\n slDisabled.Add(sl[j]);\n end;\n // clear masters\n sl.Clear;\n end;\n finally\n sl.Free;\n end;\n\n // disable OK button if there are any disabled masters\n btnOK.Enabled := slDisabled.Count = 0;\nend;\n\nprocedure ToggleState(ListItem: TPluginListItem);\nbegin\n case ListItem.StateIndex of\n cChecked: ListItem.StateIndex := cUnChecked;\n cUnChecked: ListItem.StateIndex := cChecked;\n end;\nend;\n\nprocedure TPluginSelectionForm.lvPluginsChange(Sender: TObject; Item: TListItem;\n Change: TItemChange);\nvar\n i: Integer;\n filename: string;\nbegin\n // update slMasters and slDependencies\n slMasters.Clear;\n slDependencies.Clear;\n for i := 0 to Pred(lvPlugins.Items.Count) do begin\n filename := TPluginListItem(ListItems[i]).Fields[0];\n with lvPlugins.Items[i] do\n if Selected then begin\n GetPluginMasters(filename, slMasters);\n GetPluginDependencies(filename, slDependencies);\n end;\n end;\n\n // repaint to update master/dependency colors\n lvPlugins.Repaint;\nend;\n\nfunction TPluginSelectionForm.GetMasterStatus(filename: string): Integer;\nvar\n bIsDependency, bIsMaster: boolean;\nbegin\n // if file has masters that are missing from slAllPlugins,\n // return mstMissing\n if slMissing.IndexOf(filename) > -1 then begin\n Result := mstMissing;\n exit;\n end;\n\n // if file has masters that are disabled,\n // return mstDisabled\n if slDisabled.IndexOf(filename) > -1 then begin\n Result := mstDisabled;\n exit;\n end;\n\n // compute master or dependency status based on selection\n bIsMaster := slMasters.IndexOf(filename) > -1;\n bIsDependency := slDependencies.IndexOf(filename) > -1;\n Result := IfThenInt(bIsMaster, 1, 0) + IfThenInt(bIsDependency, 2, 0);\nend;\n\nprocedure TPluginSelectionForm.lvPluginsData(Sender: TObject; Item: TListItem);\nvar\n aListItem: TPluginListItem;\n MasterStatus: Integer;\n i: Integer;\nbegin\n // get item data\n aListItem := ListItems[Item.Index];\n Item.Caption := aListItem.Fields[0];\n Item.StateIndex := aListItem.StateIndex;\n // get subitems\n for i := 1 to Pred(aListItem.fields.Count) do\n Item.SubItems.Add(aListItem.fields[i]);\n\n // set font color based on master status of item\n lvPlugins.Canvas.Font.Style := [fsBold];\n MasterStatus := GetMasterStatus(Item.Caption);\n case MasterStatus of\n mstNone: begin\n lvPlugins.Canvas.Font.Style := [];\n lvPlugins.Canvas.Font.Color := clBlack;\n end;\n mstMaster: lvPlugins.Canvas.Font.Color := clGreen;\n mstDependency: lvPlugins.Canvas.Font.Color := clMaroon;\n mstBoth: lvPlugins.Canvas.Font.Color := clPurple;\n mstMissing: begin\n lvPlugins.Canvas.Font.Style := [fsItalic];\n lvPlugins.Canvas.Font.Color := clGray;\n end;\n mstDisabled: begin\n lvPlugins.Canvas.Font.Style := [fsItalic];\n lvPlugins.Canvas.Font.Color := clRed;\n end;\n end;\nend;\n\nprocedure TPluginSelectionForm.DrawCheckbox(aCanvas: TCanvas; var x, y: Integer;\n state: Integer);\nvar\n icon: TIcon;\nbegin\n if state = 0 then\n exit;\n icon := TIcon.Create;\n StateImages.GetIcon(state, icon);\n aCanvas.Draw(x, y, icon);\n Inc(x, 17);\n icon.Free;\nend;\n\nprocedure TPluginSelectionForm.DrawSubItems(ListView: TListView; var R: TRect;\n Item: TListItem);\nvar\n i: Integer;\nbegin\n for i := 0 to Pred(Item.SubItems.Count) do begin\n // redefine rect to draw in the space for the column\n // use trailing padding to keep items lined up on columns\n R.Left := R.Right;\n R.Right := R.Left + ListView_GetColumnWidth(ListView.Handle, i) - 3;\n\n // padding between items\n Inc(R.Left, 3);\n\n // draw text\n ListView.Canvas.TextRect(R, R.Left, R.Top, Item.SubItems[i]);\n end;\nend;\n\nprocedure TPluginSelectionForm.DrawItem(ListView: TListView; var R: TRect;\n Item: TListItem);\nbegin\n // redefine rect to draw until the end of the first column\n // use trailing padding to keep items lined up on columns\n R.Right := R.Left + ListView.Columns[0].Width - 3;\n\n // draw the checkbox\n DrawCheckbox(ListView.Canvas, R.Left, R.Top, Item.StateIndex);\n\n // move text down 1 pixel\n Inc(R.Top, 1);\n // padding between checkbox and text\n Inc(R.Left, 6);\n\n // draw text\n ListView.Canvas.TextRect(R, R.Left, R.Top, Item.Caption);\nend;\n\nprocedure TPluginSelectionForm.lvPluginsDrawItem(Sender: TCustomListView;\n Item: TListItem; Rect: TRect; State: TOwnerDrawState);\nvar\n ListView: TListView;\nbegin\n // draw background color\n ListView := TListView(Sender);\n if Item.Selected then begin\n ListView.Canvas.Brush.Color := $FFEEDD;\n ListView.Canvas.FillRect(Rect);\n end;\n\n // draw item\n DrawItem(ListView, Rect, Item);\n // draw subitem\n DrawSubItems(ListView, Rect, Item);\nend;\n\nprocedure TPluginSelectionForm.lvPluginsKeyPress(Sender: TObject;\n var Key: Char);\nvar\n i, iFoundIndex: Integer;\n ListItem: TListItem;\n fBufferDiff: Real;\n sTempBuffer: string;\nbegin\n // Calculate time between current keystroke and last\n // keystroke we buffered\n fBufferDiff := Now - fLastBufferTime;\n\n // If we are within the buffer delay append the key to a\n // temporary buffer and search for next item matching the\n // buffer in the list view items.\n if fBufferDiff < fBufferDelay then begin\n fLastBufferTime := Now;\n sTempBuffer := sBuffer + Key;\n iFoundIndex := ListView_NextMatch(lvPlugins, sTempBuffer, 0);\n // If we found a match, handle it\n if iFoundIndex > -1 then begin\n ListView_HandleMatch(lvPlugins, iFoundIndex, sBuffer, sTempBuffer);\n Key := #0;\n end;\n end\n else begin\n // Allow user to use space to toggle checkbox state\n // for all selected items\n if Key = ' ' then begin\n for i := 0 to Pred(lvPlugins.Items.Count) do begin\n ListItem := lvPlugins.Items[i];\n if ListItem.Selected then\n if slMissing.IndexOf(slAllPlugins[i]) = -1 then\n ToggleState(TPluginListItem(ListItems[i]));\n end;\n // repaint to show updated checkbox state and exit\n UpdateDisabled;\n lvPlugins.Repaint;\n exit;\n end;\n\n // Restart buffering if we didn't have an active buffer\n // or press space\n fLastBufferTime := Now;\n sTempBuffer := Key;\n lvPlugins.ClearSelection;\n iFoundIndex := ListView_NextMatch(lvPlugins, sTempBuffer, 0);\n // If we found a match, handle it\n if iFoundIndex > -1 then begin\n ListView_HandleMatch(lvPlugins, iFoundIndex, sBuffer, sTempBuffer);\n Key := #0;\n end;\n end;\nend;\n\nfunction OnStateIcon(X, Y: Integer): Boolean;\nbegin\n Result := (x >= 2) and (x <= 14);\nend;\n\nprocedure TPluginSelectionForm.lvPluginsMouseDown(Sender: TObject;\n Button: TMouseButton; Shift: TShiftState; X, Y: Integer);\nvar\n ListItem: TListItem;\nbegin\n // toggle checkbox state\n ListItem := lvPlugins.GetItemAt(X, Y);\n if OnStateIcon(X, Y) then begin\n if slMissing.IndexOf(slAllPlugins[ListItem.Index]) = -1 then\n ToggleState(TPluginListItem(ListItems[ListItem.Index]));\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\n end;\nend;\n\nprocedure TPluginSelectionForm.lvPluginsMouseMove(Sender: TObject;\n Shift: TShiftState; X, Y: Integer);\nvar\n pt: TPoint;\n li : TListItem;\n hint, str: string;\n slTempMasters, slTempReq: TStringList;\n i: Integer;\nbegin\n // get list item at mouse position\n li := lvPlugins.GetItemAt(X, Y);\n // if mouse not over an item, exit\n if not Assigned(li) then\n exit;\n\n slTempMasters := TStringList.Create;\n try\n GetPluginMasters(li.Caption, slTempMasters);\n if slMissing.IndexOf(li.Caption) > -1 then begin\n str := '';\n for i := 0 to Pred(slTempMasters.Count) do\n if slAllPlugins.IndexOf(slTempMasters[i]) = -1 then\n str := str + slTempMasters[i] + #13#10;\n hint := Format('Missing masters:'#13#10'%s', [str]);\n end\n else if slTempMasters.Count > 0 then\n hint := Format('Masters:'#13#10'%s'#13#10, [slTempMasters.Text]);\n finally\n slTempMasters.Free;\n end;\n\n // get plugin dependencies and display them if they're present\n slTempReq := TStringList.Create;\n try\n GetPluginDependencies(li.Caption, slTempReq);\n if slTempReq.Count > 0 then\n hint := hint + Format('Required By:'#13#10'%s', [slTempReq.Text]);\n finally\n slTempReq.Free;\n end;\n\n // trim the hint\n hint := Trim(hint);\n\n // activate hint if it differs from previously displayed hint\n if (hint <> sLastHint) then begin\n sLastHint := hint;\n lvPlugins.ShowHint := True;\n lvPlugins.Hint := hint;\n Application.ActivateHint(Mouse.CursorPos);\n end;\nend;\n\nprocedure TPluginSelectionForm.FormClose(Sender: TObject;\n var Action: TCloseAction);\nbegin\n slMasters.Free;\n slDependencies.Free;\n slMissing.Free;\n slDisabled.Free;\n ListItems.Free;\nend;\n\nprocedure TPluginSelectionForm.FormShow(Sender: TObject);\nvar\n i, j, iColumnSize: Integer;\n aListItem: TPluginListItem;\n sPlugin: string;\n sl: TStringList;\n aColumn: TListColumn;\nbegin\n // create lists\n slMasters := TStringList.Create;\n slDependencies := TStringList.Create;\n slMissing := TStringList.Create;\n slDisabled := TStringList.Create;\n ListItems := TList.Create;\n\n // create columns\n sl := TStringList.Create;\n try\n sl.CommaText := sColumns;\n iColumnSize := (lvPlugins.ClientWidth - 300) div (sl.Count - 1);\n for i := 0 to Pred(sl.Count) do begin\n aColumn := lvPlugins.Columns.Add;\n aColumn.Caption := sl[i];\n aColumn.Width := IfThenInt(i = 0, 300, iColumnSize);\n end;\n // make first column autosize\n lvPlugins.Columns[0].AutoSize := true;\n finally\n sl.Free;\n end;\n\n // add plugin items to list\n for i := 0 to Pred(slAllPlugins.Count) do begin\n sPlugin := slAllPlugins[i];\n aListItem := TPluginListItem.Create;\n // check ListItem if it's in the CheckedPlugins list\n if slCheckedPlugins.IndexOf(sPlugin) > -1 then\n aListItem.StateIndex := cChecked;\n // add patch subitems\n LoadFields(aListItem, sPlugin);\n ListItems.Add(aListItem);\n end;\n\n // determine which plugins can't be loaded because their masters\n // are missing\n sl := TStringList.Create;\n try\n for i := 0 to Pred(slAllPlugins.Count) do begin\n sPlugin := slAllPlugins[i];\n aListItem := TPluginListItem(ListItems[i]);\n GetPluginMasters(sPlugin, sl);\n for j := 0 to Pred(sl.Count) do\n if slAllPlugins.IndexOf(sl[j]) = -1 then begin\n slMissing.Add(sPlugin);\n aListItem.StateIndex := cUnChecked;\n break;\n end;\n sl.Clear;\n end;\n finally\n sl.Free;\n end;\n\n // set plugin count for display\n lvPlugins.Items.Count := slAllPlugins.Count;\n ListView_CorrectWidth(lvPlugins);\n\n // update disabled\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.PluginsPopupMenuPopup(Sender: TObject);\nvar\n bHasMasters, bHasDependencies: Boolean;\nbegin\n bHasMasters := slMasters.Count > 0;\n bHasDependencies := slDependencies.Count > 0;\n MastersItem.Enabled := bHasMasters;\n DependenciesItem.Enabled := bHasDependencies;\nend;\n\nprocedure TPluginSelectionForm.CheckAllItemClick(Sender: TObject);\nvar\n i: Integer;\nbegin\n for i := 0 to Pred(lvPlugins.Items.Count) do\n if slMissing.IndexOf(slAllPlugins[i]) = -1 then\n TPluginListItem(ListItems[i]).StateIndex := cChecked;\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.UncheckAllItemClick(Sender: TObject);\nvar\n i: Integer;\nbegin\n for i := 0 to Pred(lvPlugins.Items.Count) do\n TPluginListItem(ListItems[i]).StateIndex := cUnChecked;\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.ToggleAllItemClick(Sender: TObject);\nvar\n i: Integer;\nbegin\n for i := 0 to Pred(lvPlugins.Items.Count) do\n if slMissing.IndexOf(slAllPlugins[i]) = -1 then\n ToggleState(TPluginListItem(ListItems[i]));\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.CheckMastersItemClick(Sender: TObject);\nvar\n i, index: Integer;\nbegin\n // loop through masters of selected plugins\n for i := 0 to Pred(slMasters.Count) do begin\n index := slAllPlugins.IndexOf(slMasters[i]);\n // if the masters isn't loaded, skip it\n if index = -1 then\n continue;\n // else check it\n TPluginListItem(ListItems[index]).StateIndex := cChecked;\n end;\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.UncheckMastersItemClick(Sender: TObject);\nvar\n i, index: Integer;\nbegin\n // loop through masters of selected plugins\n for i := 0 to Pred(slMasters.Count) do begin\n index := slAllPlugins.IndexOf(slMasters[i]);\n // if the masters isn't loaded, skip it\n if index = -1 then\n continue;\n // else uncheck it\n TPluginListItem(ListItems[index]).StateIndex := cUnChecked;\n end;\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.CheckDependenciesItemClick(Sender: TObject);\nvar\n i, index: Integer;\nbegin\n // loop through dependencies of selected plugins\n for i := 0 to Pred(slDependencies.Count) do begin\n index := slAllPlugins.IndexOf(slDependencies[i]);\n // check it\n TPluginListItem(ListItems[index]).StateIndex := cChecked;\n end;\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nprocedure TPluginSelectionForm.UncheckDependenciesItemClick(Sender: TObject);\nvar\n i, index: Integer;\nbegin\n // loop through dependencies of selected plugins\n for i := 0 to Pred(slDependencies.Count) do begin\n index := slAllPlugins.IndexOf(slDependencies[i]);\n // uncheck it\n TPluginListItem(ListItems[index]).StateIndex := cUnChecked;\n end;\n\n // repaint to show updated checkbox state\n UpdateDisabled;\n lvPlugins.Repaint;\nend;\n\nend.\n"
},
{
"path": "lib/mte/mteProgressForm.dfm",
"content": "object ProgressForm: TProgressForm\n Left = 0\n Top = 0\n Caption = 'Progress'\n ClientHeight = 342\n ClientWidth = 624\n Color = clBtnFace\n DoubleBuffered = True\n Font.Charset = DEFAULT_CHARSET\n Font.Color = clWindowText\n Font.Height = -11\n Font.Name = 'Tahoma'\n Font.Style = []\n OldCreateOrder = False\n Position = poMainFormCenter\n OnClose = FormClose\n OnCloseQuery = FormCloseQuery\n OnCreate = FormCreate\n OnShow = FormShow\n PixelsPerInch = 96\n TextHeight = 13\n object ProgressLabel: TLabel\n Left = 8\n Top = 8\n Width = 608\n Height = 13\n Align = alCustom\n Anchors = [akLeft, akTop, akRight]\n AutoSize = False\n Caption = 'Progress message'\n end\n object DetailsMemo: TMemo\n Left = 8\n Top = 58\n Width = 608\n Height = 245\n Align = alCustom\n Anchors = [akLeft, akTop, akRight, akBottom]\n ReadOnly = True\n ScrollBars = ssVertical\n TabOrder = 0\n end\n object DetailsButton: TButton\n Left = 428\n Top = 309\n Width = 91\n Height = 25\n Align = alCustom\n Anchors = [akRight, akBottom]\n Caption = 'Hide details'\n TabOrder = 1\n OnClick = ToggleDetails\n end\n object ProgressBar: TProgressBar\n Left = 8\n Top = 27\n Width = 608\n Height = 25\n Align = alCustom\n Anchors = [akLeft, akTop, akRight]\n TabOrder = 2\n end\n object CancelButton: TButton\n Left = 525\n Top = 309\n Width = 91\n Height = 25\n Align = alCustom\n Anchors = [akRight, akBottom]\n Caption = 'Cancel'\n TabOrder = 3\n OnClick = CancelButtonClick\n end\nend\n"
},
{
"path": "lib/mte/mteProgressForm.pas",
"content": "unit mteProgressForm;\n\ninterface\n\nuses\n Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\n Dialogs, StdCtrls, ComCtrls,\n // mte components\n W7Taskbar, mteTracker;\n\ntype\n TProgressForm = class(TForm)\n DetailsMemo: TMemo;\n DetailsButton: TButton;\n ProgressBar: TProgressBar;\n ProgressLabel: TLabel;\n CancelButton: TButton;\n procedure UpdateProgress(const i: Integer);\n procedure StatusMessage(const s: string);\n procedure Write(const s: string);\n procedure SaveLog;\n procedure SetProgress(const i: Integer);\n procedure SetMaxProgress(const i: Integer);\n function GetProgress: Integer;\n function GetMaxProgress: Integer;\n procedure FormCreate(Sender: TObject);\n procedure FormClose(Sender: TObject; var Action: TCloseAction);\n procedure ToggleDetails(Sender: TObject);\n procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);\n procedure CancelButtonClick(Sender: TObject);\n procedure FormShow(Sender: TObject);\n private\n { Private declarations }\n public\n bDetailsVisible: boolean;\n pfLogPath: string;\n end;\n\nimplementation\n\nvar\n lastHeight: integer;\n\n{$R *.dfm}\n\nprocedure TProgressForm.ToggleDetails(Sender: TObject);\nbegin\n bDetailsVisible := not bDetailsVisible;\n if bDetailsVisible then begin\n self.Height := lastHeight;\n DetailsMemo.Visible := true;\n DetailsButton.Caption := 'Hide details';\n DetailsMemo.Height := self.Height - 135;\n end\n else begin\n DetailsMemo.Visible := false;\n DetailsButton.Caption := 'Show details';\n lastHeight := self.Height;\n self.Height := 129;\n end;\nend;\n\nprocedure TProgressForm.CancelButtonClick(Sender: TObject);\nbegin\n Close;\nend;\n\nprocedure TProgressForm.FormClose(Sender: TObject; var Action: TCloseAction);\nbegin\n SetTaskbarProgressState(tbpsNone);\n Tracker.OnSetMaxEvent := nil;\n Tracker.OnUpdateEvent := nil;\n Tracker.OnLogEvent := nil;\n Tracker.OnSetEvent := nil;\n Tracker.OnGetEvent := nil;\n Tracker.OnGetMaxEvent := nil;\n Tracker.OnStatusEvent := nil;\nend;\n\nprocedure TProgressForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);\nbegin\n CanClose := (fsModal in FormState);\n //Tracker.Write('CanClose = '+BoolToStr(CanClose, true));\n if not (CanClose or Tracker.Cancel) then begin\n Tracker.Write('Cancelling...');\n SetTaskbarProgressState(tbpsError);\n Tracker.Cancel := true;\n end;\nend;\n\nprocedure TProgressForm.FormCreate(Sender: TObject);\nbegin\n lastHeight := 380;\n SetTaskbarProgressState(tbpsNormal);\n bDetailsVisible := true;\n DetailsMemo.ReadOnly := true;\n Tracker.OnSetMaxEvent := SetMaxProgress;\n Tracker.OnUpdateEvent := UpdateProgress;\n Tracker.OnLogEvent := Write;\n Tracker.OnSetEvent := SetProgress;\n Tracker.OnStatusEvent := StatusMessage;\n Tracker.OnGetEvent := GetProgress;\n Tracker.OnGetMaxEvent := GetMaxProgress;\nend;\n\nprocedure TProgressForm.FormShow(Sender: TObject);\nbegin\n if (fsModal in FormState) then begin\n CancelButton.Caption := 'Close';\n if not bDetailsVisible then\n ToggleDetails(nil);\n end\n else if not bDetailsVisible then begin\n bDetailsVisible := false;\n DetailsMemo.Visible := false;\n DetailsButton.Caption := 'Show details';\n lastHeight := self.Height;\n self.Height := 129;\n end;\nend;\n\nprocedure TProgressForm.SetProgress(const i: Integer);\nbegin\n ProgressBar.Position := i;\n SetTaskbarProgressValue(ProgressBar.Position, ProgressBar.Max);\nend;\n\nprocedure TProgressForm.SetMaxProgress(const i: Integer);\nbegin\n ProgressBar.Max := i;\nend;\n\nfunction TProgressForm.GetProgress: Integer;\nbegin\n Result := ProgressBar.Position;\nend;\n\nfunction TProgressForm.GetMaxProgress: Integer;\nbegin\n Result := ProgressBar.Max;\nend;\n\nprocedure TProgressForm.UpdateProgress(const i: Integer);\nbegin\n ProgressBar.StepBy(i);\n SetTaskbarProgressValue(ProgressBar.Position, ProgressBar.Max);\nend;\n\nprocedure TProgressForm.SaveLog;\nvar\n fdt: string;\nbegin\n try\n ForceDirectories(pfLogPath);\n fdt := FormatDateTime('mmddyy_hhnnss', TDateTime(Now));\n DetailsMemo.Lines.SaveToFile(pfLogPath + 'log_'+fdt+'.txt');\n except on Exception do\n // nothing to do\n end;\nend;\n\nprocedure TProgressForm.StatusMessage(const s: string);\nbegin\n ProgressLabel.Caption := s;\nend;\n\nprocedure TProgressForm.Write(const s: string);\nbegin\n if Pos(' ', s) <> 1 then\n ProgressLabel.Caption := s;\n DetailsMemo.SelLength := 0;\n DetailsMemo.Lines.Add(s);\nend;\n\nend.\n"
},
{
"path": "lib/mte/mteTaskHandler.pas",
"content": "unit mteTaskHandler;\n\ninterface\n\nuses\n Classes, SysUtils,\n // mte components\n mteLogger, mteHelpers;\n\ntype\n TProcedure = procedure of object;\n TTask = class (TObject)\n private\n FExecute : TProcedure;\n public\n name: string;\n rate: real;\n lastExecuted: TDateTime;\n constructor Create(name: string; rate: real; FExecute: TProcedure); Overload;\n property OnExecute: TProcedure read FExecute write FExecute;\n procedure Execute;\n end;\n TTaskHandler = class(TObject)\n public\n TaskList: TList;\n bExecutingTasks: boolean;\n procedure RemoveTask(taskName: string);\n procedure AddTask(task: TTask);\n procedure ExecTasks;\n constructor Create; Overload;\n end;\n\nvar\n bLogTasks: boolean;\n\nimplementation\n\nprocedure TTaskHandler.AddTask(task: TTask);\nbegin\n TaskList.Add(task);\nend;\n\nprocedure TTaskHandler.RemoveTask(taskName: string);\nvar\n i: Integer;\n task: TTask;\nbegin\n if not Assigned(TaskList) then\n exit;\n\n for i := Pred(TaskList.Count) downto 0 do begin\n task := TTask(TaskList[i]);\n if task.name = taskName then begin\n TaskList.Delete(i);\n break;\n end;\n end;\nend;\n\nprocedure TTaskHandler.ExecTasks;\nvar\n i: Integer;\n task: TTask;\nbegin\n // exit if we're currently executing tasks\n if bExecutingTasks then\n exit;\n bExecutingTasks := true;\n\n // loop through task list, executing tasks that are ready to be executed\n for i := Pred(TaskList.Count) downto 0 do begin\n task := TTask(TaskList[i]);\n if (Now - task.lastExecuted >= task.rate) then begin\n if bLogTasks and (task.rate > 60.0 * seconds) then\n Logger.Write('TASK', 'Execute', task.name);\n task.lastExecuted := Now;\n task.Execute;\n end;\n end;\n\n // no longer executing tasks\n bExecutingTasks := false;\nend;\n\nconstructor TTaskHandler.Create;\nbegin\n TaskList := TList.Create;\nend;\n\n\n{******************************************************************************}\n{ Task methods\n Object methods for TTask\n}\n{******************************************************************************}\n\nconstructor TTask.Create(name: string; rate: real; FExecute: TProcedure);\nbegin\n if bLogTasks then\n Logger.Write('TASK', 'Init', Format('%s, Rate: %s', [name, RateStr(rate)]));\n self.name := name;\n self.rate := rate;\n self.FExecute := FExecute;\n self.lastExecuted := Now;\nend;\n\nprocedure TTask.Execute;\nbegin\n if Assigned(FExecute) then\n FExecute;\nend;\n\nend.\n\n"
},
{
"path": "lib/mte/mteTracker.pas",
"content": "unit mteTracker;\n\ninterface\n\nuses Classes, SysUtils;\n\ntype\n TUpdateEvent = procedure(const i: integer) of object;\n TReadEvent = function: Integer of object;\n TLogEvent = procedure(const s: string) of object;\n\n TProgressTracker = class\n private\n FUpdateEvent : TUpdateEvent;\n FSetEvent : TUpdateEvent;\n FGetEvent : TReadEvent;\n FMaxEvent : TUpdateEvent;\n FGetMaxEvent : TReadEvent;\n FLogEvent : TLogEvent;\n FStatusEvent : TLogEvent;\n public\n Cancel: boolean;\n procedure SetMaxProgress(const i: integer);\n property OnSetMaxEvent: TUpdateEvent read FMaxEvent write FMaxEvent;\n procedure SetProgress(const i: integer);\n property OnSetEvent: TUpdateEvent read FSetEvent write FSetEvent;\n function GetProgress: Integer;\n property OnGetEvent: TReadEvent read FGetEvent write FGetEvent;\n function GetMaxProgress: Integer;\n property OnGetMaxEvent: TReadEvent read FGetMaxEvent write FGetMaxEvent;\n procedure UpdateProgress(const i: integer);\n property OnUpdateEvent: TUpdateEvent read FUpdateEvent write FUpdateEvent;\n procedure StatusMessage(const s: string);\n property OnStatusEvent: TLogEvent read FStatusEvent write FStatusEvent;\n procedure Write(const s: string);\n property OnLogEvent: TLogEvent read FLogEvent write FLogEvent;\n end;\n\nvar\n Tracker: TProgressTracker;\n\nimplementation\n\n\nprocedure TProgressTracker.SetMaxProgress(const i: Integer);\nbegin\n if Assigned(FMaxEvent) then\n FMaxEvent(i);\nend;\n\nprocedure TProgressTracker.StatusMessage(const s: string);\nbegin\n if Assigned(FStatusEvent) then\n FStatusEvent(s);\nend;\n\nprocedure TProgressTracker.SetProgress(const i: integer);\nbegin\n if Assigned(FSetEvent) then\n FSetEvent(i);\nend;\n\nfunction TProgressTracker.GetProgress: Integer;\nbegin\n Result := FGetEvent();\nend;\n\nfunction TProgressTracker.GetMaxProgress: Integer;\nbegin\n Result := FGetMaxEvent();\nend;\n\nprocedure TProgressTracker.UpdateProgress(const i: integer);\nbegin\n if Assigned(FUpdateEvent) then\n FUpdateEvent(i);\nend;\n\nprocedure TProgressTracker.Write(const s: string);\nbegin\n if s = '' then\n exit;\n if Assigned(FLogEvent) then\n FLogEvent(s);\nend;\n\ninitialization\n Tracker := TProgressTracker.Create;\n\nfinalization\n FreeAndNil(Tracker);\n\nend.\n"
},
{
"path": "lib/superobject/superobject.pas",
"content": "(*\n * Super Object Toolkit\n *\n * Usage allowed under the restrictions of the Lesser GNU General Public License\n * or alternatively the restrictions of the Mozilla Public License 1.1\n *\n * Software distributed under the License is distributed on an \"AS IS\" basis,\n * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for\n * the specific language governing rights and limitations under the License.\n *\n * Unit owner : Henri Gourvest \n * Web site : http://www.progdigy.com\n *\n * This unit is inspired from the json c lib:\n * Michael Clark \n * http://oss.metaparadigm.com/json-c/\n *\n * CHANGES:\n * v1.2\n * + support of currency data type\n * + right trim unquoted string\n * + read Unicode Files and streams (Litle Endian with BOM)\n * + Fix bug on javadate functions + windows nt compatibility\n * + Now you can force to parse only the canonical syntax of JSON using the stric parameter\n * + Delphi 2010 RTTI marshalling\n * v1.1\n * + Double licence MPL or LGPL.\n * + Delphi 2009 compatibility & Unicode support.\n * + AsString return a string instead of PChar.\n * + Escaped and Unascaped JSON serialiser.\n * + Missed FormFeed added \\f\n * - Removed @ trick, uses forcepath() method instead.\n * + Fixed parse error with uppercase E symbol in numbers.\n * + Fixed possible buffer overflow when enlarging array.\n * + Added \"delete\", \"pack\", \"insert\" methods for arrays and/or objects\n * + Multi parametters when calling methods\n * + Delphi Enumerator (for obj1 in obj2 do ...)\n * + Format method ex: obj.format('<%name%>%tab[1]%')\n * + ParseFile and ParseStream methods\n * + Parser now understand hexdecimal c syntax ex: \\xFF\n * + Null Object Design Patern (ex: for obj in values.N['path'] do ...)\n * v1.0\n * + renamed class\n * + interfaced object\n * + added a new data type: the method\n * + parser can now evaluate properties and call methods\n * - removed obselet rpc class\n * - removed \"find\" method, now you can use \"parse\" method instead\n * v0.6\n * + refactoring\n * v0.5\n * + new find method to get or set value using a path syntax\n * ex: obj.s['obj.prop[1]'] := 'string value';\n * obj.a['@obj.array'].b[n] := true; // @ -> create property if necessary\n * v0.4\n * + bug corrected: AVL tree badly balanced.\n * v0.3\n * + New validator partially based on the Kwalify syntax.\n * + extended syntax to parse unquoted fields.\n * + Freepascal compatibility win32/64 Linux32/64.\n * + JavaToDelphiDateTime and DelphiToJavaDateTime improved for UTC.\n * + new TJsonObject.Compare function.\n * v0.2\n * + Hashed string list replaced with a faster AVL tree\n * + JsonInt data type can be changed to int64\n * + JavaToDelphiDateTime and DelphiToJavaDateTime helper fonctions\n * + from json-c v0.7\n * + Add escaping of backslash to json output\n * + Add escaping of foward slash on tokenizing and output\n * + Changes to internal tokenizer from using recursion to\n * using a depth state structure to allow incremental parsing\n * v0.1\n * + first release\n *)\n\n{$IFDEF FPC}\n {$MODE OBJFPC}{$H+}\n{$ENDIF}\n\n{$DEFINE SUPER_METHOD}\n{$DEFINE WINDOWSNT_COMPATIBILITY}\n{.$DEFINE DEBUG} // track memory leack\n\nunit superobject;\n\ninterface\nuses\n Classes\n{$IFDEF VER210}\n ,Generics.Collections, RTTI, TypInfo\n{$ENDIF}\n ;\n\ntype\n{$IFNDEF FPC}\n PtrInt = longint;\n PtrUInt = Longword;\n{$ENDIF}\n SuperInt = Int64;\n\n{$if (sizeof(Char) = 1)}\n SOChar = WideChar;\n SOIChar = Word;\n PSOChar = PWideChar;\n SOString = WideString;\n{$else}\n SOChar = Char;\n SOIChar = Word;\n PSOChar = PChar;\n SOString = string;\n{$ifend}\n\nconst\n SUPER_ARRAY_LIST_DEFAULT_SIZE = 32;\n SUPER_TOKENER_MAX_DEPTH = 64;\n\n SUPER_AVL_MAX_DEPTH = sizeof(longint) * 8;\n SUPER_AVL_MASK_HIGH_BIT = not ((not longword(0)) shr 1);\n\ntype\n // forward declarations\n TSuperObject = class;\n ISuperObject = interface;\n TSuperArray = class;\n\n(* AVL Tree\n * This is a \"special\" autobalanced AVL tree\n * It use a hash value for fast compare\n *)\n\n{$IFDEF SUPER_METHOD}\n TSuperMethod = procedure(const This, Params: ISuperObject; var Result: ISuperObject);\n{$ENDIF}\n\n\n TSuperAvlBitArray = set of 0..SUPER_AVL_MAX_DEPTH - 1;\n\n TSuperAvlSearchType = (stEQual, stLess, stGreater);\n TSuperAvlSearchTypes = set of TSuperAvlSearchType;\n TSuperAvlIterator = class;\n\n TSuperAvlEntry = class\n private\n FGt, FLt: TSuperAvlEntry;\n FBf: integer;\n FHash: Cardinal;\n FName: SOString;\n FPtr: Pointer;\n function GetValue: ISuperObject;\n procedure SetValue(const val: ISuperObject);\n public\n class function Hash(const k: SOString): Cardinal; virtual;\n constructor Create(const AName: SOString; Obj: Pointer); virtual;\n property Name: SOString read FName;\n property Ptr: Pointer read FPtr;\n property Value: ISuperObject read GetValue write SetValue;\n end;\n\n TSuperAvlTree = class\n private\n FRoot: TSuperAvlEntry;\n FCount: Integer;\n function balance(bal: TSuperAvlEntry): TSuperAvlEntry;\n protected\n procedure doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); virtual;\n function CompareNodeNode(node1, node2: TSuperAvlEntry): integer; virtual;\n function CompareKeyNode(const k: SOString; h: TSuperAvlEntry): integer; virtual;\n function Insert(h: TSuperAvlEntry): TSuperAvlEntry; virtual;\n function Search(const k: SOString; st: TSuperAvlSearchTypes = [stEqual]): TSuperAvlEntry; virtual;\n public\n constructor Create; virtual;\n destructor Destroy; override;\n function IsEmpty: boolean;\n procedure Clear(all: boolean = false); virtual;\n procedure Pack(all: boolean);\n function Delete(const k: SOString): ISuperObject;\n function GetEnumerator: TSuperAvlIterator;\n property count: Integer read FCount;\n end;\n\n TSuperTableString = class(TSuperAvlTree)\n protected\n procedure doDeleteEntry(Entry: TSuperAvlEntry; all: boolean); override;\n procedure PutO(const k: SOString; const value: ISuperObject);\n function GetO(const k: SOString): ISuperObject;\n procedure PutS(const k: SOString; const value: SOString);\n function GetS(const k: SOString): SOString;\n procedure PutI(const k: SOString; value: SuperInt);\n function GetI(const k: SOString): SuperInt;\n procedure PutD(const k: SOString; value: Double);\n function GetD(const k: SOString): Double;\n procedure PutB(const k: SOString; value: Boolean);\n function GetB(const k: SOString): Boolean;\n{$IFDEF SUPER_METHOD}\n procedure PutM(const k: SOString; value: TSuperMethod);\n function GetM(const k: SOString): TSuperMethod;\n{$ENDIF}\n procedure PutN(const k: SOString; const value: ISuperObject);\n function GetN(const k: SOString): ISuperObject;\n procedure PutC(const k: SOString; value: Currency);\n function GetC(const k: SOString): Currency;\n public\n property O[const k: SOString]: ISuperObject read GetO write PutO; default;\n property S[const k: SOString]: SOString read GetS write PutS;\n property I[const k: SOString]: SuperInt read GetI write PutI;\n property D[const k: SOString]: Double read GetD write PutD;\n property B[const k: SOString]: Boolean read GetB write PutB;\n{$IFDEF SUPER_METHOD}\n property M[const k: SOString]: TSuperMethod read GetM write PutM;\n{$ENDIF}\n property N[const k: SOString]: ISuperObject read GetN write PutN;\n property C[const k: SOString]: Currency read GetC write PutC;\n\n function GetValues: ISuperObject;\n function GetNames: ISuperObject;\n end;\n\n TSuperAvlIterator = class\n private\n FTree: TSuperAvlTree;\n FBranch: TSuperAvlBitArray;\n FDepth: LongInt;\n FPath: array[0..SUPER_AVL_MAX_DEPTH - 2] of TSuperAvlEntry;\n public\n constructor Create(tree: TSuperAvlTree); virtual;\n procedure Search(const k: SOString; st: TSuperAvlSearchTypes = [stEQual]);\n procedure First;\n procedure Last;\n function GetIter: TSuperAvlEntry;\n procedure Next;\n procedure Prior;\n // delphi enumerator\n function MoveNext: Boolean;\n property Current: TSuperAvlEntry read GetIter;\n end;\n\n TSuperObjectArray = array[0..(high(PtrInt) div sizeof(TSuperObject))-1] of ISuperObject;\n PSuperObjectArray = ^TSuperObjectArray;\n\n TSuperArray = class\n private\n FArray: PSuperObjectArray;\n FLength: Integer;\n FSize: Integer;\n procedure Expand(max: Integer);\n protected\n function GetO(const index: integer): ISuperObject;\n procedure PutO(const index: integer; const Value: ISuperObject);\n function GetB(const index: integer): Boolean;\n procedure PutB(const index: integer; Value: Boolean);\n function GetI(const index: integer): SuperInt;\n procedure PutI(const index: integer; Value: SuperInt);\n function GetD(const index: integer): Double;\n procedure PutD(const index: integer; Value: Double);\n function GetC(const index: integer): Currency;\n procedure PutC(const index: integer; Value: Currency);\n function GetS(const index: integer): SOString;\n procedure PutS(const index: integer; const Value: SOString);\n{$IFDEF SUPER_METHOD}\n function GetM(const index: integer): TSuperMethod;\n procedure PutM(const index: integer; Value: TSuperMethod);\n{$ENDIF}\n function GetN(const index: integer): ISuperObject;\n procedure PutN(const index: integer; const Value: ISuperObject);\n public\n constructor Create; virtual;\n destructor Destroy; override;\n function Add(const Data: ISuperObject): Integer;\n function Delete(index: Integer): ISuperObject;\n procedure Insert(index: Integer; const value: ISuperObject);\n procedure Clear(all: boolean = false);\n procedure Pack(all: boolean);\n property Length: Integer read FLength;\n\n property N[const index: integer]: ISuperObject read GetN write PutN;\n property O[const index: integer]: ISuperObject read GetO write PutO; default;\n property B[const index: integer]: boolean read GetB write PutB;\n property I[const index: integer]: SuperInt read GetI write PutI;\n property D[const index: integer]: Double read GetD write PutD;\n property C[const index: integer]: Currency read GetC write PutC;\n property S[const index: integer]: SOString read GetS write PutS;\n{$IFDEF SUPER_METHOD}\n property M[const index: integer]: TSuperMethod read GetM write PutM;\n{$ENDIF}\n// property A[const index: integer]: TSuperArray read GetA;\n end;\n\n TSuperWriter = class\n public\n // abstact methods to overide\n function Append(buf: PSOChar; Size: Integer): Integer; overload; virtual; abstract;\n function Append(buf: PSOChar): Integer; overload; virtual; abstract;\n procedure Reset; virtual; abstract;\n end;\n\n TSuperWriterString = class(TSuperWriter)\n private\n FBuf: PSOChar;\n FBPos: integer;\n FSize: integer;\n public\n function Append(buf: PSOChar; Size: Integer): Integer; overload; override;\n function Append(buf: PSOChar): Integer; overload; override;\n procedure Reset; override;\n procedure TrimRight;\n constructor Create; virtual;\n destructor Destroy; override;\n function GetString: SOString;\n property Data: PSOChar read FBuf;\n property Size: Integer read FSize;\n property Position: integer read FBPos;\n end;\n\n TSuperWriterStream = class(TSuperWriter)\n private\n FStream: TStream;\n public\n function Append(buf: PSOChar): Integer; override;\n procedure Reset; override;\n constructor Create(AStream: TStream); reintroduce; virtual;\n end;\n\n TSuperAnsiWriterStream = class(TSuperWriterStream)\n public\n function Append(buf: PSOChar; Size: Integer): Integer; override;\n end;\n\n TSuperUnicodeWriterStream = class(TSuperWriterStream)\n public\n function Append(buf: PSOChar; Size: Integer): Integer; override;\n end;\n\n TSuperWriterFake = class(TSuperWriter)\n private\n FSize: Integer;\n public\n function Append(buf: PSOChar; Size: Integer): Integer; override;\n function Append(buf: PSOChar): Integer; override;\n procedure Reset; override;\n constructor Create; reintroduce; virtual;\n property size: integer read FSize;\n end;\n\n TSuperWriterSock = class(TSuperWriter)\n private\n FSocket: longint;\n FSize: Integer;\n public\n function Append(buf: PSOChar; Size: Integer): Integer; override;\n function Append(buf: PSOChar): Integer; override;\n procedure Reset; override;\n constructor Create(ASocket: longint); reintroduce; virtual;\n property Socket: longint read FSocket;\n property Size: Integer read FSize;\n end;\n\n TSuperTokenizerError = (\n teSuccess,\n teContinue,\n teDepth,\n teParseEof,\n teParseUnexpected,\n teParseNull,\n teParseBoolean,\n teParseNumber,\n teParseArray,\n teParseObjectKeyName,\n teParseObjectKeySep,\n teParseObjectValueSep,\n teParseString,\n teParseComment,\n teEvalObject,\n teEvalArray,\n teEvalMethod,\n teEvalInt\n );\n\n TSuperTokenerState = (\n tsEatws,\n tsStart,\n tsFinish,\n tsNull,\n tsCommentStart,\n tsComment,\n tsCommentEol,\n tsCommentEnd,\n tsString,\n tsStringEscape,\n tsIdentifier,\n tsEscapeUnicode,\n tsEscapeHexadecimal,\n tsBoolean,\n tsNumber,\n tsArray,\n tsArrayAdd,\n tsArraySep,\n tsObjectFieldStart,\n tsObjectField,\n tsObjectUnquotedField,\n tsObjectFieldEnd,\n tsObjectValue,\n tsObjectValueAdd,\n tsObjectSep,\n tsEvalProperty,\n tsEvalArray,\n tsEvalMethod,\n tsParamValue,\n tsParamPut,\n tsMethodValue,\n tsMethodPut\n );\n\n PSuperTokenerSrec = ^TSuperTokenerSrec;\n TSuperTokenerSrec = record\n state, saved_state: TSuperTokenerState;\n obj: ISuperObject;\n current: ISuperObject;\n field_name: SOString;\n parent: ISuperObject;\n gparent: ISuperObject;\n end;\n\n TSuperTokenizer = class\n public\n str: PSOChar;\n pb: TSuperWriterString;\n depth, is_double, floatcount, st_pos, char_offset: Integer;\n err: TSuperTokenizerError;\n ucs_char: Word;\n quote_char: SOChar;\n stack: array[0..SUPER_TOKENER_MAX_DEPTH-1] of TSuperTokenerSrec;\n line, col: Integer;\n public\n constructor Create; virtual;\n destructor Destroy; override;\n procedure ResetLevel(adepth: integer);\n procedure Reset;\n end;\n\n // supported object types\n TSuperType = (\n stNull,\n stBoolean,\n stDouble,\n stCurrency,\n stInt,\n stObject,\n stArray,\n stString\n{$IFDEF SUPER_METHOD}\n ,stMethod\n{$ENDIF}\n );\n\n TSuperValidateError = (\n veRuleMalformated,\n veFieldIsRequired,\n veInvalidDataType,\n veFieldNotFound,\n veUnexpectedField,\n veDuplicateEntry,\n veValueNotInEnum,\n veInvalidLength,\n veInvalidRange\n );\n\n TSuperFindOption = (\n foCreatePath,\n foPutValue,\n foDelete\n{$IFDEF SUPER_METHOD}\n ,foCallMethod\n{$ENDIF}\n );\n\n TSuperFindOptions = set of TSuperFindOption;\n TSuperCompareResult = (cpLess, cpEqu, cpGreat, cpError);\n TSuperOnValidateError = procedure(sender: Pointer; error: TSuperValidateError; const objpath: SOString);\n\n TSuperEnumerator = class\n private\n FObj: ISuperObject;\n FObjEnum: TSuperAvlIterator;\n FCount: Integer;\n public\n constructor Create(const obj: ISuperObject); virtual;\n destructor Destroy; override;\n function MoveNext: Boolean;\n function GetCurrent: ISuperObject;\n property Current: ISuperObject read GetCurrent;\n end;\n\n ISuperObject = interface\n ['{4B86A9E3-E094-4E5A-954A-69048B7B6327}']\n function GetEnumerator: TSuperEnumerator;\n function GetDataType: TSuperType;\n function GetProcessing: boolean;\n procedure SetProcessing(value: boolean);\n function ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject;\n function Format(const str: SOString; BeginSep: SOChar = '%'; EndSep: SOChar = '%'): SOString;\n\n function GetO(const path: SOString): ISuperObject;\n procedure PutO(const path: SOString; const Value: ISuperObject);\n function GetB(const path: SOString): Boolean;\n procedure PutB(const path: SOString; Value: Boolean);\n function GetI(const path: SOString): SuperInt;\n procedure PutI(const path: SOString; Value: SuperInt);\n function GetD(const path: SOString): Double;\n procedure PutC(const path: SOString; Value: Currency);\n function GetC(const path: SOString): Currency;\n procedure PutD(const path: SOString; Value: Double);\n function GetS(const path: SOString): SOString;\n procedure PutS(const path: SOString; const Value: SOString);\n{$IFDEF SUPER_METHOD}\n function GetM(const path: SOString): TSuperMethod;\n procedure PutM(const path: SOString; Value: TSuperMethod);\n{$ENDIF}\n function GetA(const path: SOString): TSuperArray;\n\n // Null Object Design patern\n function GetN(const path: SOString): ISuperObject;\n procedure PutN(const path: SOString; const Value: ISuperObject);\n\n // Writers\n function Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer;\n function SaveTo(stream: TStream; indent: boolean = false; escape: boolean = true): integer; overload;\n function SaveTo(const FileName: string; indent: boolean = false; escape: boolean = true): integer; overload;\n function SaveTo(socket: longint; indent: boolean = false; escape: boolean = true): integer; overload;\n function CalcSize(indent: boolean = false; escape: boolean = true): integer;\n\n // convert\n function AsBoolean: Boolean;\n function AsInteger: SuperInt;\n function AsDouble: Double;\n function AsCurrency: Currency;\n function AsString: SOString;\n function AsArray: TSuperArray;\n function AsObject: TSuperTableString;\n{$IFDEF SUPER_METHOD}\n function AsMethod: TSuperMethod;\n{$ENDIF}\n function AsJSon(indent: boolean = false; escape: boolean = true): SOString;\n\n procedure Clear(all: boolean = false);\n procedure Pack(all: boolean = false);\n\n property N[const path: SOString]: ISuperObject read GetN write PutN;\n property O[const path: SOString]: ISuperObject read GetO write PutO; default;\n property B[const path: SOString]: boolean read GetB write PutB;\n property I[const path: SOString]: SuperInt read GetI write PutI;\n property D[const path: SOString]: Double read GetD write PutD;\n property C[const path: SOString]: Currency read GetC write PutC;\n property S[const path: SOString]: SOString read GetS write PutS;\n{$IFDEF SUPER_METHOD}\n property M[const path: SOString]: TSuperMethod read GetM write PutM;\n{$ENDIF}\n property A[const path: SOString]: TSuperArray read GetA;\n\n{$IFDEF SUPER_METHOD}\n function call(const path: SOString; const param: ISuperObject = nil): ISuperObject; overload;\n function call(const path, param: SOString): ISuperObject; overload;\n{$ENDIF}\n // clone a node\n function Clone: ISuperObject;\n function Delete(const path: SOString): ISuperObject;\n // merges tow objects of same type, if reference is true then nodes are not cloned\n procedure Merge(const obj: ISuperObject; reference: boolean = false); overload;\n procedure Merge(const str: SOString); overload;\n\n // validate methods\n function Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;\n function Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;\n\n // compare\n function Compare(const obj: ISuperObject): TSuperCompareResult; overload;\n function Compare(const str: SOString): TSuperCompareResult; overload;\n\n // the data type\n function IsType(AType: TSuperType): boolean;\n property DataType: TSuperType read GetDataType;\n property Processing: boolean read GetProcessing write SetProcessing;\n\n function GetDataPtr: Pointer;\n procedure SetDataPtr(const Value: Pointer);\n property DataPtr: Pointer read GetDataPtr write SetDataPtr;\n end;\n\n TSuperObject = class(TObject, ISuperObject)\n private\n FRefCount: Integer;\n FProcessing: boolean;\n FDataType: TSuperType;\n FDataPtr: Pointer;\n{.$if true}\n FO: record\n case TSuperType of\n stBoolean: (c_boolean: boolean);\n stDouble: (c_double: double);\n stCurrency: (c_currency: Currency);\n stInt: (c_int: SuperInt);\n stObject: (c_object: TSuperTableString);\n stArray: (c_array: TSuperArray);\n{$IFDEF SUPER_METHOD}\n stMethod: (c_method: TSuperMethod);\n{$ENDIF}\n end;\n{.$ifend}\n FOString: SOString;\n function GetDataType: TSuperType;\n function GetDataPtr: Pointer;\n procedure SetDataPtr(const Value: Pointer);\n protected\n function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;\n function _AddRef: Integer; virtual; stdcall;\n function _Release: Integer; virtual; stdcall;\n\n function GetO(const path: SOString): ISuperObject;\n procedure PutO(const path: SOString; const Value: ISuperObject);\n function GetB(const path: SOString): Boolean;\n procedure PutB(const path: SOString; Value: Boolean);\n function GetI(const path: SOString): SuperInt;\n procedure PutI(const path: SOString; Value: SuperInt);\n function GetD(const path: SOString): Double;\n procedure PutD(const path: SOString; Value: Double);\n procedure PutC(const path: SOString; Value: Currency);\n function GetC(const path: SOString): Currency;\n function GetS(const path: SOString): SOString;\n procedure PutS(const path: SOString; const Value: SOString);\n{$IFDEF SUPER_METHOD}\n function GetM(const path: SOString): TSuperMethod;\n procedure PutM(const path: SOString; Value: TSuperMethod);\n{$ENDIF}\n function GetA(const path: SOString): TSuperArray;\n function Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer; virtual;\n public\n function GetEnumerator: TSuperEnumerator;\n procedure AfterConstruction; override;\n procedure BeforeDestruction; override;\n class function NewInstance: TObject; override;\n property RefCount: Integer read FRefCount;\n\n function GetProcessing: boolean;\n procedure SetProcessing(value: boolean);\n\n // Writers\n function SaveTo(stream: TStream; indent: boolean = false; escape: boolean = true): integer; overload;\n function SaveTo(const FileName: string; indent: boolean = false; escape: boolean = true): integer; overload;\n function SaveTo(socket: longint; indent: boolean = false; escape: boolean = true): integer; overload;\n function CalcSize(indent: boolean = false; escape: boolean = true): integer;\n function AsJSon(indent: boolean = false; escape: boolean = true): SOString;\n\n // parser ... owned!\n class function ParseString(s: PSOChar; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = [];\n const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;\n class function ParseStream(stream: TStream; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = [];\n const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;\n class function ParseFile(const FileName: string; strict: Boolean; partial: boolean = true; const this: ISuperObject = nil; options: TSuperFindOptions = [];\n const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;\n class function ParseEx(tok: TSuperTokenizer; str: PSOChar; len: integer; strict: Boolean; const this: ISuperObject = nil;\n options: TSuperFindOptions = []; const put: ISuperObject = nil; dt: TSuperType = stNull): ISuperObject;\n\n // constructors / destructor\n constructor Create(jt: TSuperType = stObject); overload; virtual;\n constructor Create(b: boolean); overload; virtual;\n constructor Create(i: SuperInt); overload; virtual;\n constructor Create(d: double); overload; virtual;\n constructor CreateCurrency(c: Currency); overload; virtual;\n constructor Create(const s: SOString); overload; virtual;\n{$IFDEF SUPER_METHOD}\n constructor Create(m: TSuperMethod); overload; virtual;\n{$ENDIF}\n destructor Destroy; override;\n\n // convert\n function AsBoolean: Boolean; virtual;\n function AsInteger: SuperInt; virtual;\n function AsDouble: Double; virtual;\n function AsCurrency: Currency; virtual;\n function AsString: SOString; virtual;\n function AsArray: TSuperArray; virtual;\n function AsObject: TSuperTableString; virtual;\n{$IFDEF SUPER_METHOD}\n function AsMethod: TSuperMethod; virtual;\n{$ENDIF}\n procedure Clear(all: boolean = false); virtual;\n procedure Pack(all: boolean = false); virtual;\n function GetN(const path: SOString): ISuperObject;\n procedure PutN(const path: SOString; const Value: ISuperObject);\n function ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject;\n function Format(const str: SOString; BeginSep: SOChar = '%'; EndSep: SOChar = '%'): SOString;\n\n property N[const path: SOString]: ISuperObject read GetN write PutN;\n property O[const path: SOString]: ISuperObject read GetO write PutO; default;\n property B[const path: SOString]: boolean read GetB write PutB;\n property I[const path: SOString]: SuperInt read GetI write PutI;\n property D[const path: SOString]: Double read GetD write PutD;\n property C[const path: SOString]: Currency read GetC write PutC;\n property S[const path: SOString]: SOString read GetS write PutS;\n{$IFDEF SUPER_METHOD}\n property M[const path: SOString]: TSuperMethod read GetM write PutM;\n{$ENDIF}\n property A[const path: SOString]: TSuperArray read GetA;\n\n{$IFDEF SUPER_METHOD}\n function call(const path: SOString; const param: ISuperObject = nil): ISuperObject; overload; virtual;\n function call(const path, param: SOString): ISuperObject; overload; virtual;\n{$ENDIF}\n // clone a node\n function Clone: ISuperObject; virtual;\n function Delete(const path: SOString): ISuperObject;\n // merges tow objects of same type, if reference is true then nodes are not cloned\n procedure Merge(const obj: ISuperObject; reference: boolean = false); overload;\n procedure Merge(const str: SOString); overload;\n\n // validate methods\n function Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;\n function Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean; overload;\n\n // compare\n function Compare(const obj: ISuperObject): TSuperCompareResult; overload;\n function Compare(const str: SOString): TSuperCompareResult; overload;\n\n // the data type\n function IsType(AType: TSuperType): boolean;\n property DataType: TSuperType read GetDataType;\n // a data pointer to link to something ele, a treeview for example\n property DataPtr: Pointer read GetDataPtr write SetDataPtr;\n property Processing: boolean read GetProcessing;\n end;\n\n{$IFDEF VER210}\n TSuperRttiContext = class;\n\n TSerialFromJson = function(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;\n TSerialToJson = function(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;\n\n TSuperAttribute = class(TCustomAttribute)\n private\n FName: string;\n public\n constructor Create(const AName: string);\n property Name: string read FName;\n end;\n\n SOName = class(TSuperAttribute);\n SODefault = class(TSuperAttribute);\n\n\n TSuperRttiContext = class\n private\n class function GetFieldName(r: TRttiField): string;\n class function GetFieldDefault(r: TRttiField; const obj: ISuperObject): ISuperObject;\n public\n Context: TRttiContext;\n SerialFromJson: TDictionary;\n SerialToJson: TDictionary;\n constructor Create; virtual;\n destructor Destroy; override;\n function FromJson(TypeInfo: PTypeInfo; const obj: ISuperObject; var Value: TValue): Boolean; virtual;\n function ToJson(var value: TValue; const index: ISuperObject): ISuperObject; virtual;\n function AsType(const obj: ISuperObject): T;\n function AsJson(const obj: T; const index: ISuperObject = nil): ISuperObject;\n end;\n\n TSuperObjectHelper = class helper for TObject\n public\n function ToJson(ctx: TSuperRttiContext = nil): ISuperObject;\n constructor FromJson(const obj: ISuperObject; ctx: TSuperRttiContext = nil); overload;\n constructor FromJson(const str: string; ctx: TSuperRttiContext = nil); overload;\n end;\n{$ENDIF}\n\n TSuperObjectIter = record\n key: SOString;\n val: ISuperObject;\n Ite: TSuperAvlIterator;\n end;\n\nfunction ObjectIsError(obj: TSuperObject): boolean;\nfunction ObjectIsType(const obj: ISuperObject; typ: TSuperType): boolean;\nfunction ObjectGetType(const obj: ISuperObject): TSuperType;\n\nfunction ObjectFindFirst(const obj: ISuperObject; var F: TSuperObjectIter): boolean;\nfunction ObjectFindNext(var F: TSuperObjectIter): boolean;\nprocedure ObjectFindClose(var F: TSuperObjectIter);\n\nfunction SO(const s: SOString = '{}'): ISuperObject; overload;\nfunction SO(const value: Variant): ISuperObject; overload;\nfunction SO(const Args: array of const): ISuperObject; overload;\n\nfunction SA(const Args: array of const): ISuperObject; overload;\n\nfunction JavaToDelphiDateTime(const dt: int64): TDateTime;\nfunction DelphiToJavaDateTime(const dt: TDateTime): int64;\n\n{$IFDEF VER210}\n\ntype\n TSuperInvokeResult = (\n irSuccess,\n irMethothodError, // method don't exist\n irParamError, // invalid parametters\n irError // other error\n );\n\nfunction TrySOInvoke(var ctx: TSuperRttiContext; const obj: TValue; const method: string; const params: ISuperObject; var Return: ISuperObject): TSuperInvokeResult; overload;\nfunction SOInvoke(const obj: TValue; const method: string; const params: ISuperObject; ctx: TSuperRttiContext = nil): ISuperObject; overload;\nfunction SOInvoke(const obj: TValue; const method: string; const params: string; ctx: TSuperRttiContext = nil): ISuperObject; overload;\n{$ENDIF}\n\nimplementation\nuses sysutils,\n{$IFDEF UNIX}\n baseunix, unix, DateUtils\n{$ELSE}\n Windows\n{$ENDIF}\n{$IFDEF FPC}\n ,sockets\n{$ELSE}\n ,WinSock\n{$ENDIF};\n\n{$IFDEF DEBUG}\nvar\n debugcount: integer = 0;\n{$ENDIF}\n\nconst\n super_number_chars_set = ['0'..'9','.','+','-','e','E'];\n super_hex_chars: PSOChar = '0123456789abcdef';\n super_hex_chars_set = ['0'..'9','a'..'f','A'..'F'];\n\n ESC_BS: PSOChar = '\\b';\n ESC_LF: PSOChar = '\\n';\n ESC_CR: PSOChar = '\\r';\n ESC_TAB: PSOChar = '\\t';\n ESC_FF: PSOChar = '\\f';\n ESC_QUOT: PSOChar = '\\\"';\n ESC_SL: PSOChar = '\\\\';\n ESC_SR: PSOChar = '\\/';\n ESC_ZERO: PSOChar = '\\u0000';\n\n TOK_CRLF: PSOChar = #13#10;\n TOK_SP: PSOChar = #32;\n TOK_BS: PSOChar = #8;\n TOK_TAB: PSOChar = #9;\n TOK_LF: PSOChar = #10;\n TOK_FF: PSOChar = #12;\n TOK_CR: PSOChar = #13;\n// TOK_SL: PSOChar = '\\';\n// TOK_SR: PSOChar = '/';\n TOK_NULL: PSOChar = 'null';\n TOK_CBL: PSOChar = '{'; // curly bracket left\n TOK_CBR: PSOChar = '}'; // curly bracket right\n TOK_ARL: PSOChar = '[';\n TOK_ARR: PSOChar = ']';\n TOK_ARRAY: PSOChar = '[]';\n TOK_OBJ: PSOChar = '{}'; // empty object\n TOK_COM: PSOChar = ','; // Comma\n TOK_DQT: PSOChar = '\"'; // Double Quote\n TOK_TRUE: PSOChar = 'true';\n TOK_FALSE: PSOChar = 'false';\n\n{$if (sizeof(Char) = 1)}\nfunction StrLComp(const Str1, Str2: PSOChar; MaxLen: Cardinal): Integer;\nvar\n P1, P2: PWideChar;\n I: Cardinal;\n C1, C2: WideChar;\nbegin\n P1 := Str1;\n P2 := Str2;\n I := 0;\n while I < MaxLen do\n begin\n C1 := P1^;\n C2 := P2^;\n\n if (C1 <> C2) or (C1 = #0) then\n begin\n Result := Ord(C1) - Ord(C2);\n Exit;\n end;\n\n Inc(P1);\n Inc(P2);\n Inc(I);\n end;\n Result := 0;\nend;\n\nfunction StrComp(const Str1, Str2: PSOChar): Integer;\nvar\n P1, P2: PWideChar;\n C1, C2: WideChar;\nbegin\n P1 := Str1;\n P2 := Str2;\n while True do\n begin\n C1 := P1^;\n C2 := P2^;\n\n if (C1 <> C2) or (C1 = #0) then\n begin\n Result := Ord(C1) - Ord(C2);\n Exit;\n end;\n\n Inc(P1);\n Inc(P2);\n end;\nend;\n\nfunction StrLen(const Str: PSOChar): Cardinal;\nvar\n p: PSOChar;\nbegin\n Result := 0;\n if Str <> nil then\n begin\n p := Str;\n while p^ <> #0 do inc(p);\n Result := (p - Str);\n end;\nend;\n{$ifend}\n\nfunction CurrToStr(c: Currency): SOString;\nvar\n p: PSOChar;\n i, len: Integer;\nbegin\n Result := IntToStr(Abs(PInt64(@c)^));\n len := Length(Result);\n SetLength(Result, len+1);\n if c <> 0 then\n begin\n while len <= 4 do\n begin\n Result := '0' + Result;\n inc(len);\n end;\n\n p := PSOChar(Result);\n inc(p, len-1);\n i := 0;\n repeat\n if p^ <> '0' then\n begin\n len := len - i + 1;\n repeat\n p[1] := p^;\n dec(p);\n inc(i);\n until i > 3;\n Break;\n end;\n dec(p);\n inc(i);\n if i > 3 then\n begin\n len := len - i + 1;\n Break;\n end;\n until false;\n p[1] := '.';\n SetLength(Result, len);\n if c < 0 then\n Result := '-' + Result;\n end;\nend;\n\n{$IFDEF UNIX}\n {$linklib c}\n{$ENDIF}\nfunction gcvt(value: Double; ndigit: longint; buf: PAnsiChar): PAnsiChar; cdecl;\n external {$IFDEF MSWINDOWS} 'msvcrt.dll' name '_gcvt'{$ENDIF};\n\n{$IFDEF UNIX}\ntype\n ptm = ^tm;\n tm = record\n tm_sec: Integer;\t\t(* Seconds: 0-59 (K&R says 0-61?) *)\n tm_min: Integer;\t\t(* Minutes: 0-59 *)\n tm_hour: Integer;\t(* Hours since midnight: 0-23 *)\n tm_mday: Integer;\t(* Day of the month: 1-31 *)\n tm_mon: Integer;\t\t(* Months *since* january: 0-11 *)\n tm_year: Integer;\t(* Years since 1900 *)\n tm_wday: Integer;\t(* Days since Sunday (0-6) *)\n tm_yday: Integer;\t(* Days since Jan. 1: 0-365 *)\n tm_isdst: Integer;\t(* +1 Daylight Savings Time, 0 No DST, -1 don't know *)\n end;\n\nfunction mktime(p: ptm): LongInt; cdecl; external;\nfunction gmtime(const t: PLongint): ptm; cdecl; external;\nfunction localtime (const t: PLongint): ptm; cdecl; external;\n\nfunction DelphiToJavaDateTime(const dt: TDateTime): Int64;\nvar\n p: ptm;\n l, ms: Integer;\n v: Int64;\nbegin\n v := Round((dt - 25569) * 86400000);\n ms := v mod 1000;\n l := v div 1000;\n p := localtime(@l);\n Result := Int64(mktime(p)) * 1000 + ms;\nend;\n\nfunction JavaToDelphiDateTime(const dt: int64): TDateTime;\nvar\n p: ptm;\n l, ms: Integer;\nbegin\n l := dt div 1000;\n ms := dt mod 1000;\n p := gmtime(@l);\n Result := EncodeDateTime(p^.tm_year+1900, p^.tm_mon+1, p^.tm_mday, p^.tm_hour, p^.tm_min, p^.tm_sec, ms);\nend;\n{$ELSE}\n\n{$IFDEF WINDOWSNT_COMPATIBILITY}\nfunction DayLightCompareDate(const date: PSystemTime;\n const compareDate: PSystemTime): Integer;\nvar\n limit_day, dayinsecs, weekofmonth: Integer;\n First: Word;\nbegin\n if (date^.wMonth < compareDate^.wMonth) then\n begin\n Result := -1; (* We are in a month before the date limit. *)\n Exit;\n end;\n\n if (date^.wMonth > compareDate^.wMonth) then\n begin\n Result := 1; (* We are in a month after the date limit. *)\n Exit;\n end;\n\n (* if year is 0 then date is in day-of-week format, otherwise\n * it's absolute date.\n *)\n if (compareDate^.wYear = 0) then\n begin\n (* compareDate.wDay is interpreted as number of the week in the month\n * 5 means: the last week in the month *)\n weekofmonth := compareDate^.wDay;\n (* calculate the day of the first DayOfWeek in the month *)\n First := (6 + compareDate^.wDayOfWeek - date^.wDayOfWeek + date^.wDay) mod 7 + 1;\n limit_day := First + 7 * (weekofmonth - 1);\n (* check needed for the 5th weekday of the month *)\n if (limit_day > MonthDays[(date^.wMonth=2) and IsLeapYear(date^.wYear)][date^.wMonth - 1]) then\n dec(limit_day, 7);\n end\n else\n limit_day := compareDate^.wDay;\n\n (* convert to seconds *)\n limit_day := ((limit_day * 24 + compareDate^.wHour) * 60 + compareDate^.wMinute ) * 60;\n dayinsecs := ((date^.wDay * 24 + date^.wHour) * 60 + date^.wMinute ) * 60 + date^.wSecond;\n (* and compare *)\n\n if dayinsecs < limit_day then\n Result := -1 else\n if dayinsecs > limit_day then\n Result := 1 else\n Result := 0; (* date is equal to the date limit. *)\nend;\n\nfunction CompTimeZoneID(const pTZinfo: PTimeZoneInformation;\n lpFileTime: PFileTime; islocal: Boolean): LongWord;\nvar\n ret: Integer;\n beforeStandardDate, afterDaylightDate: Boolean;\n llTime: Int64;\n SysTime: TSystemTime;\n ftTemp: TFileTime;\nbegin\n llTime := 0;\n\n if (pTZinfo^.DaylightDate.wMonth <> 0) then\n begin\n (* if year is 0 then date is in day-of-week format, otherwise\n * it's absolute date.\n *)\n if ((pTZinfo^.StandardDate.wMonth = 0) or\n ((pTZinfo^.StandardDate.wYear = 0) and\n ((pTZinfo^.StandardDate.wDay < 1) or\n (pTZinfo^.StandardDate.wDay > 5) or\n (pTZinfo^.DaylightDate.wDay < 1) or\n (pTZinfo^.DaylightDate.wDay > 5)))) then\n begin\n SetLastError(ERROR_INVALID_PARAMETER);\n Result := TIME_ZONE_ID_INVALID;\n Exit;\n end;\n\n if (not islocal) then\n begin\n llTime := PInt64(lpFileTime)^;\n dec(llTime, Int64(pTZinfo^.Bias + pTZinfo^.DaylightBias) * 600000000);\n PInt64(@ftTemp)^ := llTime;\n lpFileTime := @ftTemp;\n end;\n\n FileTimeToSystemTime(lpFileTime^, SysTime);\n\n (* check for daylight savings *)\n ret := DayLightCompareDate(@SysTime, @pTZinfo^.StandardDate);\n if (ret = -2) then\n begin\n Result := TIME_ZONE_ID_INVALID;\n Exit;\n end;\n\n beforeStandardDate := ret < 0;\n\n if (not islocal) then\n begin\n dec(llTime, Int64(pTZinfo^.StandardBias - pTZinfo^.DaylightBias) * 600000000);\n PInt64(@ftTemp)^ := llTime;\n FileTimeToSystemTime(lpFileTime^, SysTime);\n end;\n\n ret := DayLightCompareDate(@SysTime, @pTZinfo^.DaylightDate);\n if (ret = -2) then\n begin\n Result := TIME_ZONE_ID_INVALID;\n Exit;\n end;\n\n afterDaylightDate := ret >= 0;\n\n Result := TIME_ZONE_ID_STANDARD;\n if( pTZinfo^.DaylightDate.wMonth < pTZinfo^.StandardDate.wMonth ) then\n begin\n (* Northern hemisphere *)\n if( beforeStandardDate and afterDaylightDate) then\n Result := TIME_ZONE_ID_DAYLIGHT;\n end else (* Down south *)\n if( beforeStandardDate or afterDaylightDate) then\n Result := TIME_ZONE_ID_DAYLIGHT;\n end else\n (* No transition date *)\n Result := TIME_ZONE_ID_UNKNOWN;\nend;\n\nfunction GetTimezoneBias(const pTZinfo: PTimeZoneInformation;\n lpFileTime: PFileTime; islocal: Boolean; pBias: PLongint): Boolean;\nvar\n bias: LongInt;\n tzid: LongWord;\nbegin\n bias := pTZinfo^.Bias;\n tzid := CompTimeZoneID(pTZinfo, lpFileTime, islocal);\n\n if( tzid = TIME_ZONE_ID_INVALID) then\n begin\n Result := False;\n Exit;\n end;\n if (tzid = TIME_ZONE_ID_DAYLIGHT) then\n inc(bias, pTZinfo^.DaylightBias)\n else if (tzid = TIME_ZONE_ID_STANDARD) then\n inc(bias, pTZinfo^.StandardBias);\n pBias^ := bias;\n Result := True;\nend;\n\nfunction SystemTimeToTzSpecificLocalTime(\n lpTimeZoneInformation: PTimeZoneInformation;\n lpUniversalTime, lpLocalTime: PSystemTime): BOOL;\nvar\n ft: TFileTime;\n lBias: LongInt;\n llTime: Int64;\n tzinfo: TTimeZoneInformation;\nbegin\n if (lpTimeZoneInformation <> nil) then\n tzinfo := lpTimeZoneInformation^ else\n if (GetTimeZoneInformation(tzinfo) = TIME_ZONE_ID_INVALID) then\n begin\n Result := False;\n Exit;\n end;\n\n if (not SystemTimeToFileTime(lpUniversalTime^, ft)) then\n begin\n Result := False;\n Exit;\n end;\n llTime := PInt64(@ft)^;\n if (not GetTimezoneBias(@tzinfo, @ft, False, @lBias)) then\n begin\n Result := False;\n Exit;\n end;\n (* convert minutes to 100-nanoseconds-ticks *)\n dec(llTime, Int64(lBias) * 600000000);\n PInt64(@ft)^ := llTime;\n Result := FileTimeToSystemTime(ft, lpLocalTime^);\nend;\n\nfunction TzSpecificLocalTimeToSystemTime(\n const lpTimeZoneInformation: PTimeZoneInformation;\n const lpLocalTime: PSystemTime; lpUniversalTime: PSystemTime): BOOL;\nvar\n ft: TFileTime;\n lBias: LongInt;\n t: Int64;\n tzinfo: TTimeZoneInformation;\nbegin\n if (lpTimeZoneInformation <> nil) then\n tzinfo := lpTimeZoneInformation^\n else\n if (GetTimeZoneInformation(tzinfo) = TIME_ZONE_ID_INVALID) then\n begin\n Result := False;\n Exit;\n end;\n\n if (not SystemTimeToFileTime(lpLocalTime^, ft)) then\n begin\n Result := False;\n Exit;\n end;\n t := PInt64(@ft)^;\n if (not GetTimezoneBias(@tzinfo, @ft, True, @lBias)) then\n begin\n Result := False;\n Exit;\n end;\n (* convert minutes to 100-nanoseconds-ticks *)\n inc(t, Int64(lBias) * 600000000);\n PInt64(@ft)^ := t;\n Result := FileTimeToSystemTime(ft, lpUniversalTime^);\nend;\n{$ELSE}\nfunction TzSpecificLocalTimeToSystemTime(\n lpTimeZoneInformation: PTimeZoneInformation;\n lpLocalTime, lpUniversalTime: PSystemTime): BOOL; stdcall; external 'kernel32.dll';\n\nfunction SystemTimeToTzSpecificLocalTime(\n lpTimeZoneInformation: PTimeZoneInformation;\n lpUniversalTime, lpLocalTime: PSystemTime): BOOL; stdcall; external 'kernel32.dll';\n{$ENDIF}\n\nfunction JavaToDelphiDateTime(const dt: int64): TDateTime;\nvar\n t: TSystemTime;\nbegin\n DateTimeToSystemTime(25569 + (dt / 86400000), t);\n SystemTimeToTzSpecificLocalTime(nil, @t, @t);\n Result := SystemTimeToDateTime(t);\nend;\n\nfunction DelphiToJavaDateTime(const dt: TDateTime): int64;\nvar\n t: TSystemTime;\nbegin\n DateTimeToSystemTime(dt, t);\n TzSpecificLocalTimeToSystemTime(nil, @t, @t);\n Result := Round((SystemTimeToDateTime(t) - 25569) * 86400000)\nend;\n{$ENDIF}\n\n\nfunction SO(const s: SOString): ISuperObject; overload;\nbegin\n Result := TSuperObject.ParseString(PSOChar(s), False);\nend;\n\nfunction SA(const Args: array of const): ISuperObject; overload;\ntype\n TByteArray = array[0..sizeof(integer) - 1] of byte;\n PByteArray = ^TByteArray;\nvar\n j: Integer;\n intf: IInterface;\nbegin\n Result := TSuperObject.Create(stArray);\n for j := 0 to length(Args) - 1 do\n with Result.AsArray do\n case TVarRec(Args[j]).VType of\n vtInteger : Add(TSuperObject.Create(TVarRec(Args[j]).VInteger));\n vtInt64 : Add(TSuperObject.Create(TVarRec(Args[j]).VInt64^));\n vtBoolean : Add(TSuperObject.Create(TVarRec(Args[j]).VBoolean));\n vtChar : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VChar)));\n vtWideChar: Add(TSuperObject.Create(SOChar(TVarRec(Args[j]).VWideChar)));\n vtExtended: Add(TSuperObject.Create(TVarRec(Args[j]).VExtended^));\n vtCurrency: Add(TSuperObject.CreateCurrency(TVarRec(Args[j]).VCurrency^));\n vtString : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VString^)));\n vtPChar : Add(TSuperObject.Create(SOString(TVarRec(Args[j]).VPChar^)));\n vtAnsiString: Add(TSuperObject.Create(SOString(AnsiString(TVarRec(Args[j]).VAnsiString))));\n vtWideString: Add(TSuperObject.Create(SOString(PWideChar(TVarRec(Args[j]).VWideString))));\n vtInterface:\n if TVarRec(Args[j]).VInterface = nil then\n Add(nil) else\n if IInterface(TVarRec(Args[j]).VInterface).QueryInterface(ISuperObject, intf) = 0 then\n Add(ISuperObject(intf)) else\n Add(nil);\n vtPointer :\n if TVarRec(Args[j]).VPointer = nil then\n Add(nil) else\n Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer)));\n vtVariant:\n Add(SO(TVarRec(Args[j]).VVariant^));\n vtObject:\n if TVarRec(Args[j]).VPointer = nil then\n Add(nil) else\n Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer)));\n vtClass:\n if TVarRec(Args[j]).VPointer = nil then\n Add(nil) else\n Add(TSuperObject.Create(PtrInt(TVarRec(Args[j]).VPointer)));\n{$if declared(vtUnicodeString)}\n vtUnicodeString:\n Add(TSuperObject.Create(SOString(string(TVarRec(Args[j]).VUnicodeString))));\n{$ifend}\n else\n assert(false);\n end;\nend;\n\nfunction SO(const Args: array of const): ISuperObject; overload;\nvar\n j: Integer;\n arr: ISuperObject;\nbegin\n Result := TSuperObject.Create(stObject);\n arr := SA(Args);\n with arr.AsArray do\n for j := 0 to (Length div 2) - 1 do\n Result.AsObject.PutO(O[j*2].AsString, O[(j*2) + 1]);\nend;\n\nfunction SO(const value: Variant): ISuperObject; overload;\nbegin\n with TVarData(value) do\n case VType of\n varNull: Result := nil;\n varEmpty: Result := nil;\n varSmallInt: Result := TSuperObject.Create(VSmallInt);\n varInteger: Result := TSuperObject.Create(VInteger);\n varSingle: Result := TSuperObject.Create(VSingle);\n varDouble: Result := TSuperObject.Create(VDouble);\n varCurrency: Result := TSuperObject.CreateCurrency(VCurrency);\n varDate: Result := TSuperObject.Create(DelphiToJavaDateTime(vDate));\n varOleStr: Result := TSuperObject.Create(SOString(VOleStr));\n varBoolean: Result := TSuperObject.Create(VBoolean);\n varShortInt: Result := TSuperObject.Create(VShortInt);\n varByte: Result := TSuperObject.Create(VByte);\n varWord: Result := TSuperObject.Create(VWord);\n varLongWord: Result := TSuperObject.Create(VLongWord);\n varInt64: Result := TSuperObject.Create(VInt64);\n varString: Result := TSuperObject.Create(SOString(AnsiString(VString)));\n{$if declared(varUString)}\n varUString: Result := TSuperObject.Create(SOString(string(VUString)));\n{$ifend}\n else\n raise Exception.CreateFmt('Unsuported variant data type: %d', [VType]);\n end;\nend;\n\nfunction ObjectIsError(obj: TSuperObject): boolean;\nbegin\n Result := PtrUInt(obj) > PtrUInt(-4000);\nend;\n\nfunction ObjectIsType(const obj: ISuperObject; typ: TSuperType): boolean;\nbegin\n if obj <> nil then\n Result := typ = obj.DataType else\n Result := typ = stNull;\nend;\n\nfunction ObjectGetType(const obj: ISuperObject): TSuperType;\nbegin\n if obj <> nil then\n Result := obj.DataType else\n Result := stNull;\nend;\n\nfunction ObjectFindFirst(const obj: ISuperObject; var F: TSuperObjectIter): boolean;\nvar\n i: TSuperAvlEntry;\nbegin\n if ObjectIsType(obj, stObject) then\n begin\n F.Ite := TSuperAvlIterator.Create(obj.AsObject);\n F.Ite.First;\n i := F.Ite.GetIter;\n if i <> nil then\n begin\n f.key := i.Name;\n f.val := i.Value;\n Result := true;\n end else\n Result := False;\n end else\n Result := False;\nend;\n\nfunction ObjectFindNext(var F: TSuperObjectIter): boolean;\nvar\n i: TSuperAvlEntry;\nbegin\n F.Ite.Next;\n i := F.Ite.GetIter;\n if i <> nil then\n begin\n f.key := i.FName;\n f.val := i.Value;\n Result := true;\n end else\n Result := False;\nend;\n\nprocedure ObjectFindClose(var F: TSuperObjectIter);\nbegin\n F.Ite.Free;\n F.val := nil;\nend;\n\n{$IFDEF VER210}\n\nfunction serialtoboolean(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;\nbegin\n Result := TSuperObject.Create(TValueData(value).FAsSLong <> 0);\nend;\n\nfunction serialtodatetime(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;\nbegin\n Result := TSuperObject.Create(DelphiToJavaDateTime(TValueData(value).FAsDouble));\nend;\n\nfunction serialtoguid(ctx: TSuperRttiContext; var value: TValue; const index: ISuperObject): ISuperObject;\nvar\n g: TGUID;\nbegin\n value.ExtractRawData(@g);\n Result := TSuperObject.Create(\n format('%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x',\n [g.D1, g.D2, g.D3,\n g.D4[0], g.D4[1], g.D4[2],\n g.D4[3], g.D4[4], g.D4[5],\n g.D4[6], g.D4[7]])\n );\nend;\n\nfunction serialfromboolean(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;\nvar\n o: ISuperObject;\nbegin\n case ObjectGetType(obj) of\n stBoolean:\n begin\n TValueData(Value).FAsSLong := obj.AsInteger;\n Result := True;\n end;\n stInt:\n begin\n TValueData(Value).FAsSLong := ord(obj.AsInteger <> 0);\n Result := True;\n end;\n stString:\n begin\n o := SO(obj.AsString);\n if not ObjectIsType(o, stString) then\n Result := serialfromboolean(ctx, SO(obj.AsString), Value) else\n Result := False;\n end;\n else\n Result := False;\n end;\nend;\n\nfunction serialfromdatetime(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;\nvar\n dt: TDateTime;\nbegin\n case ObjectGetType(obj) of\n stInt:\n begin\n TValueData(Value).FAsDouble := JavaToDelphiDateTime(obj.AsInteger);\n Result := True;\n end;\n stString:\n begin\n if TryStrToDateTime(obj.AsString, dt) then\n begin\n TValueData(Value).FAsDouble := dt;\n Result := True;\n end else\n Result := False;\n end;\n else\n Result := False;\n end;\nend;\n\nfunction UuidFromString(const s: PSOChar; Uuid: PGUID): Boolean;\nconst\n hex2bin: array[#0..#102] of short = (\n -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, (* 0x00 *)\n -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, (* 0x10 *)\n -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, (* 0x20 *)\n 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1, (* 0x30 *)\n -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1, (* 0x40 *)\n -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, (* 0x50 *)\n -1,10,11,12,13,14,15); (* 0x60 *)\nvar\n i: Integer;\nbegin\n if (strlen(s) <> 36) then Exit(False);\n\n if ((s[8] <> '-') or (s[13] <> '-') or (s[18] <> '-') or (s[23] <> '-')) then\n Exit(False);\n\n for i := 0 to 35 do\n begin\n if not i in [8,13,18,23] then\n if ((s[i] > 'f') or ((hex2bin[s[i]] = -1) and (s[i] <> ''))) then\n Exit(False);\n end;\n\n uuid.D1 := ((hex2bin[s[0]] shl 28) or (hex2bin[s[1]] shl 24) or (hex2bin[s[2]] shl 20) or (hex2bin[s[3]] shl 16) or\n (hex2bin[s[4]] shl 12) or (hex2bin[s[5]] shl 8) or (hex2bin[s[6]] shl 4) or hex2bin[s[7]]);\n uuid.D2 := (hex2bin[s[9]] shl 12) or (hex2bin[s[10]] shl 8) or (hex2bin[s[11]] shl 4) or hex2bin[s[12]];\n uuid.D3 := (hex2bin[s[14]] shl 12) or (hex2bin[s[15]] shl 8) or (hex2bin[s[16]] shl 4) or hex2bin[s[17]];\n\n uuid.D4[0] := (hex2bin[s[19]] shl 4) or hex2bin[s[20]];\n uuid.D4[1] := (hex2bin[s[21]] shl 4) or hex2bin[s[22]];\n uuid.D4[2] := (hex2bin[s[24]] shl 4) or hex2bin[s[25]];\n uuid.D4[3] := (hex2bin[s[26]] shl 4) or hex2bin[s[27]];\n uuid.D4[4] := (hex2bin[s[28]] shl 4) or hex2bin[s[29]];\n uuid.D4[5] := (hex2bin[s[30]] shl 4) or hex2bin[s[31]];\n uuid.D4[6] := (hex2bin[s[32]] shl 4) or hex2bin[s[33]];\n uuid.D4[7] := (hex2bin[s[34]] shl 4) or hex2bin[s[35]];\n Result := True;\nend;\n\nfunction serialfromguid(ctx: TSuperRttiContext; const obj: ISuperObject; var Value: TValue): Boolean;\nbegin\n case ObjectGetType(obj) of\n stNull:\n begin\n FillChar(Value.GetReferenceToRawData^, SizeOf(TGUID), 0);\n Result := True;\n end;\n stString: Result := UuidFromString(PSOChar(obj.AsString), Value.GetReferenceToRawData);\n else\n Result := False;\n end;\nend;\n\nfunction SOInvoke(const obj: TValue; const method: string; const params: ISuperObject; ctx: TSuperRttiContext): ISuperObject; overload;\nvar\n owned: Boolean;\nbegin\n if ctx = nil then\n begin\n ctx := TSuperRttiContext.Create;\n owned := True;\n end else\n owned := False;\n try\n if TrySOInvoke(ctx, obj, method, params, Result) <> irSuccess then\n raise Exception.Create('Invalid method call');\n finally\n if owned then\n ctx.Free;\n end;\nend;\n\nfunction SOInvoke(const obj: TValue; const method: string; const params: string; ctx: TSuperRttiContext): ISuperObject; overload;\nbegin\n Result := SOInvoke(obj, method, so(params), ctx)\nend;\n\nfunction TrySOInvoke(var ctx: TSuperRttiContext; const obj: TValue;\n const method: string; const params: ISuperObject;\n var Return: ISuperObject): TSuperInvokeResult;\nvar\n t: TRttiInstanceType;\n m: TRttiMethod;\n a: TArray;\n ps: TArray;\n v: TValue;\n index: ISuperObject;\n\n function GetParams: Boolean;\n var\n i: Integer;\n begin\n case ObjectGetType(params) of\n stArray:\n for i := 0 to Length(ps) - 1 do\n if (pfOut in ps[i].Flags) then\n TValue.Make(nil, ps[i].ParamType.Handle, a[i]) else\n if not ctx.FromJson(ps[i].ParamType.Handle, params.AsArray[i], a[i]) then\n Exit(False);\n stObject:\n for i := 0 to Length(ps) - 1 do\n if (pfOut in ps[i].Flags) then\n TValue.Make(nil, ps[i].ParamType.Handle, a[i]) else\n if not ctx.FromJson(ps[i].ParamType.Handle, params.AsObject[ps[i].Name], a[i]) then\n Exit(False);\n stNull: ;\n else\n Exit(False);\n end;\n Result := True;\n end;\n\n procedure SetParams;\n var\n i: Integer;\n begin\n case ObjectGetType(params) of\n stArray:\n for i := 0 to Length(ps) - 1 do\n if (ps[i].Flags * [pfVar, pfOut]) <> [] then\n params.AsArray[i] := ctx.ToJson(a[i], index);\n stObject:\n for i := 0 to Length(ps) - 1 do\n if (ps[i].Flags * [pfVar, pfOut]) <> [] then\n params.AsObject[ps[i].Name] := ctx.ToJson(a[i], index);\n end;\n end;\n\nbegin\n Result := irSuccess;\n index := SO;\n case obj.Kind of\n tkClass:\n begin\n t := TRttiInstanceType(ctx.Context.GetType(obj.AsObject.ClassType));\n m := t.GetMethod(method);\n if m = nil then Exit(irMethothodError);\n ps := m.GetParameters;\n SetLength(a, Length(ps));\n if not GetParams then Exit(irParamError);\n if m.IsClassMethod then\n begin\n v := m.Invoke(obj.AsObject.ClassType, a);\n Return := ctx.ToJson(v, index);\n SetParams;\n end else\n begin\n v := m.Invoke(obj, a);\n Return := ctx.ToJson(v, index);\n SetParams;\n end;\n end;\n tkClassRef:\n begin\n t := TRttiInstanceType(ctx.Context.GetType(obj.AsClass));\n m := t.GetMethod(method);\n if m = nil then Exit(irMethothodError);\n ps := m.GetParameters;\n SetLength(a, Length(ps));\n\n if not GetParams then Exit(irParamError);\n if m.IsClassMethod then\n begin\n v := m.Invoke(obj, a);\n Return := ctx.ToJson(v, index);\n SetParams;\n end else\n Exit(irError);\n end;\n else\n Exit(irError);\n end;\nend;\n\n{$ENDIF}\n\n{ TSuperEnumerator }\n\nconstructor TSuperEnumerator.Create(const obj: ISuperObject);\nbegin\n FObj := obj;\n FCount := -1;\n if ObjectIsType(FObj, stObject) then\n FObjEnum := FObj.AsObject.GetEnumerator else\n FObjEnum := nil;\nend;\n\ndestructor TSuperEnumerator.Destroy;\nbegin\n if FObjEnum <> nil then\n FObjEnum.Free;\nend;\n\nfunction TSuperEnumerator.MoveNext: Boolean;\nbegin\n case ObjectGetType(FObj) of\n stObject: Result := FObjEnum.MoveNext;\n stArray:\n begin\n inc(FCount);\n if FCount < FObj.AsArray.Length then\n Result := True else\n Result := False;\n end;\n else\n Result := false;\n end;\nend;\n\nfunction TSuperEnumerator.GetCurrent: ISuperObject;\nbegin\n case ObjectGetType(FObj) of\n stObject: Result := FObjEnum.Current.Value;\n stArray: Result := FObj.AsArray.GetO(FCount);\n else\n Result := FObj;\n end;\nend;\n\n{ TSuperObject }\n\nconstructor TSuperObject.Create(jt: TSuperType);\nbegin\n inherited Create;\n{$IFDEF DEBUG}\n InterlockedIncrement(debugcount);\n{$ENDIF}\n\n FProcessing := false;\n FDataPtr := nil;\n FDataType := jt;\n case FDataType of\n stObject: FO.c_object := TSuperTableString.Create;\n stArray: FO.c_array := TSuperArray.Create;\n stString: FOString := '';\n else\n FO.c_object := nil;\n end;\nend;\n\nconstructor TSuperObject.Create(b: boolean);\nbegin\n Create(stBoolean);\n FO.c_boolean := b;\nend;\n\nconstructor TSuperObject.Create(i: SuperInt);\nbegin\n Create(stInt);\n FO.c_int := i;\nend;\n\nconstructor TSuperObject.Create(d: double);\nbegin\n Create(stDouble);\n FO.c_double := d;\nend;\n\nconstructor TSuperObject.CreateCurrency(c: Currency);\nbegin\n Create(stCurrency);\n FO.c_currency := c;\nend;\n\ndestructor TSuperObject.Destroy;\nbegin\n{$IFDEF DEBUG}\n InterlockedDecrement(debugcount);\n{$ENDIF}\n case FDataType of\n stObject: FO.c_object.Free;\n stArray: FO.c_array.Free;\n end;\n inherited;\nend;\n\nfunction TSuperObject.Write(writer: TSuperWriter; indent: boolean; escape: boolean; level: integer): Integer;\nfunction DoEscape(str: PSOChar; len: Integer): Integer;\nvar\n pos, start_offset: Integer;\n c: SOChar;\n buf: array[0..5] of SOChar;\ntype\n TByteChar = record\n case integer of\n 0: (a, b: Byte);\n 1: (c: WideChar);\n end;\n begin\n if str = nil then\n begin\n Result := 0;\n exit;\n end;\n pos := 0; start_offset := 0;\n with writer do\n while pos < len do\n begin\n c := str[pos];\n case c of\n #8,#9,#10,#12,#13,'\"','\\','/':\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n\n if(c = #8) then Append(ESC_BS, 2)\n else if (c = #9) then Append(ESC_TAB, 2)\n else if (c = #10) then Append(ESC_LF, 2)\n else if (c = #12) then Append(ESC_FF, 2)\n else if (c = #13) then Append(ESC_CR, 2)\n else if (c = '\"') then Append(ESC_QUOT, 2)\n else if (c = '\\') then Append(ESC_SL, 2)\n else if (c = '/') then Append(ESC_SR, 2);\n inc(pos);\n start_offset := pos;\n end;\n else\n if (SOIChar(c) > 255) then\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n buf[0] := '\\';\n buf[1] := 'u';\n buf[2] := super_hex_chars[TByteChar(c).b shr 4];\n buf[3] := super_hex_chars[TByteChar(c).b and $f];\n buf[4] := super_hex_chars[TByteChar(c).a shr 4];\n buf[5] := super_hex_chars[TByteChar(c).a and $f];\n Append(@buf, 6);\n inc(pos);\n start_offset := pos;\n end else\n if (c < #32) or (c > #127) then\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n buf[0] := '\\';\n buf[1] := 'u';\n buf[2] := '0';\n buf[3] := '0';\n buf[4] := super_hex_chars[ord(c) shr 4];\n buf[5] := super_hex_chars[ord(c) and $f];\n Append(buf, 6);\n inc(pos);\n start_offset := pos;\n end else\n inc(pos);\n end;\n end;\n if(pos - start_offset > 0) then\n writer.Append(str + start_offset, pos - start_offset);\n Result := 0;\n end;\n\nfunction DoMinimalEscape(str: PSOChar; len: Integer): Integer;\nvar\n pos, start_offset: Integer;\n c: SOChar;\ntype\n TByteChar = record\n case integer of\n 0: (a, b: Byte);\n 1: (c: WideChar);\n end;\n begin\n if str = nil then\n begin\n Result := 0;\n exit;\n end;\n pos := 0; start_offset := 0;\n with writer do\n while pos < len do\n begin\n c := str[pos];\n case c of\n #0:\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n Append(ESC_ZERO, 6);\n inc(pos);\n start_offset := pos;\n end;\n '\"':\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n Append(ESC_QUOT, 2);\n inc(pos);\n start_offset := pos;\n end;\n '\\':\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n Append(ESC_SL, 2);\n inc(pos);\n start_offset := pos;\n end;\n '/':\n begin\n if(pos - start_offset > 0) then\n Append(str + start_offset, pos - start_offset);\n Append(ESC_SR, 2);\n inc(pos);\n start_offset := pos;\n end;\n else\n inc(pos);\n end;\n end;\n if(pos - start_offset > 0) then\n writer.Append(str + start_offset, pos - start_offset);\n Result := 0;\n end;\n\n\n procedure _indent(i: shortint; r: boolean);\n begin\n inc(level, i);\n if r then\n with writer do\n begin\n{$IFDEF MSWINDOWS}\n Append(TOK_CRLF, 2);\n{$ELSE}\n Append(TOK_LF, 1);\n{$ENDIF}\n for i := 0 to level - 1 do\n Append(TOK_SP, 1);\n end;\n end;\nvar\n k,j: Integer;\n iter: TSuperObjectIter;\n st: AnsiString;\n val: ISuperObject;\n fbuffer: array[0..31] of AnsiChar;\nconst\n ENDSTR_A: PSOChar = '\": ';\n ENDSTR_B: PSOChar = '\":';\nbegin\n\n if FProcessing then\n begin\n Result := writer.Append(TOK_NULL, 4);\n Exit;\n end;\n\n FProcessing := true;\n with writer do\n try\n case FDataType of\n stObject:\n if FO.c_object.FCount > 0 then\n begin\n k := 0;\n Append(TOK_CBL, 1);\n if indent then _indent(1, false);\n if ObjectFindFirst(Self, iter) then\n repeat\n {$IFDEF SUPER_METHOD}\n if (iter.val = nil) or not ObjectIsType(iter.val, stMethod) then\n begin\n {$ENDIF}\n if (iter.val = nil) or (not iter.val.Processing) then\n begin\n if(k <> 0) then\n Append(TOK_COM, 1);\n if indent then _indent(0, true);\n Append(TOK_DQT, 1);\n if escape then\n doEscape(PSOChar(iter.key), Length(iter.key)) else\n DoMinimalEscape(PSOChar(iter.key), Length(iter.key));\n if indent then\n Append(ENDSTR_A, 3) else\n Append(ENDSTR_B, 2);\n if(iter.val = nil) then\n Append(TOK_NULL, 4) else\n iter.val.write(writer, indent, escape, level);\n inc(k);\n end;\n {$IFDEF SUPER_METHOD}\n end;\n {$ENDIF}\n until not ObjectFindNext(iter);\n ObjectFindClose(iter);\n if indent then _indent(-1, true);\n Result := Append(TOK_CBR, 1);\n end else\n Result := Append(TOK_OBJ, 2);\n stBoolean:\n begin\n if (FO.c_boolean) then\n Result := Append(TOK_TRUE, 4) else\n Result := Append(TOK_FALSE, 5);\n end;\n stInt:\n begin\n str(FO.c_int, st);\n Result := Append(PSOChar(SOString(st)));\n end;\n stDouble:\n Result := Append(PSOChar(SOString(gcvt(FO.c_double, 15, fbuffer))));\n stCurrency:\n begin\n Result := Append(PSOChar(CurrToStr(FO.c_currency)));\n end;\n stString:\n begin\n Append(TOK_DQT, 1);\n if escape then\n doEscape(PSOChar(FOString), Length(FOString)) else\n DoMinimalEscape(PSOChar(FOString), Length(FOString));\n Append(TOK_DQT, 1);\n Result := 0;\n end;\n stArray:\n if FO.c_array.FLength > 0 then\n begin\n Append(TOK_ARL, 1);\n if indent then _indent(1, true);\n k := 0;\n j := 0;\n while k < FO.c_array.FLength do\n begin\n\n val := FO.c_array.GetO(k);\n {$IFDEF SUPER_METHOD}\n if not ObjectIsType(val, stMethod) then\n begin\n {$ENDIF}\n if (val = nil) or (not val.Processing) then\n begin\n if (j <> 0) then\n Append(TOK_COM, 1);\n if(val = nil) then\n Append(TOK_NULL, 4) else\n val.write(writer, indent, escape, level);\n inc(j);\n end;\n {$IFDEF SUPER_METHOD}\n end;\n {$ENDIF}\n inc(k);\n end;\n if indent then _indent(-1, false);\n Result := Append(TOK_ARR, 1);\n end else\n Result := Append(TOK_ARRAY, 2);\n stNull:\n Result := Append(TOK_NULL, 4);\n else\n Result := 0;\n end;\n finally\n FProcessing := false;\n end;\nend;\n\nfunction TSuperObject.IsType(AType: TSuperType): boolean;\nbegin\n Result := AType = FDataType;\nend;\n\nfunction TSuperObject.AsBoolean: boolean;\nbegin\n case FDataType of\n stBoolean: Result := FO.c_boolean;\n stInt: Result := (FO.c_int <> 0);\n stDouble: Result := (FO.c_double <> 0);\n stCurrency: Result := (FO.c_currency <> 0);\n stString: Result := (Length(FOString) <> 0);\n stNull: Result := False;\n else\n Result := True;\n end;\nend;\n\nfunction TSuperObject.AsInteger: SuperInt;\nvar\n code: integer;\n cint: SuperInt;\nbegin\n case FDataType of\n stInt: Result := FO.c_int;\n stDouble: Result := round(FO.c_double);\n stCurrency: Result := round(FO.c_currency);\n stBoolean: Result := ord(FO.c_boolean);\n stString:\n begin\n Val(FOString, cint, code);\n if code = 0 then\n Result := cint else\n Result := 0;\n end;\n else\n Result := 0;\n end;\nend;\n\nfunction TSuperObject.AsDouble: Double;\nvar\n code: integer;\n cdouble: double;\nbegin\n case FDataType of\n stDouble: Result := FO.c_double;\n stCurrency: Result := FO.c_currency;\n stInt: Result := FO.c_int;\n stBoolean: Result := ord(FO.c_boolean);\n stString:\n begin\n Val(FOString, cdouble, code);\n if code = 0 then\n Result := cdouble else\n Result := 0.0;\n end;\n else\n Result := 0.0;\n end;\nend;\n\nfunction TSuperObject.AsCurrency: Currency;\nvar\n code: integer;\n cdouble: double;\nbegin\n case FDataType of\n stDouble: Result := FO.c_double;\n stCurrency: Result := FO.c_currency;\n stInt: Result := FO.c_int;\n stBoolean: Result := ord(FO.c_boolean);\n stString:\n begin\n Val(FOString, cdouble, code);\n if code = 0 then\n Result := cdouble else\n Result := 0.0;\n end;\n else\n Result := 0.0;\n end;\nend;\n\nfunction TSuperObject.AsString: SOString;\nbegin\n if FDataType = stString then\n Result := FOString else\n Result := AsJSon(false, false);\nend;\n\nfunction TSuperObject.GetEnumerator: TSuperEnumerator;\nbegin\n Result := TSuperEnumerator.Create(Self);\nend;\n\nprocedure TSuperObject.AfterConstruction;\nbegin\n InterlockedDecrement(FRefCount);\nend;\n\nprocedure TSuperObject.BeforeDestruction;\nbegin\n if RefCount <> 0 then\n raise Exception.Create('Invalid pointer');\nend;\n\nfunction TSuperObject.AsArray: TSuperArray;\nbegin\n if FDataType = stArray then\n Result := FO.c_array else\n Result := nil;\nend;\n\nfunction TSuperObject.AsObject: TSuperTableString;\nbegin\n if FDataType = stObject then\n Result := FO.c_object else\n Result := nil;\nend;\n\nfunction TSuperObject.AsJSon(indent, escape: boolean): SOString;\nvar\n pb: TSuperWriterString;\nbegin\n pb := TSuperWriterString.Create;\n try\n if(Write(pb, indent, escape, 0) < 0) then\n begin\n Result := '';\n Exit;\n end;\n if pb.FBPos > 0 then\n Result := pb.FBuf else\n Result := '';\n finally\n pb.Free;\n end;\nend;\n\nclass function TSuperObject.ParseString(s: PSOChar; strict: Boolean; partial: boolean; const this: ISuperObject;\n options: TSuperFindOptions; const put: ISuperObject; dt: TSuperType): ISuperObject;\nvar\n tok: TSuperTokenizer;\n obj: ISuperObject;\nbegin\n tok := TSuperTokenizer.Create;\n obj := ParseEx(tok, s, -1, strict, this, options, put, dt);\n if(tok.err <> teSuccess) or (not partial and (s[tok.char_offset] <> #0)) then\n Result := nil else\n Result := obj;\n tok.Free;\nend;\n\nclass function TSuperObject.ParseStream(stream: TStream; strict: Boolean;\n partial: boolean; const this: ISuperObject; options: TSuperFindOptions;\n const put: ISuperObject; dt: TSuperType): ISuperObject;\nconst\n BUFFER_SIZE = 1024;\nvar\n tok: TSuperTokenizer;\n buffera: array[0..BUFFER_SIZE-1] of AnsiChar;\n bufferw: array[0..BUFFER_SIZE-1] of SOChar;\n bom: array[0..1] of byte;\n unicode: boolean;\n j, size: Integer;\n st: string;\nbegin\n st := '';\n tok := TSuperTokenizer.Create;\n\n if (stream.Read(bom, sizeof(bom)) = 2) and (bom[0] = $FF) and (bom[1] = $FE) then\n begin\n unicode := true;\n size := stream.Read(bufferw, BUFFER_SIZE * SizeOf(SoChar)) div SizeOf(SoChar);\n end else\n begin\n unicode := false;\n stream.Seek(0, soFromBeginning);\n size := stream.Read(buffera, BUFFER_SIZE);\n end;\n\n while size > 0 do\n begin\n if not unicode then\n for j := 0 to size - 1 do\n bufferw[j] := SOChar(buffera[j]);\n ParseEx(tok, bufferw, size, strict, this, options, put, dt);\n\n if tok.err = teContinue then\n begin\n if not unicode then\n size := stream.Read(buffera, BUFFER_SIZE) else\n size := stream.Read(bufferw, BUFFER_SIZE * SizeOf(SoChar)) div SizeOf(SoChar);\n end else\n Break;\n end;\n if(tok.err <> teSuccess) or (not partial and (st[tok.char_offset] <> #0)) then\n Result := nil else\n Result := tok.stack[tok.depth].current;\n tok.Free;\nend;\n\nclass function TSuperObject.ParseFile(const FileName: string; strict: Boolean;\n partial: boolean; const this: ISuperObject; options: TSuperFindOptions;\n const put: ISuperObject; dt: TSuperType): ISuperObject;\nvar\n stream: TFileStream;\nbegin\n stream := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite);\n try\n Result := ParseStream(stream, strict, partial, this, options, put, dt);\n finally\n stream.Free;\n end;\nend;\n\nclass function TSuperObject.ParseEx(tok: TSuperTokenizer; str: PSOChar; len: integer;\n strict: Boolean; const this: ISuperObject; options: TSuperFindOptions; const put: ISuperObject; dt: TSuperType): ISuperObject;\n\nconst\n spaces = [#32,#8,#9,#10,#12,#13];\n delimiters = ['\"', '.', '[', ']', '{', '}', '(', ')', ',', ':', #0];\n reserved = delimiters + spaces;\n path = ['a'..'z', 'A'..'Z', '.', '_'];\n\n function hexdigit(x: SOChar): byte;\n begin\n if x <= '9' then\n Result := byte(x) - byte('0') else\n Result := (byte(x) and 7) + 9;\n end;\n function min(v1, v2: integer): integer; begin if v1 < v2 then result := v1 else result := v2 end;\n\nvar\n obj: ISuperObject;\n v: SOChar;\n{$IFDEF SUPER_METHOD}\n sm: TSuperMethod;\n{$ENDIF}\n numi: SuperInt;\n numd: Double;\n code: integer;\n TokRec: PSuperTokenerSrec;\n evalstack: integer;\n p: PSOChar;\n\n function IsEndDelimiter(v: AnsiChar): Boolean;\n begin\n if tok.depth > 0 then\n case tok.stack[tok.depth - 1].state of\n tsArrayAdd: Result := v in [',', ']', #0];\n tsObjectValueAdd: Result := v in [',', '}', #0];\n else\n Result := v = #0;\n end else\n Result := v = #0;\n end;\n\nlabel out, redo_char;\nbegin\n evalstack := 0;\n obj := nil;\n Result := nil;\n TokRec := @tok.stack[tok.depth];\n\n tok.char_offset := 0;\n tok.err := teSuccess;\n\n repeat\n if (tok.char_offset = len) then\n begin\n if (tok.depth = 0) and (TokRec^.state = tsEatws) and\n (TokRec^.saved_state = tsFinish) then\n tok.err := teSuccess else\n tok.err := teContinue;\n goto out;\n end;\n\n v := str^;\n\n case v of\n #10:\n begin\n inc(tok.line);\n tok.col := 0;\n end;\n #9: inc(tok.col, 4);\n else\n inc(tok.col);\n end;\n\nredo_char:\n case TokRec^.state of\n tsEatws:\n begin\n if (SOIChar(v) < 256) and (AnsiChar(v) in spaces) then {nop} else\n if (v = '/') then\n begin\n tok.pb.Reset;\n tok.pb.Append(@v, 1);\n TokRec^.state := tsCommentStart;\n end else begin\n TokRec^.state := TokRec^.saved_state;\n goto redo_char;\n end\n end;\n\n tsStart:\n case v of\n '\"',\n '''':\n begin\n TokRec^.state := tsString;\n tok.pb.Reset;\n tok.quote_char := v;\n end;\n '-':\n begin\n TokRec^.state := tsNumber;\n tok.pb.Reset;\n tok.is_double := 0;\n tok.floatcount := -1;\n goto redo_char;\n end;\n\n '0'..'9':\n begin\n if (tok.depth = 0) then\n case ObjectGetType(this) of\n stObject:\n begin\n TokRec^.state := tsIdentifier;\n TokRec^.current := this;\n goto redo_char;\n end;\n end;\n TokRec^.state := tsNumber;\n tok.pb.Reset;\n tok.is_double := 0;\n tok.floatcount := -1;\n goto redo_char;\n end;\n '{':\n begin\n TokRec^.state := tsEatws;\n TokRec^.saved_state := tsObjectFieldStart;\n TokRec^.current := TSuperObject.Create(stObject);\n end;\n '[':\n begin\n TokRec^.state := tsEatws;\n TokRec^.saved_state := tsArray;\n TokRec^.current := TSuperObject.Create(stArray);\n end;\n{$IFDEF SUPER_METHOD}\n '(':\n begin\n if (tok.depth = 0) and ObjectIsType(this, stMethod) then\n begin\n TokRec^.current := this;\n TokRec^.state := tsParamValue;\n end;\n end;\n{$ENDIF}\n 'N',\n 'n':\n begin\n TokRec^.state := tsNull;\n tok.pb.Reset;\n tok.st_pos := 0;\n goto redo_char;\n end;\n 'T',\n 't',\n 'F',\n 'f':\n begin\n TokRec^.state := tsBoolean;\n tok.pb.Reset;\n tok.st_pos := 0;\n goto redo_char;\n end;\n else\n TokRec^.state := tsIdentifier;\n tok.pb.Reset;\n goto redo_char;\n end;\n\n tsFinish:\n begin\n if(tok.depth = 0) then goto out;\n obj := TokRec^.current;\n tok.ResetLevel(tok.depth);\n dec(tok.depth);\n TokRec := @tok.stack[tok.depth];\n goto redo_char;\n end;\n\n tsNull:\n begin\n tok.pb.Append(@v, 1);\n if (StrLComp(TOK_NULL, PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 4)) = 0) then\n begin\n if (tok.st_pos = 4) then\n if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then\n TokRec^.state := tsIdentifier else\n begin\n TokRec^.current := TSuperObject.Create(stNull);\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n goto redo_char;\n end;\n end else\n begin\n TokRec^.state := tsIdentifier;\n tok.pb.FBuf[tok.st_pos] := #0;\n dec(tok.pb.FBPos);\n goto redo_char;\n end;\n inc(tok.st_pos);\n end;\n\n tsCommentStart:\n begin\n if(v = '*') then\n begin\n TokRec^.state := tsComment;\n end else\n if (v = '/') then\n begin\n TokRec^.state := tsCommentEol;\n end else\n begin\n tok.err := teParseComment;\n goto out;\n end;\n tok.pb.Append(@v, 1);\n end;\n\n tsComment:\n begin\n if(v = '*') then\n TokRec^.state := tsCommentEnd;\n tok.pb.Append(@v, 1);\n end;\n\n tsCommentEol:\n begin\n if (v = #10) then\n TokRec^.state := tsEatws else\n tok.pb.Append(@v, 1);\n end;\n\n tsCommentEnd:\n begin\n tok.pb.Append(@v, 1);\n if (v = '/') then\n TokRec^.state := tsEatws else\n TokRec^.state := tsComment;\n end;\n\n tsString:\n begin\n if (v = tok.quote_char) then\n begin\n TokRec^.current := TSuperObject.Create(SOString(tok.pb.GetString));\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n end else\n if (v = '\\') then\n begin\n TokRec^.saved_state := tsString;\n TokRec^.state := tsStringEscape;\n end else\n begin\n tok.pb.Append(@v, 1);\n end\n end;\n\n tsEvalProperty:\n begin\n if (TokRec^.current = nil) and (foCreatePath in options) then\n begin\n TokRec^.current := TSuperObject.Create(stObject);\n TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current)\n end else\n if not ObjectIsType(TokRec^.current, stObject) then\n begin\n tok.err := teEvalObject;\n goto out;\n end;\n tok.pb.Reset;\n TokRec^.state := tsIdentifier;\n goto redo_char;\n end;\n\n tsEvalArray:\n begin\n if (TokRec^.current = nil) and (foCreatePath in options) then\n begin\n TokRec^.current := TSuperObject.Create(stArray);\n TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current)\n end else\n if not ObjectIsType(TokRec^.current, stArray) then\n begin\n tok.err := teEvalArray;\n goto out;\n end;\n tok.pb.Reset;\n TokRec^.state := tsParamValue;\n goto redo_char;\n end;\n{$IFDEF SUPER_METHOD}\n tsEvalMethod:\n begin\n if ObjectIsType(TokRec^.current, stMethod) and assigned(TokRec^.current.AsMethod) then\n begin\n tok.pb.Reset;\n TokRec^.obj := TSuperObject.Create(stArray);\n TokRec^.state := tsMethodValue;\n goto redo_char;\n end else\n begin\n tok.err := teEvalMethod;\n goto out;\n end;\n end;\n\n tsMethodValue:\n begin\n case v of\n ')':\n TokRec^.state := tsIdentifier;\n else\n if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then\n begin\n tok.err := teDepth;\n goto out;\n end;\n inc(evalstack);\n TokRec^.state := tsMethodPut;\n inc(tok.depth);\n tok.ResetLevel(tok.depth);\n TokRec := @tok.stack[tok.depth];\n goto redo_char;\n end;\n end;\n\n tsMethodPut:\n begin\n TokRec^.obj.AsArray.Add(obj);\n case v of\n ',':\n begin\n tok.pb.Reset;\n TokRec^.saved_state := tsMethodValue;\n TokRec^.state := tsEatws;\n end;\n ')':\n begin\n if TokRec^.obj.AsArray.Length = 1 then\n TokRec^.obj := TokRec^.obj.AsArray.GetO(0);\n dec(evalstack);\n tok.pb.Reset;\n TokRec^.saved_state := tsIdentifier;\n TokRec^.state := tsEatws;\n end;\n else\n tok.err := teEvalMethod;\n goto out;\n end;\n end;\n{$ENDIF}\n tsParamValue:\n begin\n case v of\n ']':\n TokRec^.state := tsIdentifier;\n else\n if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then\n begin\n tok.err := teDepth;\n goto out;\n end;\n inc(evalstack);\n TokRec^.state := tsParamPut;\n inc(tok.depth);\n tok.ResetLevel(tok.depth);\n TokRec := @tok.stack[tok.depth];\n goto redo_char;\n end;\n end;\n\n tsParamPut:\n begin\n dec(evalstack);\n TokRec^.obj := obj;\n tok.pb.Reset;\n TokRec^.saved_state := tsIdentifier;\n TokRec^.state := tsEatws;\n if v <> ']' then\n begin\n tok.err := teEvalArray;\n goto out;\n end;\n end;\n\n tsIdentifier:\n begin\n if (this = nil) then\n begin\n if (SOIChar(v) < 256) and IsEndDelimiter(AnsiChar(v)) then\n begin\n if not strict then\n begin\n tok.pb.TrimRight;\n TokRec^.current := TSuperObject.Create(tok.pb.Fbuf);\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n goto redo_char;\n end else\n begin\n tok.err := teParseString;\n goto out;\n end;\n end else\n if (v = '\\') then\n begin\n TokRec^.saved_state := tsIdentifier;\n TokRec^.state := tsStringEscape;\n end else\n tok.pb.Append(@v, 1);\n end else\n begin\n if (SOIChar(v) < 256) and (AnsiChar(v) in reserved) then\n begin\n TokRec^.gparent := TokRec^.parent;\n if TokRec^.current = nil then\n TokRec^.parent := this else\n TokRec^.parent := TokRec^.current;\n\n case ObjectGetType(TokRec^.parent) of\n stObject:\n case v of\n '.':\n begin\n TokRec^.state := tsEvalProperty;\n if tok.pb.FBPos > 0 then\n TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);\n end;\n '[':\n begin\n TokRec^.state := tsEvalArray;\n if tok.pb.FBPos > 0 then\n TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);\n end;\n '(':\n begin\n TokRec^.state := tsEvalMethod;\n if tok.pb.FBPos > 0 then\n TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);\n end;\n else\n if tok.pb.FBPos > 0 then\n TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);\n if (foPutValue in options) and (evalstack = 0) then\n begin\n TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, put);\n TokRec^.current := put\n end else\n if (foDelete in options) and (evalstack = 0) then\n begin\n TokRec^.current := TokRec^.parent.AsObject.Delete(tok.pb.Fbuf);\n end else\n if (TokRec^.current = nil) and (foCreatePath in options) then\n begin\n TokRec^.current := TSuperObject.Create(dt);\n TokRec^.parent.AsObject.PutO(tok.pb.Fbuf, TokRec^.current);\n end;\n TokRec^.current := TokRec^.parent.AsObject.GetO(tok.pb.Fbuf);\n TokRec^.state := tsFinish;\n goto redo_char;\n end;\n stArray:\n begin\n if TokRec^.obj <> nil then\n begin\n if not ObjectIsType(TokRec^.obj, stInt) or (TokRec^.obj.AsInteger < 0) then\n begin\n tok.err := teEvalInt;\n TokRec^.obj := nil;\n goto out;\n end;\n numi := TokRec^.obj.AsInteger;\n TokRec^.obj := nil;\n\n TokRec^.current := TokRec^.parent.AsArray.GetO(numi);\n case v of\n '.':\n if (TokRec^.current = nil) and (foCreatePath in options) then\n begin\n TokRec^.current := TSuperObject.Create(stObject);\n TokRec^.parent.AsArray.PutO(numi, TokRec^.current);\n end else\n if (TokRec^.current = nil) then\n begin\n tok.err := teEvalObject;\n goto out;\n end;\n '[':\n begin\n if (TokRec^.current = nil) and (foCreatePath in options) then\n begin\n TokRec^.current := TSuperObject.Create(stArray);\n TokRec^.parent.AsArray.Add(TokRec^.current);\n end else\n if (TokRec^.current = nil) then\n begin\n tok.err := teEvalArray;\n goto out;\n end;\n TokRec^.state := tsEvalArray;\n end;\n '(': TokRec^.state := tsEvalMethod;\n else\n if (foPutValue in options) and (evalstack = 0) then\n begin\n TokRec^.parent.AsArray.PutO(numi, put);\n TokRec^.current := put;\n end else\n if (foDelete in options) and (evalstack = 0) then\n begin\n TokRec^.current := TokRec^.parent.AsArray.Delete(numi);\n end else\n TokRec^.current := TokRec^.parent.AsArray.GetO(numi);\n TokRec^.state := tsFinish;\n goto redo_char\n end;\n end else\n begin\n case v of\n '.':\n begin\n if (foPutValue in options) then\n begin\n TokRec^.current := TSuperObject.Create(stObject);\n TokRec^.parent.AsArray.Add(TokRec^.current);\n end else\n TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1);\n end;\n '[':\n begin\n if (foPutValue in options) then\n begin\n TokRec^.current := TSuperObject.Create(stArray);\n TokRec^.parent.AsArray.Add(TokRec^.current);\n end else\n TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1);\n TokRec^.state := tsEvalArray;\n end;\n '(':\n begin\n if not (foPutValue in options) then\n TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1) else\n TokRec^.current := nil;\n\n TokRec^.state := tsEvalMethod;\n end;\n else\n if (foPutValue in options) and (evalstack = 0) then\n begin\n TokRec^.parent.AsArray.Add(put);\n TokRec^.current := put;\n end else\n if tok.pb.FBPos = 0 then\n TokRec^.current := TokRec^.parent.AsArray.GetO(TokRec^.parent.AsArray.FLength - 1);\n TokRec^.state := tsFinish;\n goto redo_char\n end;\n end;\n end;\n{$IFDEF SUPER_METHOD}\n stMethod:\n case v of\n '.':\n begin\n TokRec^.current := nil;\n sm := TokRec^.parent.AsMethod;\n sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);\n TokRec^.obj := nil;\n end;\n '[':\n begin\n TokRec^.current := nil;\n sm := TokRec^.parent.AsMethod;\n sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);\n TokRec^.state := tsEvalArray;\n TokRec^.obj := nil;\n end;\n '(':\n begin\n TokRec^.current := nil;\n sm := TokRec^.parent.AsMethod;\n sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);\n TokRec^.state := tsEvalMethod;\n TokRec^.obj := nil;\n end;\n else\n if not (foPutValue in options) or (evalstack > 0) then\n begin\n TokRec^.current := nil;\n sm := TokRec^.parent.AsMethod;\n sm(TokRec^.gparent, TokRec^.obj, TokRec^.current);\n TokRec^.obj := nil;\n TokRec^.state := tsFinish;\n goto redo_char\n end else\n begin\n tok.err := teEvalMethod;\n TokRec^.obj := nil;\n goto out;\n end;\n end;\n{$ENDIF}\n end;\n end else\n tok.pb.Append(@v, 1);\n end;\n end;\n\n tsStringEscape:\n case v of\n 'b',\n 'n',\n 'r',\n 't',\n 'f':\n begin\n if(v = 'b') then tok.pb.Append(TOK_BS, 1)\n else if(v = 'n') then tok.pb.Append(TOK_LF, 1)\n else if(v = 'r') then tok.pb.Append(TOK_CR, 1)\n else if(v = 't') then tok.pb.Append(TOK_TAB, 1)\n else if(v = 'f') then tok.pb.Append(TOK_FF, 1);\n TokRec^.state := TokRec^.saved_state;\n end;\n 'u':\n begin\n tok.ucs_char := 0;\n tok.st_pos := 0;\n TokRec^.state := tsEscapeUnicode;\n end;\n 'x':\n begin\n tok.ucs_char := 0;\n tok.st_pos := 0;\n TokRec^.state := tsEscapeHexadecimal;\n end\n else\n tok.pb.Append(@v, 1);\n TokRec^.state := TokRec^.saved_state;\n end;\n\n tsEscapeUnicode:\n begin\n if ((SOIChar(v) < 256) and (AnsiChar(v) in super_hex_chars_set)) then\n begin\n inc(tok.ucs_char, (Word(hexdigit(v)) shl ((3-tok.st_pos)*4)));\n inc(tok.st_pos);\n if (tok.st_pos = 4) then\n begin\n tok.pb.Append(@tok.ucs_char, 1);\n TokRec^.state := TokRec^.saved_state;\n end\n end else\n begin\n tok.err := teParseString;\n goto out;\n end\n end;\n tsEscapeHexadecimal:\n begin\n if ((SOIChar(v) < 256) and (AnsiChar(v) in super_hex_chars_set)) then\n begin\n inc(tok.ucs_char, (Word(hexdigit(v)) shl ((1-tok.st_pos)*4)));\n inc(tok.st_pos);\n if (tok.st_pos = 2) then\n begin\n tok.pb.Append(@tok.ucs_char, 1);\n TokRec^.state := TokRec^.saved_state;\n end\n end else\n begin\n tok.err := teParseString;\n goto out;\n end\n end;\n tsBoolean:\n begin\n tok.pb.Append(@v, 1);\n if (StrLComp('true', PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 4)) = 0) then\n begin\n if (tok.st_pos = 4) then\n if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then\n TokRec^.state := tsIdentifier else\n begin\n TokRec^.current := TSuperObject.Create(true);\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n goto redo_char;\n end\n end else\n if (StrLComp('false', PSOChar(tok.pb.FBuf), min(tok.st_pos + 1, 5)) = 0) then\n begin\n if (tok.st_pos = 5) then\n if (((SOIChar(v) < 256) and (AnsiChar(v) in path)) or (SOIChar(v) >= 256)) then\n TokRec^.state := tsIdentifier else\n begin\n TokRec^.current := TSuperObject.Create(false);\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n goto redo_char;\n end\n end else\n begin\n TokRec^.state := tsIdentifier;\n tok.pb.FBuf[tok.st_pos] := #0;\n dec(tok.pb.FBPos);\n goto redo_char;\n end;\n inc(tok.st_pos);\n end;\n\n tsNumber:\n begin\n if (SOIChar(v) < 256) and (AnsiChar(v) in super_number_chars_set) then\n begin\n tok.pb.Append(@v, 1);\n if (SOIChar(v) < 256) then\n case v of\n '.': begin\n tok.is_double := 1;\n tok.floatcount := 0;\n end;\n 'e','E':\n begin\n tok.is_double := 1;\n tok.floatcount := -1;\n end;\n '0'..'9':\n begin\n\n if (tok.is_double = 1) and (tok.floatcount >= 0) then\n begin\n inc(tok.floatcount);\n if tok.floatcount > 4 then\n tok.floatcount := -1;\n end;\n end;\n end;\n end else\n begin\n if (tok.is_double = 0) then\n begin\n val(tok.pb.FBuf, numi, code);\n if ObjectIsType(this, stArray) then\n begin\n if (foPutValue in options) and (evalstack = 0) then\n begin\n this.AsArray.PutO(numi, put);\n TokRec^.current := put;\n end else\n if (foDelete in options) and (evalstack = 0) then\n TokRec^.current := this.AsArray.Delete(numi) else\n TokRec^.current := this.AsArray.GetO(numi);\n end else\n TokRec^.current := TSuperObject.Create(numi);\n\n end else\n if (tok.is_double <> 0) then\n begin\n if tok.floatcount >= 0 then\n begin\n p := tok.pb.FBuf;\n while p^ <> '.' do inc(p);\n for code := 0 to tok.floatcount - 1 do\n begin\n p^ := p[1];\n inc(p);\n end;\n p^ := #0;\n val(tok.pb.FBuf, numi, code);\n case tok.floatcount of\n 0: numi := numi * 10000;\n 1: numi := numi * 1000;\n 2: numi := numi * 100;\n 3: numi := numi * 10;\n end;\n TokRec^.current := TSuperObject.CreateCurrency(PCurrency(@numi)^);\n end else\n begin\n val(tok.pb.FBuf, numd, code);\n TokRec^.current := TSuperObject.Create(numd);\n end;\n end else\n begin\n tok.err := teParseNumber;\n goto out;\n end;\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n goto redo_char;\n end\n end;\n\n tsArray:\n begin\n if (v = ']') then\n begin\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n end else\n begin\n if(tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then\n begin\n tok.err := teDepth;\n goto out;\n end;\n TokRec^.state := tsArrayAdd;\n inc(tok.depth);\n tok.ResetLevel(tok.depth);\n TokRec := @tok.stack[tok.depth];\n goto redo_char;\n end\n end;\n\n tsArrayAdd:\n begin\n TokRec^.current.AsArray.Add(obj);\n TokRec^.saved_state := tsArraySep;\n TokRec^.state := tsEatws;\n goto redo_char;\n end;\n\n tsArraySep:\n begin\n if (v = ']') then\n begin\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n end else\n if (v = ',') then\n begin\n TokRec^.saved_state := tsArray;\n TokRec^.state := tsEatws;\n end else\n begin\n tok.err := teParseArray;\n goto out;\n end\n end;\n\n tsObjectFieldStart:\n begin\n if (v = '}') then\n begin\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n end else\n if (SOIChar(v) < 256) and (AnsiChar(v) in ['\"', '''']) then\n begin\n tok.quote_char := v;\n tok.pb.Reset;\n TokRec^.state := tsObjectField;\n end else\n if not((SOIChar(v) < 256) and ((AnsiChar(v) in reserved) or strict)) then\n begin\n TokRec^.state := tsObjectUnquotedField;\n tok.pb.Reset;\n goto redo_char;\n end else\n begin\n tok.err := teParseObjectKeyName;\n goto out;\n end\n end;\n\n tsObjectField:\n begin\n if (v = tok.quote_char) then\n begin\n TokRec^.field_name := tok.pb.FBuf;\n TokRec^.saved_state := tsObjectFieldEnd;\n TokRec^.state := tsEatws;\n end else\n if (v = '\\') then\n begin\n TokRec^.saved_state := tsObjectField;\n TokRec^.state := tsStringEscape;\n end else\n begin\n tok.pb.Append(@v, 1);\n end\n end;\n\n tsObjectUnquotedField:\n begin\n if (SOIChar(v) < 256) and (AnsiChar(v) in [':', #0]) then\n begin\n TokRec^.field_name := tok.pb.FBuf;\n TokRec^.saved_state := tsObjectFieldEnd;\n TokRec^.state := tsEatws;\n goto redo_char;\n end else\n if (v = '\\') then\n begin\n TokRec^.saved_state := tsObjectUnquotedField;\n TokRec^.state := tsStringEscape;\n end else\n tok.pb.Append(@v, 1);\n end;\n\n tsObjectFieldEnd:\n begin\n if (v = ':') then\n begin\n TokRec^.saved_state := tsObjectValue;\n TokRec^.state := tsEatws;\n end else\n begin\n tok.err := teParseObjectKeySep;\n goto out;\n end\n end;\n\n tsObjectValue:\n begin\n if (tok.depth >= SUPER_TOKENER_MAX_DEPTH-1) then\n begin\n tok.err := teDepth;\n goto out;\n end;\n TokRec^.state := tsObjectValueAdd;\n inc(tok.depth);\n tok.ResetLevel(tok.depth);\n TokRec := @tok.stack[tok.depth];\n goto redo_char;\n end;\n\n tsObjectValueAdd:\n begin\n TokRec^.current.AsObject.PutO(TokRec^.field_name, obj);\n TokRec^.field_name := '';\n TokRec^.saved_state := tsObjectSep;\n TokRec^.state := tsEatws;\n goto redo_char;\n end;\n\n tsObjectSep:\n begin\n if (v = '}') then\n begin\n TokRec^.saved_state := tsFinish;\n TokRec^.state := tsEatws;\n end else\n if (v = ',') then\n begin\n TokRec^.saved_state := tsObjectFieldStart;\n TokRec^.state := tsEatws;\n end else\n begin\n tok.err := teParseObjectValueSep;\n goto out;\n end\n end;\n end;\n inc(str);\n inc(tok.char_offset);\n until v = #0;\n\n if(TokRec^.state <> tsFinish) and\n (TokRec^.saved_state <> tsFinish) then\n tok.err := teParseEof;\n\n out:\n if(tok.err in [teSuccess]) then\n begin\n{$IFDEF SUPER_METHOD}\n if (foCallMethod in options) and ObjectIsType(TokRec^.current, stMethod) and assigned(TokRec^.current.AsMethod) then\n begin\n sm := TokRec^.current.AsMethod;\n sm(TokRec^.parent, put, Result);\n end else\n{$ENDIF}\n Result := TokRec^.current;\n end else\n Result := nil;\nend;\n\nprocedure TSuperObject.PutO(const path: SOString; const Value: ISuperObject);\nbegin\n ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], Value);\nend;\n\nprocedure TSuperObject.PutB(const path: SOString; Value: Boolean);\nbegin\n ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));\nend;\n\nprocedure TSuperObject.PutD(const path: SOString; Value: Double);\nbegin\n ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));\nend;\n\nprocedure TSuperObject.PutC(const path: SOString; Value: Currency);\nbegin\n ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.CreateCurrency(Value));\nend;\n\nprocedure TSuperObject.PutI(const path: SOString; Value: SuperInt);\nbegin\n ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));\nend;\n\nprocedure TSuperObject.PutS(const path: SOString; const Value: SOString);\nbegin\n ParseString(PSOChar(path), true, False, self, [foCreatePath, foPutValue], TSuperObject.Create(Value));\nend;\n\nfunction TSuperObject.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;\nbegin\n if GetInterface(IID, Obj) then\n Result := 0\n else\n Result := E_NOINTERFACE;\nend;\n\nfunction TSuperObject.SaveTo(stream: TStream; indent, escape: boolean): integer;\nvar\n pb: TSuperWriterStream;\nbegin\n if escape then\n pb := TSuperAnsiWriterStream.Create(stream) else\n pb := TSuperUnicodeWriterStream.Create(stream);\n\n if(Write(pb, indent, escape, 0) < 0) then\n begin\n pb.Reset;\n pb.Free;\n Result := 0;\n Exit;\n end;\n Result := stream.Size;\n pb.Free;\nend;\n\nfunction TSuperObject.CalcSize(indent, escape: boolean): integer;\nvar\n pb: TSuperWriterFake;\nbegin\n pb := TSuperWriterFake.Create;\n if(Write(pb, indent, escape, 0) < 0) then\n begin\n pb.Free;\n Result := 0;\n Exit;\n end;\n Result := pb.FSize;\n pb.Free;\nend;\n\nfunction TSuperObject.SaveTo(socket: Integer; indent, escape: boolean): integer;\nvar\n pb: TSuperWriterSock;\nbegin\n pb := TSuperWriterSock.Create(socket);\n if(Write(pb, indent, escape, 0) < 0) then\n begin\n pb.Free;\n Result := 0;\n Exit;\n end;\n Result := pb.FSize;\n pb.Free;\nend;\n\nconstructor TSuperObject.Create(const s: SOString);\nbegin\n Create(stString);\n FOString := s;\nend;\n\nprocedure TSuperObject.Clear(all: boolean);\nbegin\n if FProcessing then exit;\n FProcessing := true;\n try\n case FDataType of\n stBoolean: FO.c_boolean := false;\n stDouble: FO.c_double := 0.0;\n stCurrency: FO.c_currency := 0.0;\n stInt: FO.c_int := 0;\n stObject: FO.c_object.Clear(all);\n stArray: FO.c_array.Clear(all);\n stString: FOString := '';\n{$IFDEF SUPER_METHOD}\n stMethod: FO.c_method := nil;\n{$ENDIF}\n end;\n finally\n FProcessing := false;\n end;\nend;\n\nprocedure TSuperObject.Pack(all: boolean = false);\nbegin\n if FProcessing then exit;\n FProcessing := true;\n try\n case FDataType of\n stObject: FO.c_object.Pack(all);\n stArray: FO.c_array.Pack(all);\n end;\n finally\n FProcessing := false;\n end;\nend;\n\nfunction TSuperObject.GetN(const path: SOString): ISuperObject;\nbegin\n Result := ParseString(PSOChar(path), False, true, self);\n if Result = nil then\n Result := TSuperObject.Create(stNull);\nend;\n\nprocedure TSuperObject.PutN(const path: SOString; const Value: ISuperObject);\nbegin\n if Value = nil then\n ParseString(PSOChar(path), False, True, self, [foCreatePath, foPutValue], TSuperObject.Create(stNull)) else\n ParseString(PSOChar(path), False, True, self, [foCreatePath, foPutValue], Value);\nend;\n\nfunction TSuperObject.Delete(const path: SOString): ISuperObject;\nbegin\n Result := ParseString(PSOChar(path), False, true, self, [foDelete]);\nend;\n\nfunction TSuperObject.Clone: ISuperObject;\nvar\n ite: TSuperObjectIter;\n arr: TSuperArray;\n j: integer;\nbegin\n case FDataType of\n stBoolean: Result := TSuperObject.Create(FO.c_boolean);\n stDouble: Result := TSuperObject.Create(FO.c_double);\n stCurrency: Result := TSuperObject.CreateCurrency(FO.c_currency);\n stInt: Result := TSuperObject.Create(FO.c_int);\n stString: Result := TSuperObject.Create(FOString);\n{$IFDEF SUPER_METHOD}\n stMethod: Result := TSuperObject.Create(FO.c_method);\n{$ENDIF}\n stObject:\n begin\n Result := TSuperObject.Create(stObject);\n if ObjectFindFirst(self, ite) then\n with Result.AsObject do\n repeat\n PutO(ite.key, ite.val.Clone);\n until not ObjectFindNext(ite);\n ObjectFindClose(ite);\n end;\n stArray:\n begin\n Result := TSuperObject.Create(stArray);\n arr := AsArray;\n with Result.AsArray do\n for j := 0 to arr.Length - 1 do\n Add(arr.GetO(j).Clone);\n end;\n else\n Result := nil;\n end;\nend;\n\nprocedure TSuperObject.Merge(const obj: ISuperObject; reference: boolean);\nvar\n prop1, prop2: ISuperObject;\n ite: TSuperObjectIter;\n arr: TSuperArray;\n j: integer;\nbegin\n if ObjectIsType(obj, FDataType) then\n case FDataType of\n stBoolean: FO.c_boolean := obj.AsBoolean;\n stDouble: FO.c_double := obj.AsDouble;\n stCurrency: FO.c_currency := obj.AsCurrency;\n stInt: FO.c_int := obj.AsInteger;\n stString: FOString := obj.AsString;\n{$IFDEF SUPER_METHOD}\n stMethod: FO.c_method := obj.AsMethod;\n{$ENDIF}\n stObject:\n begin\n if ObjectFindFirst(obj, ite) then\n with FO.c_object do\n repeat\n prop1 := FO.c_object.GetO(ite.key);\n if (prop1 <> nil) and (ite.val <> nil) and (prop1.DataType = ite.val.DataType) then\n prop1.Merge(ite.val) else\n if reference then\n PutO(ite.key, ite.val) else\n PutO(ite.key, ite.val.Clone);\n until not ObjectFindNext(ite);\n ObjectFindClose(ite);\n end;\n stArray:\n begin\n arr := obj.AsArray;\n with FO.c_array do\n for j := 0 to arr.Length - 1 do\n begin\n prop1 := GetO(j);\n prop2 := arr.GetO(j);\n if (prop1 <> nil) and (prop2 <> nil) and (prop1.DataType = prop2.DataType) then\n prop1.Merge(prop2) else\n if reference then\n PutO(j, prop2) else\n PutO(j, prop2.Clone);\n end;\n end;\n end;\nend;\n\nprocedure TSuperObject.Merge(const str: SOString);\nbegin\n Merge(TSuperObject.ParseString(PSOChar(str), False), true);\nend;\n\nclass function TSuperObject.NewInstance: TObject;\nbegin\n Result := inherited NewInstance;\n TSuperObject(Result).FRefCount := 1;\nend;\n\nfunction TSuperObject.ForcePath(const path: SOString; dataType: TSuperType = stObject): ISuperObject;\nbegin\n Result := ParseString(PSOChar(path), False, True, Self, [foCreatePath], nil, dataType);\nend;\n\nfunction TSuperObject.Format(const str: SOString; BeginSep: SOChar; EndSep: SOChar): SOString;\nvar\n p1, p2: PSOChar;\nbegin\n Result := '';\n p2 := PSOChar(str);\n p1 := p2;\n while true do\n if p2^ = BeginSep then\n begin\n if p2 > p1 then\n Result := Result + Copy(p1, 0, p2-p1);\n inc(p2);\n p1 := p2;\n while true do\n if p2^ = EndSep then Break else\n if p2^ = #0 then Exit else\n inc(p2);\n Result := Result + GetS(copy(p1, 0, p2-p1));\n inc(p2);\n p1 := p2;\n end\n else if p2^ = #0 then\n begin\n if p2 > p1 then\n Result := Result + Copy(p1, 0, p2-p1);\n Break;\n end else\n inc(p2);\nend;\n\nfunction TSuperObject.GetO(const path: SOString): ISuperObject;\nbegin\n Result := ParseString(PSOChar(path), False, True, Self);\nend;\n\nfunction TSuperObject.GetA(const path: SOString): TSuperArray;\nvar\n obj: ISuperObject;\nbegin\n obj := ParseString(PSOChar(path), False, True, Self);\n if obj <> nil then\n Result := obj.AsArray else\n Result := nil;\nend;\n\nfunction TSuperObject.GetB(const path: SOString): Boolean;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(path);\n if obj <> nil then\n Result := obj.AsBoolean else\n Result := false;\nend;\n\nfunction TSuperObject.GetD(const path: SOString): Double;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(path);\n if obj <> nil then\n Result := obj.AsDouble else\n Result := 0.0;\nend;\n\nfunction TSuperObject.GetC(const path: SOString): Currency;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(path);\n if obj <> nil then\n Result := obj.AsCurrency else\n Result := 0.0;\nend;\n\nfunction TSuperObject.GetI(const path: SOString): SuperInt;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(path);\n if obj <> nil then\n Result := obj.AsInteger else\n Result := 0;\nend;\n\nfunction TSuperObject.GetDataPtr: Pointer;\nbegin\n Result := FDataPtr;\nend;\n\nfunction TSuperObject.GetDataType: TSuperType;\nbegin\n Result := FDataType\nend;\n\nfunction TSuperObject.GetS(const path: SOString): SOString;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(path);\n if obj <> nil then\n Result := obj.AsString else\n Result := '';\nend;\n\nfunction TSuperObject.SaveTo(const FileName: string; indent, escape: boolean): integer;\nvar\n stream: TFileStream;\nbegin\n stream := TFileStream.Create(FileName, fmCreate);\n try\n Result := SaveTo(stream, indent, escape);\n finally\n stream.Free;\n end;\nend;\n\nfunction TSuperObject.Validate(const rules: SOString; const defs: SOString = ''; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean;\nbegin\n Result := Validate(TSuperObject.ParseString(PSOChar(rules), False), TSuperObject.ParseString(PSOChar(defs), False), callback, sender);\nend;\n\nfunction TSuperObject.Validate(const rules: ISuperObject; const defs: ISuperObject = nil; callback: TSuperOnValidateError = nil; sender: Pointer = nil): boolean;\ntype\n TDataType = (dtUnknown, dtStr, dtInt, dtFloat, dtNumber, dtText, dtBool,\n dtMap, dtSeq, dtScalar, dtAny);\nvar\n datatypes: ISuperObject;\n names: ISuperObject;\n\n function FindInheritedProperty(const prop: PSOChar; p: ISuperObject): ISuperObject;\n var\n o: ISuperObject;\n e: TSuperAvlEntry;\n begin\n o := p[prop];\n if o <> nil then\n result := o else\n begin\n o := p['inherit'];\n if (o <> nil) and ObjectIsType(o, stString) then\n begin\n e := names.AsObject.Search(o.AsString);\n if (e <> nil) then\n Result := FindInheritedProperty(prop, e.Value) else\n Result := nil;\n end else\n Result := nil;\n end;\n end;\n\n function FindDataType(o: ISuperObject): TDataType;\n var\n e: TSuperAvlEntry;\n obj: ISuperObject;\n begin\n obj := FindInheritedProperty('type', o);\n if obj <> nil then\n begin\n e := datatypes.AsObject.Search(obj.AsString);\n if e <> nil then\n Result := TDataType(e.Value.AsInteger) else\n Result := dtUnknown;\n end else\n Result := dtUnknown;\n end;\n\n procedure GetNames(o: ISuperObject);\n var\n obj: ISuperObject;\n f: TSuperObjectIter;\n begin\n obj := o['name'];\n if ObjectIsType(obj, stString) then\n names[obj.AsString] := o;\n\n case FindDataType(o) of\n dtMap:\n begin\n obj := o['mapping'];\n if ObjectIsType(obj, stObject) then\n begin\n if ObjectFindFirst(obj, f) then\n repeat\n if ObjectIsType(f.val, stObject) then\n GetNames(f.val);\n until not ObjectFindNext(f);\n ObjectFindClose(f);\n end;\n end;\n dtSeq:\n begin\n obj := o['sequence'];\n if ObjectIsType(obj, stObject) then\n GetNames(obj);\n end;\n end;\n end;\n\n function FindInheritedField(const prop: SOString; p: ISuperObject): ISuperObject;\n var\n o: ISuperObject;\n e: TSuperAvlEntry;\n begin\n o := p['mapping'];\n if ObjectIsType(o, stObject) then\n begin\n o := o.AsObject.GetO(prop);\n if o <> nil then\n begin\n Result := o;\n Exit;\n end;\n end;\n\n o := p['inherit'];\n if ObjectIsType(o, stString) then\n begin\n e := names.AsObject.Search(o.AsString);\n if (e <> nil) then\n Result := FindInheritedField(prop, e.Value) else\n Result := nil;\n end else\n Result := nil;\n end;\n\n function InheritedFieldExist(const obj: ISuperObject; p: ISuperObject; const name: SOString = ''): boolean;\n var\n o: ISuperObject;\n e: TSuperAvlEntry;\n j: TSuperAvlIterator;\n begin\n Result := true;\n o := p['mapping'];\n if ObjectIsType(o, stObject) then\n begin\n j := TSuperAvlIterator.Create(o.AsObject);\n try\n j.First;\n e := j.GetIter;\n while e <> nil do\n begin\n if obj.AsObject.Search(e.Name) = nil then\n begin\n Result := False;\n if assigned(callback) then\n callback(sender, veFieldNotFound, name + '.' + e.Name);\n end;\n j.Next;\n e := j.GetIter;\n end;\n\n finally\n j.Free;\n end;\n end;\n\n o := p['inherit'];\n if ObjectIsType(o, stString) then\n begin\n e := names.AsObject.Search(o.AsString);\n if (e <> nil) then\n Result := InheritedFieldExist(obj, e.Value, name) and Result;\n end;\n end;\n\n function getInheritedBool(f: PSOChar; p: ISuperObject; default: boolean = false): boolean;\n var\n o: ISuperObject;\n begin\n o := FindInheritedProperty(f, p);\n case ObjectGetType(o) of\n stBoolean: Result := o.AsBoolean;\n stNull: Result := Default;\n else\n Result := default;\n if assigned(callback) then\n callback(sender, veRuleMalformated, f);\n end;\n end;\n\n procedure GetInheritedFieldList(list: ISuperObject; p: ISuperObject);\n var\n o: ISuperObject;\n e: TSuperAvlEntry;\n i: TSuperAvlIterator;\n begin\n Result := true;\n o := p['mapping'];\n if ObjectIsType(o, stObject) then\n begin\n i := TSuperAvlIterator.Create(o.AsObject);\n try\n i.First;\n e := i.GetIter;\n while e <> nil do\n begin\n if list.AsObject.Search(e.Name) = nil then\n list[e.Name] := e.Value;\n i.Next;\n e := i.GetIter;\n end;\n\n finally\n i.Free;\n end;\n end;\n\n o := p['inherit'];\n if ObjectIsType(o, stString) then\n begin\n e := names.AsObject.Search(o.AsString);\n if (e <> nil) then\n GetInheritedFieldList(list, e.Value);\n end;\n end;\n\n function CheckEnum(o: ISuperObject; p: ISuperObject; name: SOString = ''): boolean;\n var\n enum: ISuperObject;\n i: integer;\n begin\n Result := false;\n enum := FindInheritedProperty('enum', p);\n case ObjectGetType(enum) of\n stArray:\n for i := 0 to enum.AsArray.Length - 1 do\n if (o.AsString = enum.AsArray[i].AsString) then\n begin\n Result := true;\n exit;\n end;\n stNull: Result := true;\n else\n Result := false;\n if assigned(callback) then\n callback(sender, veRuleMalformated, '');\n Exit;\n end;\n\n if (not Result) and assigned(callback) then\n callback(sender, veValueNotInEnum, name);\n end;\n\n function CheckLength(len: integer; p: ISuperObject; const objpath: SOString): boolean;\n var\n length, o: ISuperObject;\n begin\n result := true;\n length := FindInheritedProperty('length', p);\n case ObjectGetType(length) of\n stObject:\n begin\n o := length.AsObject.GetO('min');\n if (o <> nil) and (o.AsInteger > len) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidLength, objpath);\n end;\n o := length.AsObject.GetO('max');\n if (o <> nil) and (o.AsInteger < len) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidLength, objpath);\n end;\n o := length.AsObject.GetO('minex');\n if (o <> nil) and (o.AsInteger >= len) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidLength, objpath);\n end;\n o := length.AsObject.GetO('maxex');\n if (o <> nil) and (o.AsInteger <= len) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidLength, objpath);\n end;\n end;\n stNull: ;\n else\n Result := false;\n if assigned(callback) then\n callback(sender, veRuleMalformated, '');\n end;\n end;\n\n function CheckRange(obj: ISuperObject; p: ISuperObject; const objpath: SOString): boolean;\n var\n length, o: ISuperObject;\n begin\n result := true;\n length := FindInheritedProperty('range', p);\n case ObjectGetType(length) of\n stObject:\n begin\n o := length.AsObject.GetO('min');\n if (o <> nil) and (o.Compare(obj) = cpGreat) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidRange, objpath);\n end;\n o := length.AsObject.GetO('max');\n if (o <> nil) and (o.Compare(obj) = cpLess) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidRange, objpath);\n end;\n o := length.AsObject.GetO('minex');\n if (o <> nil) and (o.Compare(obj) in [cpGreat, cpEqu]) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidRange, objpath);\n end;\n o := length.AsObject.GetO('maxex');\n if (o <> nil) and (o.Compare(obj) in [cpLess, cpEqu]) then\n begin\n Result := false;\n if assigned(callback) then\n callback(sender, veInvalidRange, objpath);\n end;\n end;\n stNull: ;\n else\n Result := false;\n if assigned(callback) then\n callback(sender, veRuleMalformated, '');\n end;\n end;\n\n\n function process(o: ISuperObject; p: ISuperObject; objpath: SOString = ''): boolean;\n var\n ite: TSuperAvlIterator;\n ent: TSuperAvlEntry;\n p2, o2, sequence: ISuperObject;\n s: SOString;\n i: integer;\n uniquelist, fieldlist: ISuperObject;\n begin\n Result := true;\n if (o = nil) then\n begin\n if getInheritedBool('required', p) then\n begin\n if assigned(callback) then\n callback(sender, veFieldIsRequired, objpath);\n result := false;\n end;\n end else\n case FindDataType(p) of\n dtStr:\n case ObjectGetType(o) of\n stString:\n begin\n Result := Result and CheckLength(Length(o.AsString), p, objpath);\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtBool:\n case ObjectGetType(o) of\n stBoolean:\n begin\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtInt:\n case ObjectGetType(o) of\n stInt:\n begin\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtFloat:\n case ObjectGetType(o) of\n stDouble, stCurrency:\n begin\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtMap:\n case ObjectGetType(o) of\n stObject:\n begin\n // all objects have and match a rule ?\n ite := TSuperAvlIterator.Create(o.AsObject);\n try\n ite.First;\n ent := ite.GetIter;\n while ent <> nil do\n begin\n p2 := FindInheritedField(ent.Name, p);\n if ObjectIsType(p2, stObject) then\n result := process(ent.Value, p2, objpath + '.' + ent.Name) and result else\n begin\n if assigned(callback) then\n callback(sender, veUnexpectedField, objpath + '.' + ent.Name);\n result := false; // field have no rule\n end;\n ite.Next;\n ent := ite.GetIter;\n end;\n finally\n ite.Free;\n end;\n\n // all expected field exists ?\n Result := InheritedFieldExist(o, p, objpath) and Result;\n end;\n stNull: {nop};\n else\n result := false;\n if assigned(callback) then\n callback(sender, veRuleMalformated, objpath);\n end;\n dtSeq:\n case ObjectGetType(o) of\n stArray:\n begin\n sequence := FindInheritedProperty('sequence', p);\n if sequence <> nil then\n case ObjectGetType(sequence) of\n stObject:\n begin\n for i := 0 to o.AsArray.Length - 1 do\n result := process(o.AsArray.GetO(i), sequence, objpath + '[' + IntToStr(i) + ']') and result;\n if getInheritedBool('unique', sequence) then\n begin\n // type is unique ?\n uniquelist := TSuperObject.Create(stObject);\n try\n for i := 0 to o.AsArray.Length - 1 do\n begin\n s := o.AsArray.GetO(i).AsString;\n if (s <> '') then\n begin\n if uniquelist.AsObject.Search(s) = nil then\n uniquelist[s] := nil else\n begin\n Result := False;\n if Assigned(callback) then\n callback(sender, veDuplicateEntry, objpath + '[' + IntToStr(i) + ']');\n end;\n end;\n end;\n finally\n uniquelist := nil;\n end;\n end;\n\n // field is unique ?\n if (FindDataType(sequence) = dtMap) then\n begin\n fieldlist := TSuperObject.Create(stObject);\n try\n GetInheritedFieldList(fieldlist, sequence);\n ite := TSuperAvlIterator.Create(fieldlist.AsObject);\n try\n ite.First;\n ent := ite.GetIter;\n while ent <> nil do\n begin\n if getInheritedBool('unique', ent.Value) then\n begin\n uniquelist := TSuperObject.Create(stObject);\n try\n for i := 0 to o.AsArray.Length - 1 do\n begin\n o2 := o.AsArray.GetO(i);\n if o2 <> nil then\n begin\n s := o2.AsObject.GetO(ent.Name).AsString;\n if (s <> '') then\n if uniquelist.AsObject.Search(s) = nil then\n uniquelist[s] := nil else\n begin\n Result := False;\n if Assigned(callback) then\n callback(sender, veDuplicateEntry, objpath + '[' + IntToStr(i) + '].' + ent.name);\n end;\n end;\n end;\n finally\n uniquelist := nil;\n end;\n end;\n ite.Next;\n ent := ite.GetIter;\n end;\n finally\n ite.Free;\n end;\n finally\n fieldlist := nil;\n end;\n end;\n\n\n end;\n stNull: {nop};\n else\n result := false;\n if assigned(callback) then\n callback(sender, veRuleMalformated, objpath);\n end;\n Result := Result and CheckLength(o.AsArray.Length, p, objpath);\n\n end;\n else\n result := false;\n if assigned(callback) then\n callback(sender, veRuleMalformated, objpath);\n end;\n dtNumber:\n case ObjectGetType(o) of\n stInt,\n stDouble, stCurrency:\n begin\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtText:\n case ObjectGetType(o) of\n stInt,\n stDouble,\n stCurrency,\n stString:\n begin\n result := result and CheckLength(Length(o.AsString), p, objpath);\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtScalar:\n case ObjectGetType(o) of\n stBoolean,\n stDouble,\n stCurrency,\n stInt,\n stString:\n begin\n result := result and CheckLength(Length(o.AsString), p, objpath);\n Result := Result and CheckRange(o, p, objpath);\n end;\n else\n if assigned(callback) then\n callback(sender, veInvalidDataType, objpath);\n result := false;\n end;\n dtAny:;\n else\n if assigned(callback) then\n callback(sender, veRuleMalformated, objpath);\n result := false;\n end;\n Result := Result and CheckEnum(o, p, objpath)\n\n end;\nvar\n j: integer;\n\nbegin\n Result := False;\n datatypes := TSuperObject.Create(stObject);\n names := TSuperObject.Create;\n try\n datatypes.I['str'] := ord(dtStr);\n datatypes.I['int'] := ord(dtInt);\n datatypes.I['float'] := ord(dtFloat);\n datatypes.I['number'] := ord(dtNumber);\n datatypes.I['text'] := ord(dtText);\n datatypes.I['bool'] := ord(dtBool);\n datatypes.I['map'] := ord(dtMap);\n datatypes.I['seq'] := ord(dtSeq);\n datatypes.I['scalar'] := ord(dtScalar);\n datatypes.I['any'] := ord(dtAny);\n\n if ObjectIsType(defs, stArray) then\n for j := 0 to defs.AsArray.Length - 1 do\n if ObjectIsType(defs.AsArray[j], stObject) then\n GetNames(defs.AsArray[j]) else\n begin\n if assigned(callback) then\n callback(sender, veRuleMalformated, '');\n Exit;\n end;\n\n\n if ObjectIsType(rules, stObject) then\n GetNames(rules) else\n begin\n if assigned(callback) then\n callback(sender, veRuleMalformated, '');\n Exit;\n end;\n\n Result := process(self, rules);\n\n finally\n datatypes := nil;\n names := nil;\n end;\nend;\n\nfunction TSuperObject._AddRef: Integer; stdcall;\nbegin\n Result := InterlockedIncrement(FRefCount);\nend;\n\nfunction TSuperObject._Release: Integer; stdcall;\nbegin\n Result := InterlockedDecrement(FRefCount);\n if Result = 0 then\n Destroy;\nend;\n\nfunction TSuperObject.Compare(const str: SOString): TSuperCompareResult;\nbegin\n Result := Compare(TSuperObject.ParseString(PSOChar(str), False));\nend;\n\nfunction TSuperObject.Compare(const obj: ISuperObject): TSuperCompareResult;\n function GetIntCompResult(const i: int64): TSuperCompareResult;\n begin\n if i < 0 then result := cpLess else\n if i = 0 then result := cpEqu else\n Result := cpGreat;\n end;\n\n function GetDblCompResult(const d: double): TSuperCompareResult;\n begin\n if d < 0 then result := cpLess else\n if d = 0 then result := cpEqu else\n Result := cpGreat;\n end;\n\nbegin\n case DataType of\n stBoolean:\n case ObjectGetType(obj) of\n stBoolean: Result := GetIntCompResult(ord(FO.c_boolean) - ord(obj.AsBoolean));\n stDouble: Result := GetDblCompResult(ord(FO.c_boolean) - obj.AsDouble);\n stCurrency:Result := GetDblCompResult(ord(FO.c_boolean) - obj.AsCurrency);\n stInt: Result := GetIntCompResult(ord(FO.c_boolean) - obj.AsInteger);\n stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));\n else\n Result := cpError;\n end;\n stDouble:\n case ObjectGetType(obj) of\n stBoolean: Result := GetDblCompResult(FO.c_double - ord(obj.AsBoolean));\n stDouble: Result := GetDblCompResult(FO.c_double - obj.AsDouble);\n stCurrency:Result := GetDblCompResult(FO.c_double - obj.AsCurrency);\n stInt: Result := GetDblCompResult(FO.c_double - obj.AsInteger);\n stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));\n else\n Result := cpError;\n end;\n stCurrency:\n case ObjectGetType(obj) of\n stBoolean: Result := GetDblCompResult(FO.c_currency - ord(obj.AsBoolean));\n stDouble: Result := GetDblCompResult(FO.c_currency - obj.AsDouble);\n stCurrency:Result := GetDblCompResult(FO.c_currency - obj.AsCurrency);\n stInt: Result := GetDblCompResult(FO.c_currency - obj.AsInteger);\n stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));\n else\n Result := cpError;\n end;\n stInt:\n case ObjectGetType(obj) of\n stBoolean: Result := GetIntCompResult(FO.c_int - ord(obj.AsBoolean));\n stDouble: Result := GetDblCompResult(FO.c_int - obj.AsDouble);\n stCurrency:Result := GetDblCompResult(FO.c_int - obj.AsCurrency);\n stInt: Result := GetIntCompResult(FO.c_int - obj.AsInteger);\n stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));\n else\n Result := cpError;\n end;\n stString:\n case ObjectGetType(obj) of\n stBoolean,\n stDouble,\n stCurrency,\n stInt,\n stString: Result := GetIntCompResult(StrComp(PSOChar(AsString), PSOChar(obj.AsString)));\n else\n Result := cpError;\n end;\n else\n Result := cpError;\n end;\nend;\n\n{$IFDEF SUPER_METHOD}\nfunction TSuperObject.AsMethod: TSuperMethod;\nbegin\n if FDataType = stMethod then\n Result := FO.c_method else\n Result := nil;\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nconstructor TSuperObject.Create(m: TSuperMethod);\nbegin\n Create(stMethod);\n FO.c_method := m;\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nfunction TSuperObject.GetM(const path: SOString): TSuperMethod;\nvar\n v: ISuperObject;\nbegin\n v := ParseString(PSOChar(path), False, True, Self);\n if (v <> nil) and (ObjectGetType(v) = stMethod) then\n Result := v.AsMethod else\n Result := nil;\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nprocedure TSuperObject.PutM(const path: SOString; Value: TSuperMethod);\nbegin\n ParseString(PSOChar(path), False, True, Self, [foCreatePath, foPutValue], TSuperObject.Create(Value));\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nfunction TSuperObject.call(const path: SOString; const param: ISuperObject): ISuperObject;\nbegin\n Result := ParseString(PSOChar(path), False, True, Self, [foCallMethod], param);\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nfunction TSuperObject.call(const path, param: SOString): ISuperObject;\nbegin\n Result := ParseString(PSOChar(path), False, True, Self, [foCallMethod], TSuperObject.ParseString(PSOChar(param), False));\nend;\n{$ENDIF}\n\nfunction TSuperObject.GetProcessing: boolean;\nbegin\n Result := FProcessing;\nend;\n\nprocedure TSuperObject.SetDataPtr(const Value: Pointer);\nbegin\n FDataPtr := Value;\nend;\n\nprocedure TSuperObject.SetProcessing(value: boolean);\nbegin\n FProcessing := value;\nend;\n\n{ TSuperArray }\n\nfunction TSuperArray.Add(const Data: ISuperObject): Integer;\nbegin\n Result := FLength;\n PutO(Result, data);\nend;\n\nfunction TSuperArray.Delete(index: Integer): ISuperObject;\nbegin\n if (Index >= 0) and (Index < FLength) then\n begin\n Result := FArray^[index];\n FArray^[index] := nil;\n Dec(FLength);\n if Index < FLength then\n begin\n Move(FArray^[index + 1], FArray^[index],\n (FLength - index) * SizeOf(Pointer));\n Pointer(FArray^[FLength]) := nil;\n end;\n end;\nend;\n\nprocedure TSuperArray.Insert(index: Integer; const value: ISuperObject);\nbegin\n if (Index >= 0) then\n if (index < FLength) then\n begin\n if FLength = FSize then\n Expand(index);\n if Index < FLength then\n Move(FArray^[index], FArray^[index + 1],\n (FLength - index) * SizeOf(Pointer));\n Pointer(FArray^[index]) := nil;\n FArray^[index] := value;\n Inc(FLength);\n end else\n PutO(index, value);\nend;\n\nprocedure TSuperArray.Clear(all: boolean);\nvar\n j: Integer;\nbegin\n for j := 0 to FLength - 1 do\n if FArray^[j] <> nil then\n begin\n if all then\n FArray^[j].Clear(all);\n FArray^[j] := nil;\n end;\n FLength := 0;\nend;\n\nprocedure TSuperArray.Pack(all: boolean);\nvar\n PackedCount, StartIndex, EndIndex, j: Integer;\nbegin\n if FLength > 0 then\n begin\n PackedCount := 0;\n StartIndex := 0;\n repeat\n while (StartIndex < FLength) and (FArray^[StartIndex] = nil) do\n Inc(StartIndex);\n if StartIndex < FLength then\n begin\n EndIndex := StartIndex;\n while (EndIndex < FLength) and (FArray^[EndIndex] <> nil) do\n Inc(EndIndex);\n\n Dec(EndIndex);\n\n if StartIndex > PackedCount then\n Move(FArray^[StartIndex], FArray^[PackedCount], (EndIndex - StartIndex + 1) * SizeOf(Pointer));\n\n Inc(PackedCount, EndIndex - StartIndex + 1);\n StartIndex := EndIndex + 1;\n end;\n until StartIndex >= FLength;\n FillChar(FArray^[PackedCount], (FLength - PackedCount) * sizeof(Pointer), 0);\n FLength := PackedCount;\n if all then\n for j := 0 to FLength - 1 do\n FArray^[j].Pack(all);\n end;\nend;\n\nconstructor TSuperArray.Create;\nbegin\n inherited Create;\n FSize := SUPER_ARRAY_LIST_DEFAULT_SIZE;\n FLength := 0;\n GetMem(FArray, sizeof(Pointer) * FSize);\n FillChar(FArray^, sizeof(Pointer) * FSize, 0);\nend;\n\ndestructor TSuperArray.Destroy;\nbegin\n Clear;\n FreeMem(FArray);\n inherited;\nend;\n\nprocedure TSuperArray.Expand(max: Integer);\nvar\n new_size: Integer;\nbegin\n if (max < FSize) then\n Exit;\n if max < (FSize shl 1) then\n new_size := (FSize shl 1) else\n new_size := max + 1;\n ReallocMem(FArray, new_size * sizeof(Pointer));\n FillChar(FArray^[FSize], (new_size - FSize) * sizeof(Pointer), 0);\n FSize := new_size;\nend;\n\nfunction TSuperArray.GetO(const index: Integer): ISuperObject;\nbegin\n if(index >= FLength) then\n Result := nil else\n Result := FArray^[index];\nend;\n\nfunction TSuperArray.GetB(const index: integer): Boolean;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(index);\n if obj <> nil then\n Result := obj.AsBoolean else\n Result := false;\nend;\n\nfunction TSuperArray.GetD(const index: integer): Double;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(index);\n if obj <> nil then\n Result := obj.AsDouble else\n Result := 0.0;\nend;\n\nfunction TSuperArray.GetI(const index: integer): SuperInt;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(index);\n if obj <> nil then\n Result := obj.AsInteger else\n Result := 0;\nend;\n\nfunction TSuperArray.GetS(const index: integer): SOString;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(index);\n if obj <> nil then\n Result := obj.AsString else\n Result := '';\nend;\n\nprocedure TSuperArray.PutO(const index: Integer; const Value: ISuperObject);\nbegin\n Expand(index);\n FArray^[index] := value;\n if(FLength <= index) then FLength := index + 1;\nend;\n\nfunction TSuperArray.GetN(const index: integer): ISuperObject;\nbegin\n Result := GetO(index);\n if Result = nil then\n Result := TSuperObject.Create(stNull);\nend;\n\nprocedure TSuperArray.PutN(const index: integer; const Value: ISuperObject);\nbegin\n if Value <> nil then\n PutO(index, Value) else\n PutO(index, TSuperObject.Create(stNull));\nend;\n\nprocedure TSuperArray.PutB(const index: integer; Value: Boolean);\nbegin\n PutO(index, TSuperObject.Create(Value));\nend;\n\nprocedure TSuperArray.PutD(const index: integer; Value: Double);\nbegin\n PutO(index, TSuperObject.Create(Value));\nend;\n\nfunction TSuperArray.GetC(const index: integer): Currency;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(index);\n if obj <> nil then\n Result := obj.AsCurrency else\n Result := 0.0;\nend;\n\nprocedure TSuperArray.PutC(const index: integer; Value: Currency);\nbegin\n PutO(index, TSuperObject.CreateCurrency(Value));\nend;\n\nprocedure TSuperArray.PutI(const index: integer; Value: SuperInt);\nbegin\n PutO(index, TSuperObject.Create(Value));\nend;\n\nprocedure TSuperArray.PutS(const index: integer; const Value: SOString);\nbegin\n PutO(index, TSuperObject.Create(Value));\nend;\n\n{$IFDEF SUPER_METHOD}\nfunction TSuperArray.GetM(const index: integer): TSuperMethod;\nvar\n v: ISuperObject;\nbegin\n v := GetO(index);\n if (ObjectGetType(v) = stMethod) then\n Result := v.AsMethod else\n Result := nil;\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nprocedure TSuperArray.PutM(const index: integer; Value: TSuperMethod);\nbegin\n PutO(index, TSuperObject.Create(Value));\nend;\n{$ENDIF}\n\n{ TSuperWriterString }\n\nfunction TSuperWriterString.Append(buf: PSOChar; Size: Integer): Integer;\n function max(a, b: Integer): integer; begin if a > b then Result := a else Result := b end;\nbegin\n Result := size;\n if Size > 0 then\n begin\n if (FSize - FBPos <= size) then\n begin\n FSize := max(FSize * 2, FBPos + size + 8);\n ReallocMem(FBuf, FSize * SizeOf(SOChar));\n end;\n // fast move\n case size of\n 1: FBuf[FBPos] := buf^;\n 2: PInteger(@FBuf[FBPos])^ := PInteger(buf)^;\n 4: PInt64(@FBuf[FBPos])^ := PInt64(buf)^;\n else\n move(buf^, FBuf[FBPos], size * SizeOf(SOChar));\n end;\n inc(FBPos, size);\n FBuf[FBPos] := #0;\n end;\nend;\n\nfunction TSuperWriterString.Append(buf: PSOChar): Integer;\nbegin\n Result := Append(buf, strlen(buf));\nend;\n\nconstructor TSuperWriterString.Create;\nbegin\n inherited;\n FSize := 32;\n FBPos := 0;\n GetMem(FBuf, FSize * SizeOf(SOChar));\nend;\n\ndestructor TSuperWriterString.Destroy;\nbegin\n inherited;\n if FBuf <> nil then\n FreeMem(FBuf)\nend;\n\nfunction TSuperWriterString.GetString: SOString;\nbegin\n SetString(Result, FBuf, FBPos);\nend;\n\nprocedure TSuperWriterString.Reset;\nbegin\n FBuf[0] := #0;\n FBPos := 0;\nend;\n\nprocedure TSuperWriterString.TrimRight;\nbegin\n while (FBPos > 0) and (FBuf[FBPos-1] < #256) and (AnsiChar(FBuf[FBPos-1]) in [#32, #13, #10]) do\n begin\n dec(FBPos);\n FBuf[FBPos] := #0;\n end;\nend;\n\n{ TSuperWriterStream }\n\nfunction TSuperWriterStream.Append(buf: PSOChar): Integer;\nbegin\n Result := Append(buf, StrLen(buf));\nend;\n\nconstructor TSuperWriterStream.Create(AStream: TStream);\nbegin\n inherited Create;\n FStream := AStream;\nend;\n\nprocedure TSuperWriterStream.Reset;\nbegin\n FStream.Size := 0;\nend;\n\n{ TSuperWriterStream }\n\nfunction TSuperAnsiWriterStream.Append(buf: PSOChar; Size: Integer): Integer;\nvar\n Buffer: array[0..1023] of AnsiChar;\n pBuffer: PAnsiChar;\n i: Integer;\nbegin\n if Size = 1 then\n Result := FStream.Write(buf^, Size) else\n begin\n if Size > SizeOf(Buffer) then\n GetMem(pBuffer, Size) else\n pBuffer := @Buffer;\n try\n for i := 0 to Size - 1 do\n pBuffer[i] := AnsiChar(buf[i]);\n Result := FStream.Write(pBuffer^, Size);\n finally\n if pBuffer <> @Buffer then\n FreeMem(pBuffer);\n end;\n end;\nend;\n\n{ TSuperUnicodeWriterStream }\n\nfunction TSuperUnicodeWriterStream.Append(buf: PSOChar; Size: Integer): Integer;\nbegin\n Result := FStream.Write(buf^, Size * 2);\nend;\n\n{ TSuperWriterFake }\n\nfunction TSuperWriterFake.Append(buf: PSOChar; Size: Integer): Integer;\nbegin\n inc(FSize, Size);\n Result := FSize;\nend;\n\nfunction TSuperWriterFake.Append(buf: PSOChar): Integer;\nbegin\n inc(FSize, Strlen(buf));\n Result := FSize;\nend;\n\nconstructor TSuperWriterFake.Create;\nbegin\n inherited Create;\n FSize := 0;\nend;\n\nprocedure TSuperWriterFake.Reset;\nbegin\n FSize := 0;\nend;\n\n{ TSuperWriterSock }\n\nfunction TSuperWriterSock.Append(buf: PSOChar; Size: Integer): Integer;\nvar\n Buffer: array[0..1023] of AnsiChar;\n pBuffer: PAnsiChar;\n i: Integer;\nbegin\n if Size = 1 then\n{$IFDEF FPC}\n Result := fpsend(FSocket, buf, size, 0) else\n{$ELSE}\n Result := send(FSocket, buf^, size, 0) else\n{$ENDIF}\n begin\n if Size > SizeOf(Buffer) then\n GetMem(pBuffer, Size) else\n pBuffer := @Buffer;\n try\n for i := 0 to Size - 1 do\n pBuffer[i] := AnsiChar(buf[i]);\n{$IFDEF FPC}\n Result := fpsend(FSocket, pBuffer, size, 0);\n{$ELSE}\n Result := send(FSocket, pBuffer^, size, 0);\n{$ENDIF}\n finally\n if pBuffer <> @Buffer then\n FreeMem(pBuffer);\n end;\n end;\n inc(FSize, Result);\nend;\n\nfunction TSuperWriterSock.Append(buf: PSOChar): Integer;\nbegin\n Result := Append(buf, StrLen(buf));\nend;\n\nconstructor TSuperWriterSock.Create(ASocket: Integer);\nbegin\n inherited Create;\n FSocket := ASocket;\n FSize := 0;\nend;\n\nprocedure TSuperWriterSock.Reset;\nbegin\n FSize := 0;\nend;\n\n{ TSuperTokenizer }\n\nconstructor TSuperTokenizer.Create;\nbegin\n pb := TSuperWriterString.Create;\n line := 1;\n col := 0;\n Reset;\nend;\n\ndestructor TSuperTokenizer.Destroy;\nbegin\n Reset;\n pb.Free;\n inherited;\nend;\n\nprocedure TSuperTokenizer.Reset;\nvar\n i: integer;\nbegin\n for i := depth downto 0 do\n ResetLevel(i);\n depth := 0;\n err := teSuccess;\nend;\n\nprocedure TSuperTokenizer.ResetLevel(adepth: integer);\nbegin\n stack[adepth].state := tsEatws;\n stack[adepth].saved_state := tsStart;\n stack[adepth].current := nil;\n stack[adepth].field_name := '';\n stack[adepth].obj := nil;\n stack[adepth].parent := nil;\n stack[adepth].gparent := nil;\nend;\n\n{ TSuperAvlTree }\n\nconstructor TSuperAvlTree.Create;\nbegin\n FRoot := nil;\n FCount := 0;\nend;\n\ndestructor TSuperAvlTree.Destroy;\nbegin\n Clear;\n inherited;\nend;\n\nfunction TSuperAvlTree.IsEmpty: boolean;\nbegin\n result := FRoot = nil;\nend;\n\nfunction TSuperAvlTree.balance(bal: TSuperAvlEntry): TSuperAvlEntry;\nvar\n deep, old: TSuperAvlEntry;\n bf: integer;\nbegin\n if (bal.FBf > 0) then\n begin\n deep := bal.FGt;\n if (deep.FBf < 0) then\n begin\n old := bal;\n bal := deep.FLt;\n old.FGt := bal.FLt;\n deep.FLt := bal.FGt;\n bal.FLt := old;\n bal.FGt := deep;\n bf := bal.FBf;\n if (bf <> 0) then\n begin\n if (bf > 0) then\n begin\n old.FBf := -1;\n deep.FBf := 0;\n end else\n begin\n deep.FBf := 1;\n old.FBf := 0;\n end;\n bal.FBf := 0;\n end else\n begin\n old.FBf := 0;\n deep.FBf := 0;\n end;\n end else\n begin\n bal.FGt := deep.FLt;\n deep.FLt := bal;\n if (deep.FBf = 0) then\n begin\n deep.FBf := -1;\n bal.FBf := 1;\n end else\n begin\n deep.FBf := 0;\n bal.FBf := 0;\n end;\n bal := deep;\n end;\n end else\n begin\n (* \"Less than\" subtree is deeper. *)\n\n deep := bal.FLt;\n if (deep.FBf > 0) then\n begin\n old := bal;\n bal := deep.FGt;\n old.FLt := bal.FGt;\n deep.FGt := bal.FLt;\n bal.FGt := old;\n bal.FLt := deep;\n\n bf := bal.FBf;\n if (bf <> 0) then\n begin\n if (bf < 0) then\n begin\n old.FBf := 1;\n deep.FBf := 0;\n end else\n begin\n deep.FBf := -1;\n old.FBf := 0;\n end;\n bal.FBf := 0;\n end else\n begin\n old.FBf := 0;\n deep.FBf := 0;\n end;\n end else\n begin\n bal.FLt := deep.FGt;\n deep.FGt := bal;\n if (deep.FBf = 0) then\n begin\n deep.FBf := 1;\n bal.FBf := -1;\n end else\n begin\n deep.FBf := 0;\n bal.FBf := 0;\n end;\n bal := deep;\n end;\n end;\n Result := bal;\nend;\n\nfunction TSuperAvlTree.Insert(h: TSuperAvlEntry): TSuperAvlEntry;\nvar\n unbal, parentunbal, hh, parent: TSuperAvlEntry;\n depth, unbaldepth: longint;\n cmp: integer;\n unbalbf: integer;\n branch: TSuperAvlBitArray;\n p: Pointer;\nbegin\n inc(FCount);\n h.FLt := nil;\n h.FGt := nil;\n h.FBf := 0;\n branch := [];\n\n if (FRoot = nil) then\n FRoot := h\n else\n begin\n unbal := nil;\n parentunbal := nil;\n depth := 0;\n unbaldepth := 0;\n hh := FRoot;\n parent := nil;\n repeat\n if (hh.FBf <> 0) then\n begin\n unbal := hh;\n parentunbal := parent;\n unbaldepth := depth;\n end;\n if hh.FHash <> h.FHash then\n begin\n if hh.FHash < h.FHash then cmp := -1 else\n if hh.FHash > h.FHash then cmp := 1 else\n cmp := 0;\n end else\n cmp := CompareNodeNode(h, hh);\n if (cmp = 0) then\n begin\n Result := hh;\n //exchange data\n p := hh.Ptr;\n hh.FPtr := h.Ptr;\n h.FPtr := p;\n doDeleteEntry(h, false);\n dec(FCount);\n exit;\n end;\n parent := hh;\n if (cmp > 0) then\n begin\n hh := hh.FGt;\n include(branch, depth);\n end else\n begin\n hh := hh.FLt;\n exclude(branch, depth);\n end;\n inc(depth);\n until (hh = nil);\n\n if (cmp < 0) then\n parent.FLt := h else\n parent.FGt := h;\n\n depth := unbaldepth;\n\n if (unbal = nil) then\n hh := FRoot\n else\n begin\n if depth in branch then\n cmp := 1 else\n cmp := -1;\n inc(depth);\n unbalbf := unbal.FBf;\n if (cmp < 0) then\n dec(unbalbf) else\n inc(unbalbf);\n if cmp < 0 then\n hh := unbal.FLt else\n hh := unbal.FGt;\n if ((unbalbf <> -2) and (unbalbf <> 2)) then\n begin\n unbal.FBf := unbalbf;\n unbal := nil;\n end;\n end;\n\n if (hh <> nil) then\n while (h <> hh) do\n begin\n if depth in branch then\n cmp := 1 else\n cmp := -1;\n inc(depth);\n if (cmp < 0) then\n begin\n hh.FBf := -1;\n hh := hh.FLt;\n end else (* cmp > 0 *)\n begin\n hh.FBf := 1;\n hh := hh.FGt;\n end;\n end;\n\n if (unbal <> nil) then\n begin\n unbal := balance(unbal);\n if (parentunbal = nil) then\n FRoot := unbal\n else\n begin\n depth := unbaldepth - 1;\n if depth in branch then\n cmp := 1 else\n cmp := -1;\n if (cmp < 0) then\n parentunbal.FLt := unbal else\n parentunbal.FGt := unbal;\n end;\n end;\n end;\n result := h;\nend;\n\nfunction TSuperAvlTree.Search(const k: SOString; st: TSuperAvlSearchTypes): TSuperAvlEntry;\nvar\n cmp, target_cmp: integer;\n match_h, h: TSuperAvlEntry;\n ha: Cardinal;\nbegin\n ha := TSuperAvlEntry.Hash(k);\n\n match_h := nil;\n h := FRoot;\n\n if (stLess in st) then\n target_cmp := 1 else\n if (stGreater in st) then\n target_cmp := -1 else\n target_cmp := 0;\n\n while (h <> nil) do\n begin\n if h.FHash < ha then cmp := -1 else\n if h.FHash > ha then cmp := 1 else\n cmp := 0;\n\n if cmp = 0 then\n cmp := CompareKeyNode(PSOChar(k), h);\n if (cmp = 0) then\n begin\n if (stEqual in st) then\n begin\n match_h := h;\n break;\n end;\n cmp := -target_cmp;\n end\n else\n if (target_cmp <> 0) then\n if ((cmp xor target_cmp) and SUPER_AVL_MASK_HIGH_BIT) = 0 then\n match_h := h;\n if cmp < 0 then\n h := h.FLt else\n h := h.FGt;\n end;\n result := match_h;\nend;\n\nfunction TSuperAvlTree.Delete(const k: SOString): ISuperObject;\nvar\n depth, rm_depth: longint;\n branch: TSuperAvlBitArray;\n h, parent, child, path, rm, parent_rm: TSuperAvlEntry;\n cmp, cmp_shortened_sub_with_path, reduced_depth, bf: integer;\n ha: Cardinal;\nbegin\n ha := TSuperAvlEntry.Hash(k);\n cmp_shortened_sub_with_path := 0;\n branch := [];\n\n depth := 0;\n h := FRoot;\n parent := nil;\n while true do\n begin\n if (h = nil) then\n exit;\n if h.FHash < ha then cmp := -1 else\n if h.FHash > ha then cmp := 1 else\n cmp := 0;\n\n if cmp = 0 then\n cmp := CompareKeyNode(k, h);\n if (cmp = 0) then\n break;\n parent := h;\n if (cmp > 0) then\n begin\n h := h.FGt;\n include(branch, depth)\n end else\n begin\n h := h.FLt;\n exclude(branch, depth)\n end;\n inc(depth);\n cmp_shortened_sub_with_path := cmp;\n end;\n rm := h;\n parent_rm := parent;\n rm_depth := depth;\n\n if (h.FBf < 0) then\n begin\n child := h.FLt;\n exclude(branch, depth);\n cmp := -1;\n end else\n begin\n child := h.FGt;\n include(branch, depth);\n cmp := 1;\n end;\n inc(depth);\n\n if (child <> nil) then\n begin\n cmp := -cmp;\n repeat\n parent := h;\n h := child;\n if (cmp < 0) then\n begin\n child := h.FLt;\n exclude(branch, depth);\n end else\n begin\n child := h.FGt;\n include(branch, depth);\n end;\n inc(depth);\n until (child = nil);\n\n if (parent = rm) then\n cmp_shortened_sub_with_path := -cmp else\n cmp_shortened_sub_with_path := cmp;\n\n if cmp > 0 then\n child := h.FLt else\n child := h.FGt;\n end;\n\n if (parent = nil) then\n FRoot := child else\n if (cmp_shortened_sub_with_path < 0) then\n parent.FLt := child else\n parent.FGt := child;\n\n if parent = rm then\n path := h else\n path := parent;\n\n if (h <> rm) then\n begin\n h.FLt := rm.FLt;\n h.FGt := rm.FGt;\n h.FBf := rm.FBf;\n if (parent_rm = nil) then\n FRoot := h\n else\n begin\n depth := rm_depth - 1;\n if (depth in branch) then\n parent_rm.FGt := h else\n parent_rm.FLt := h;\n end;\n end;\n\n if (path <> nil) then\n begin\n h := FRoot;\n parent := nil;\n depth := 0;\n while (h <> path) do\n begin\n if (depth in branch) then\n begin\n child := h.FGt;\n h.FGt := parent;\n end else\n begin\n child := h.FLt;\n h.FLt := parent;\n end;\n inc(depth);\n parent := h;\n h := child;\n end;\n\n reduced_depth := 1;\n cmp := cmp_shortened_sub_with_path;\n while true do\n begin\n if (reduced_depth <> 0) then\n begin\n bf := h.FBf;\n if (cmp < 0) then\n inc(bf) else\n dec(bf);\n if ((bf = -2) or (bf = 2)) then\n begin\n h := balance(h);\n bf := h.FBf;\n end else\n h.FBf := bf;\n reduced_depth := integer(bf = 0);\n end;\n if (parent = nil) then\n break;\n child := h;\n h := parent;\n dec(depth);\n if depth in branch then\n cmp := 1 else\n cmp := -1;\n if (cmp < 0) then\n begin\n parent := h.FLt;\n h.FLt := child;\n end else\n begin\n parent := h.FGt;\n h.FGt := child;\n end;\n end;\n FRoot := h;\n end;\n if rm <> nil then\n begin\n Result := rm.GetValue;\n doDeleteEntry(rm, false);\n dec(FCount);\n end;\nend;\n\nprocedure TSuperAvlTree.Pack(all: boolean);\nvar\n node1, node2: TSuperAvlEntry;\n list: TList;\n i: Integer;\nbegin\n node1 := FRoot;\n list := TList.Create;\n while node1 <> nil do\n begin\n if (node1.FLt = nil) then\n begin\n node2 := node1.FGt;\n if (node1.FPtr = nil) then\n list.Add(node1) else\n if all then\n node1.Value.Pack(all);\n end\n else\n begin\n node2 := node1.FLt;\n node1.FLt := node2.FGt;\n node2.FGt := node1;\n end;\n node1 := node2;\n end;\n for i := 0 to list.Count - 1 do\n Delete(TSuperAvlEntry(list[i]).FName);\n list.Free;\nend;\n\nprocedure TSuperAvlTree.Clear(all: boolean);\nvar\n node1, node2: TSuperAvlEntry;\nbegin\n node1 := FRoot;\n while node1 <> nil do\n begin\n if (node1.FLt = nil) then\n begin\n node2 := node1.FGt;\n doDeleteEntry(node1, all);\n end\n else\n begin\n node2 := node1.FLt;\n node1.FLt := node2.FGt;\n node2.FGt := node1;\n end;\n node1 := node2;\n end;\n FRoot := nil;\n FCount := 0;\nend;\n\nfunction TSuperAvlTree.CompareKeyNode(const k: SOString; h: TSuperAvlEntry): integer;\nbegin\n Result := StrComp(PSOChar(k), PSOChar(h.FName));\nend;\n\nfunction TSuperAvlTree.CompareNodeNode(node1, node2: TSuperAvlEntry): integer;\nbegin\n Result := StrComp(PSOChar(node1.FName), PSOChar(node2.FName));\nend;\n\n{ TSuperAvlIterator }\n\n(* Initialize depth to invalid value, to indicate iterator is\n** invalid. (Depth is zero-base.) It's not necessary to initialize\n** iterators prior to passing them to the \"start\" function.\n*)\n\nconstructor TSuperAvlIterator.Create(tree: TSuperAvlTree);\nbegin\n FDepth := not 0;\n FTree := tree;\nend;\n\nprocedure TSuperAvlIterator.Search(const k: SOString; st: TSuperAvlSearchTypes);\nvar\n h: TSuperAvlEntry;\n d: longint;\n cmp, target_cmp: integer;\n ha: Cardinal;\nbegin\n ha := TSuperAvlEntry.Hash(k);\n h := FTree.FRoot;\n d := 0;\n FDepth := not 0;\n if (h = nil) then\n exit;\n\n if (stLess in st) then\n target_cmp := 1 else\n if (stGreater in st) then\n target_cmp := -1 else\n target_cmp := 0;\n\n while true do\n begin\n if h.FHash < ha then cmp := -1 else\n if h.FHash > ha then cmp := 1 else\n cmp := 0;\n\n if cmp = 0 then\n cmp := FTree.CompareKeyNode(k, h);\n if (cmp = 0) then\n begin\n if (stEqual in st) then\n begin\n FDepth := d;\n break;\n end;\n cmp := -target_cmp;\n end\n else\n if (target_cmp <> 0) then\n if ((cmp xor target_cmp) and SUPER_AVL_MASK_HIGH_BIT) = 0 then\n FDepth := d;\n if cmp < 0 then\n h := h.FLt else\n h := h.FGt;\n if (h = nil) then\n break;\n if (cmp > 0) then\n include(FBranch, d) else\n exclude(FBranch, d);\n FPath[d] := h;\n inc(d);\n end;\nend;\n\nprocedure TSuperAvlIterator.First;\nvar\n h: TSuperAvlEntry;\nbegin\n h := FTree.FRoot;\n FDepth := not 0;\n FBranch := [];\n while (h <> nil) do\n begin\n if (FDepth <> not 0) then\n FPath[FDepth] := h;\n inc(FDepth);\n h := h.FLt;\n end;\nend;\n\nprocedure TSuperAvlIterator.Last;\nvar\n h: TSuperAvlEntry;\nbegin\n h := FTree.FRoot;\n FDepth := not 0;\n FBranch := [0..SUPER_AVL_MAX_DEPTH - 1];\n while (h <> nil) do\n begin\n if (FDepth <> not 0) then\n FPath[FDepth] := h;\n inc(FDepth);\n h := h.FGt;\n end;\nend;\n\nfunction TSuperAvlIterator.MoveNext: boolean;\nbegin\n if FDepth = not 0 then\n First else\n Next;\n Result := GetIter <> nil;\nend;\n\nfunction TSuperAvlIterator.GetIter: TSuperAvlEntry;\nbegin\n if (FDepth = not 0) then\n begin\n result := nil;\n exit;\n end;\n if FDepth = 0 then\n Result := FTree.FRoot else\n Result := FPath[FDepth - 1];\nend;\n\nprocedure TSuperAvlIterator.Next;\nvar\n h: TSuperAvlEntry;\nbegin\n if (FDepth <> not 0) then\n begin\n if FDepth = 0 then\n h := FTree.FRoot.FGt else\n h := FPath[FDepth - 1].FGt;\n\n if (h = nil) then\n repeat\n if (FDepth = 0) then\n begin\n FDepth := not 0;\n break;\n end;\n dec(FDepth);\n until (not (FDepth in FBranch))\n else\n begin\n include(FBranch, FDepth);\n FPath[FDepth] := h;\n inc(FDepth);\n while true do\n begin\n h := h.FLt;\n if (h = nil) then\n break;\n exclude(FBranch, FDepth);\n FPath[FDepth] := h;\n inc(FDepth);\n end;\n end;\n end;\nend;\n\nprocedure TSuperAvlIterator.Prior;\nvar\n h: TSuperAvlEntry;\nbegin\n if (FDepth <> not 0) then\n begin\n if FDepth = 0 then\n h := FTree.FRoot.FLt else\n h := FPath[FDepth - 1].FLt;\n if (h = nil) then\n repeat\n if (FDepth = 0) then\n begin\n FDepth := not 0;\n break;\n end;\n dec(FDepth);\n until (FDepth in FBranch)\n else\n begin\n exclude(FBranch, FDepth);\n FPath[FDepth] := h;\n inc(FDepth);\n while true do\n begin\n h := h.FGt;\n if (h = nil) then\n break;\n include(FBranch, FDepth);\n FPath[FDepth] := h;\n inc(FDepth);\n end;\n end;\n end;\nend;\n\nprocedure TSuperAvlTree.doDeleteEntry(Entry: TSuperAvlEntry; all: boolean);\nbegin\n Entry.Free;\nend;\n\nfunction TSuperAvlTree.GetEnumerator: TSuperAvlIterator;\nbegin\n Result := TSuperAvlIterator.Create(Self);\nend;\n\n{ TSuperAvlEntry }\n\nconstructor TSuperAvlEntry.Create(const AName: SOString; Obj: Pointer);\nbegin\n FName := AName;\n FPtr := Obj;\n FHash := Hash(FName);\nend;\n\nfunction TSuperAvlEntry.GetValue: ISuperObject;\nbegin\n Result := ISuperObject(FPtr)\nend;\n\nclass function TSuperAvlEntry.Hash(const k: SOString): Cardinal;\nvar\n h: cardinal;\n i: Integer;\nbegin\n h := 0;\n{$Q-}\n for i := 1 to Length(k) do\n h := h*129 + ord(k[i]) + $9e370001;\n{$Q+}\n Result := h;\nend;\n\nprocedure TSuperAvlEntry.SetValue(const val: ISuperObject);\nbegin\n ISuperObject(FPtr) := val;\nend;\n\n{ TSuperTableString }\n\nfunction TSuperTableString.GetValues: ISuperObject;\nvar\n ite: TSuperAvlIterator;\n obj: TSuperAvlEntry;\nbegin\n Result := TSuperObject.Create(stArray);\n ite := TSuperAvlIterator.Create(Self);\n try\n ite.First;\n obj := ite.GetIter;\n while obj <> nil do\n begin\n Result.AsArray.Add(obj.Value);\n ite.Next;\n obj := ite.GetIter;\n end;\n finally\n ite.Free;\n end;\nend;\n\nfunction TSuperTableString.GetNames: ISuperObject;\nvar\n ite: TSuperAvlIterator;\n obj: TSuperAvlEntry;\nbegin\n Result := TSuperObject.Create(stArray);\n ite := TSuperAvlIterator.Create(Self);\n try\n ite.First;\n obj := ite.GetIter;\n while obj <> nil do\n begin\n Result.AsArray.Add(TSuperObject.Create(obj.FName));\n ite.Next;\n obj := ite.GetIter;\n end;\n finally\n ite.Free;\n end;\nend;\n\nprocedure TSuperTableString.doDeleteEntry(Entry: TSuperAvlEntry; all: boolean);\nbegin\n if Entry.Ptr <> nil then\n begin\n if all then Entry.Value.Clear(true);\n Entry.Value := nil;\n end;\n inherited;\nend;\n\nfunction TSuperTableString.GetO(const k: SOString): ISuperObject;\nvar\n e: TSuperAvlEntry;\nbegin\n e := Search(k);\n if e <> nil then\n Result := e.Value else\n Result := nil\nend;\n\nprocedure TSuperTableString.PutO(const k: SOString; const value: ISuperObject);\nvar\n entry: TSuperAvlEntry;\nbegin\n entry := Insert(TSuperAvlEntry.Create(k, Pointer(value)));\n if entry.FPtr <> nil then\n ISuperObject(entry.FPtr)._AddRef;\nend;\n\nprocedure TSuperTableString.PutS(const k: SOString; const value: SOString);\nbegin\n PutO(k, TSuperObject.Create(Value));\nend;\n\nfunction TSuperTableString.GetS(const k: SOString): SOString;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj.AsString else\n Result := '';\nend;\n\nprocedure TSuperTableString.PutI(const k: SOString; value: SuperInt);\nbegin\n PutO(k, TSuperObject.Create(Value));\nend;\n\nfunction TSuperTableString.GetI(const k: SOString): SuperInt;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj.AsInteger else\n Result := 0;\nend;\n\nprocedure TSuperTableString.PutD(const k: SOString; value: Double);\nbegin\n PutO(k, TSuperObject.Create(Value));\nend;\n\nprocedure TSuperTableString.PutC(const k: SOString; value: Currency);\nbegin\n PutO(k, TSuperObject.CreateCurrency(Value));\nend;\n\nfunction TSuperTableString.GetC(const k: SOString): Currency;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj.AsCurrency else\n Result := 0.0;\nend;\n\nfunction TSuperTableString.GetD(const k: SOString): Double;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj.AsDouble else\n Result := 0.0;\nend;\n\nprocedure TSuperTableString.PutB(const k: SOString; value: Boolean);\nbegin\n PutO(k, TSuperObject.Create(Value));\nend;\n\nfunction TSuperTableString.GetB(const k: SOString): Boolean;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj.AsBoolean else\n Result := False;\nend;\n\n{$IFDEF SUPER_METHOD}\nprocedure TSuperTableString.PutM(const k: SOString; value: TSuperMethod);\nbegin\n PutO(k, TSuperObject.Create(Value));\nend;\n{$ENDIF}\n\n{$IFDEF SUPER_METHOD}\nfunction TSuperTableString.GetM(const k: SOString): TSuperMethod;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj.AsMethod else\n Result := nil;\nend;\n{$ENDIF}\n\nprocedure TSuperTableString.PutN(const k: SOString; const value: ISuperObject);\nbegin\n if value <> nil then\n PutO(k, TSuperObject.Create(stNull)) else\n PutO(k, value);\nend;\n\nfunction TSuperTableString.GetN(const k: SOString): ISuperObject;\nvar\n obj: ISuperObject;\nbegin\n obj := GetO(k);\n if obj <> nil then\n Result := obj else\n Result := TSuperObject.Create(stNull);\nend;\n\n\n{$IFDEF VER210}\n\n{ TSuperAttribute }\n\nconstructor TSuperAttribute.Create(const AName: string);\nbegin\n FName := AName;\nend;\n\n{ TSuperRttiContext }\n\nconstructor TSuperRttiContext.Create;\nbegin\n Context := TRttiContext.Create;\n SerialFromJson := TDictionary.Create;\n SerialToJson := TDictionary.Create;\n\n SerialFromJson.Add(TypeInfo(Boolean), serialfromboolean);\n SerialFromJson.Add(TypeInfo(TDateTime), serialfromdatetime);\n SerialFromJson.Add(TypeInfo(TGUID), serialfromguid);\n SerialToJson.Add(TypeInfo(Boolean), serialtoboolean);\n SerialToJson.Add(TypeInfo(TDateTime), serialtodatetime);\n SerialToJson.Add(TypeInfo(TGUID), serialtoguid);\nend;\n\ndestructor TSuperRttiContext.Destroy;\nbegin\n SerialFromJson.Free;\n SerialToJson.Free;\n Context.Free;\nend;\n\nclass function TSuperRttiContext.GetFieldName(r: TRttiField): string;\nvar\n o: TCustomAttribute;\nbegin\n for o in r.GetAttributes do\n if o is SOName then\n Exit(SOName(o).Name);\n Result := r.Name;\nend;\n\nclass function TSuperRttiContext.GetFieldDefault(r: TRttiField; const obj: ISuperObject): ISuperObject;\nvar\n o: TCustomAttribute;\nbegin\n if not ObjectIsType(obj, stNull) then Exit(obj);\n for o in r.GetAttributes do\n if o is SODefault then\n Exit(SO(SODefault(o).Name));\n Result := obj;\nend;\n\nfunction TSuperRttiContext.AsType(const obj: ISuperObject): T;\nvar\n ret: TValue;\nbegin\n if FromJson(TypeInfo(T), obj, ret) then\n Result := ret.AsType else\n raise exception.Create('Marshalling error');\nend;\n\nfunction TSuperRttiContext.AsJson(const obj: T; const index: ISuperObject = nil): ISuperObject;\nvar\n v: TValue;\nbegin\n TValue.MakeWithoutCopy(@obj, TypeInfo(T), v);\n if index <> nil then\n Result := ToJson(v, index) else\n Result := ToJson(v, so);\nend;\n\nfunction TSuperRttiContext.FromJson(TypeInfo: PTypeInfo; const obj: ISuperObject;\n var Value: TValue): Boolean;\n\n procedure FromChar;\n begin\n if ObjectIsType(obj, stString) and (Length(obj.AsString) = 1) then\n begin\n Value := string(AnsiString(obj.AsString)[1]);\n Result := True;\n end else\n Result := False;\n end;\n\n procedure FromWideChar;\n begin\n if ObjectIsType(obj, stString) and (Length(obj.AsString) = 1) then\n begin\n Value := obj.AsString[1];\n Result := True;\n end else\n Result := False;\n end;\n\n procedure FromInt64;\n var\n i: Int64;\n begin\n case ObjectGetType(obj) of\n stInt:\n begin\n TValue.Make(nil, TypeInfo, Value);\n TValueData(Value).FAsSInt64 := obj.AsInteger;\n Result := True;\n end;\n stString:\n begin\n if TryStrToInt64(obj.AsString, i) then\n begin\n TValue.Make(nil, TypeInfo, Value);\n TValueData(Value).FAsSInt64 := i;\n Result := True;\n end else\n Result := False;\n end;\n else\n Result := False;\n end;\n end;\n\n procedure FromInt(const obj: ISuperObject);\n var\n TypeData: PTypeData;\n i: Integer;\n o: ISuperObject;\n begin\n case ObjectGetType(obj) of\n stInt, stBoolean:\n begin\n i := obj.AsInteger;\n TypeData := GetTypeData(TypeInfo);\n Result := (i >= TypeData.MinValue) and (i <= TypeData.MaxValue);\n if Result then\n TValue.Make(@i, TypeInfo, Value);\n end;\n stString:\n begin\n o := SO(obj.AsString);\n if not ObjectIsType(o, stString) then\n FromInt(o) else\n Result := False;\n end;\n else\n Result := False;\n end;\n end;\n\n procedure fromSet;\n begin\n if ObjectIsType(obj, stInt) then\n begin\n TValue.Make(nil, TypeInfo, Value);\n TValueData(Value).FAsSLong := obj.AsInteger;\n Result := True;\n end else\n Result := False;\n end;\n\n procedure FromFloat(const obj: ISuperObject);\n var\n o: ISuperObject;\n begin\n case ObjectGetType(obj) of\n stInt, stDouble, stCurrency:\n begin\n TValue.Make(nil, TypeInfo, Value);\n case GetTypeData(TypeInfo).FloatType of\n ftSingle: TValueData(Value).FAsSingle := obj.AsDouble;\n ftDouble: TValueData(Value).FAsDouble := obj.AsDouble;\n ftExtended: TValueData(Value).FAsExtended := obj.AsDouble;\n ftComp: TValueData(Value).FAsSInt64 := obj.AsInteger;\n ftCurr: TValueData(Value).FAsCurr := obj.AsCurrency;\n end;\n Result := True;\n end;\n stString:\n begin\n o := SO(obj.AsString);\n if not ObjectIsType(o, stString) then\n FromFloat(o) else\n Result := False;\n end\n else\n Result := False;\n end;\n end;\n\n procedure FromString;\n begin\n case ObjectGetType(obj) of\n stObject, stArray:\n Result := False;\n stnull:\n begin\n Value := '';\n Result := True;\n end;\n else\n Value := obj.AsString;\n Result := True;\n end;\n end;\n\n procedure FromClass;\n var\n f: TRttiField;\n v: TValue;\n begin\n case ObjectGetType(obj) of\n stObject:\n begin\n Result := True;\n if Value.Kind <> tkClass then\n Value := GetTypeData(TypeInfo).ClassType.Create;\n for f in Context.GetType(Value.AsObject.ClassType).GetFields do\n if f.FieldType <> nil then\n begin\n Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);\n if Result then\n f.SetValue(Value.AsObject, v) else\n Exit;\n end;\n end;\n stNull:\n begin\n Value := nil;\n Result := True;\n end\n else\n // error\n Value := nil;\n Result := False;\n end;\n end;\n\n procedure FromRecord;\n var\n f: TRttiField;\n p: Pointer;\n v: TValue;\n begin\n Result := True;\n TValue.Make(nil, TypeInfo, Value);\n for f in Context.GetType(TypeInfo).GetFields do\n begin\n if ObjectIsType(obj, stObject) and (f.FieldType <> nil) then\n begin\n p := IValueData(TValueData(Value).FHeapData).GetReferenceToRawData;\n Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);\n if Result then\n f.SetValue(p, v) else\n Exit;\n end else\n begin\n Result := False;\n Exit;\n end;\n end;\n end;\n\n procedure FromDynArray;\n var\n i: Integer;\n p: Pointer;\n pb: PByte;\n val: TValue;\n typ: PTypeData;\n el: PTypeInfo;\n begin\n case ObjectGetType(obj) of\n stArray:\n begin\n i := obj.AsArray.Length;\n p := nil;\n DynArraySetLength(p, TypeInfo, 1, @i);\n pb := p;\n typ := GetTypeData(TypeInfo);\n if typ.elType <> nil then\n el := typ.elType^ else\n el := typ.elType2^;\n\n Result := True;\n for i := 0 to i - 1 do\n begin\n Result := FromJson(el, obj.AsArray[i], val);\n if not Result then\n Break;\n val.ExtractRawData(pb);\n val := TValue.Empty;\n Inc(pb, typ.elSize);\n end;\n if Result then\n TValue.MakeWithoutCopy(@p, TypeInfo, Value) else\n DynArrayClear(p, TypeInfo);\n end;\n stNull:\n begin\n TValue.MakeWithoutCopy(nil, TypeInfo, Value);\n Result := True;\n end;\n else\n i := 1;\n p := nil;\n DynArraySetLength(p, TypeInfo, 1, @i);\n pb := p;\n typ := GetTypeData(TypeInfo);\n if typ.elType <> nil then\n el := typ.elType^ else\n el := typ.elType2^;\n\n Result := FromJson(el, obj, val);\n val.ExtractRawData(pb);\n val := TValue.Empty;\n\n if Result then\n TValue.MakeWithoutCopy(@p, TypeInfo, Value) else\n DynArrayClear(p, TypeInfo);\n end;\n end;\n\n procedure FromArray;\n var\n ArrayData: PArrayTypeData;\n idx: Integer;\n function ProcessDim(dim: Byte; const o: ISuperobject): Boolean;\n var\n i: Integer;\n v: TValue;\n a: PTypeData;\n begin\n if ObjectIsType(o, stArray) and (ArrayData.Dims[dim-1] <> nil) then\n begin\n a := @GetTypeData(ArrayData.Dims[dim-1]^).ArrayData;\n if (a.MaxValue - a.MinValue + 1) <> o.AsArray.Length then\n begin\n Result := False;\n Exit;\n end;\n Result := True;\n if dim = ArrayData.DimCount then\n for i := a.MinValue to a.MaxValue do\n begin\n Result := FromJson(ArrayData.ElType^, o.AsArray[i], v);\n if not Result then\n Exit;\n Value.SetArrayElement(idx, v);\n inc(idx);\n end\n else\n for i := a.MinValue to a.MaxValue do\n begin\n Result := ProcessDim(dim + 1, o.AsArray[i]);\n if not Result then\n Exit;\n end;\n end else\n Result := False;\n end;\n var\n i: Integer;\n v: TValue;\n begin\n TValue.Make(nil, TypeInfo, Value);\n ArrayData := @GetTypeData(TypeInfo).ArrayData;\n idx := 0;\n if ArrayData.DimCount = 1 then\n begin\n if ObjectIsType(obj, stArray) and (obj.AsArray.Length = ArrayData.ElCount) then\n begin\n Result := True;\n for i := 0 to ArrayData.ElCount - 1 do\n begin\n Result := FromJson(ArrayData.ElType^, obj.AsArray[i], v);\n if not Result then\n Exit;\n Value.SetArrayElement(idx, v);\n v := TValue.Empty;\n inc(idx);\n end;\n end else\n Result := False;\n end else\n Result := ProcessDim(1, obj);\n end;\n\n procedure FromClassRef;\n var\n r: TRttiType;\n begin\n if ObjectIsType(obj, stString) then\n begin\n r := Context.FindType(obj.AsString);\n if r <> nil then\n begin\n Value := TRttiInstanceType(r).MetaclassType;\n Result := True;\n end else\n Result := False;\n end else\n Result := False;\n end;\n\n procedure FromUnknown;\n begin\n case ObjectGetType(obj) of\n stBoolean:\n begin\n Value := obj.AsBoolean;\n Result := True;\n end;\n stDouble:\n begin\n Value := obj.AsDouble;\n Result := True;\n end;\n stCurrency:\n begin\n Value := obj.AsCurrency;\n Result := True;\n end;\n stInt:\n begin\n Value := obj.AsInteger;\n Result := True;\n end;\n stString:\n begin\n Value := obj.AsString;\n Result := True;\n end\n else\n Value := nil;\n Result := False;\n end;\n end;\n\n procedure FromInterface;\n const soguid: TGuid = '{4B86A9E3-E094-4E5A-954A-69048B7B6327}';\n var\n o: ISuperObject;\n begin\n if CompareMem(@GetTypeData(TypeInfo).Guid, @soguid, SizeOf(TGUID)) then\n begin\n if obj <> nil then\n TValue.Make(@obj, TypeInfo, Value) else\n begin\n o := TSuperObject.Create(stNull);\n TValue.Make(@o, TypeInfo, Value);\n end;\n Result := True;\n end else\n Result := False;\n end;\nvar\n Serial: TSerialFromJson;\nbegin\n if TypeInfo <> nil then\n begin\n if not SerialFromJson.TryGetValue(TypeInfo, Serial) then\n case TypeInfo.Kind of\n tkChar: FromChar;\n tkInt64: FromInt64;\n tkEnumeration, tkInteger: FromInt(obj);\n tkSet: fromSet;\n tkFloat: FromFloat(obj);\n tkString, tkLString, tkUString, tkWString: FromString;\n tkClass: FromClass;\n tkMethod: ;\n tkWChar: FromWideChar;\n tkRecord: FromRecord;\n tkPointer: ;\n tkInterface: FromInterface;\n tkArray: FromArray;\n tkDynArray: FromDynArray;\n tkClassRef: FromClassRef;\n else\n FromUnknown\n end else\n begin\n TValue.Make(nil, TypeInfo, Value);\n Result := Serial(Self, obj, Value);\n end;\n end else\n Result := False;\nend;\n\nfunction TSuperRttiContext.ToJson(var value: TValue; const index: ISuperObject): ISuperObject;\n procedure ToInt64;\n begin\n Result := TSuperObject.Create(SuperInt(Value.AsInt64));\n end;\n\n procedure ToChar;\n begin\n Result := TSuperObject.Create(string(Value.AsType));\n end;\n\n procedure ToInteger;\n begin\n Result := TSuperObject.Create(TValueData(Value).FAsSLong);\n end;\n\n procedure ToFloat;\n begin\n case Value.TypeData.FloatType of\n ftSingle: Result := TSuperObject.Create(TValueData(Value).FAsSingle);\n ftDouble: Result := TSuperObject.Create(TValueData(Value).FAsDouble);\n ftExtended: Result := TSuperObject.Create(TValueData(Value).FAsExtended);\n ftComp: Result := TSuperObject.Create(TValueData(Value).FAsSInt64);\n ftCurr: Result := TSuperObject.CreateCurrency(TValueData(Value).FAsCurr);\n end;\n end;\n\n procedure ToString;\n begin\n Result := TSuperObject.Create(string(Value.AsType));\n end;\n\n procedure ToClass;\n var\n o: ISuperObject;\n f: TRttiField;\n v: TValue;\n begin\n if TValueData(Value).FAsObject <> nil then\n begin\n o := index[IntToStr(Integer(Value.AsObject))];\n if o = nil then\n begin\n Result := TSuperObject.Create(stObject);\n index[IntToStr(Integer(Value.AsObject))] := Result;\n for f in Context.GetType(Value.AsObject.ClassType).GetFields do\n if f.FieldType <> nil then\n begin\n v := f.GetValue(Value.AsObject);\n Result.AsObject[GetFieldName(f)] := ToJson(v, index);\n end\n end else\n Result := o;\n end else\n Result := nil;\n end;\n\n procedure ToWChar;\n begin\n Result := TSuperObject.Create(string(Value.AsType));\n end;\n\n procedure ToVariant;\n begin\n Result := SO(Value.AsVariant);\n end;\n\n procedure ToRecord;\n var\n f: TRttiField;\n v: TValue;\n begin\n Result := TSuperObject.Create(stObject);\n for f in Context.GetType(Value.TypeInfo).GetFields do\n begin\n v := f.GetValue(IValueData(TValueData(Value).FHeapData).GetReferenceToRawData);\n Result.AsObject[GetFieldName(f)] := ToJson(v, index);\n end;\n end;\n\n procedure ToArray;\n var\n idx: Integer;\n ArrayData: PArrayTypeData;\n\n procedure ProcessDim(dim: Byte; const o: ISuperObject);\n var\n dt: PTypeData;\n i: Integer;\n o2: ISuperObject;\n v: TValue;\n begin\n if ArrayData.Dims[dim-1] = nil then Exit;\n dt := GetTypeData(ArrayData.Dims[dim-1]^);\n if Dim = ArrayData.DimCount then\n for i := dt.MinValue to dt.MaxValue do\n begin\n v := Value.GetArrayElement(idx);\n o.AsArray.Add(toJSon(v, index));\n inc(idx);\n end\n else\n for i := dt.MinValue to dt.MaxValue do\n begin\n o2 := TSuperObject.Create(stArray);\n o.AsArray.Add(o2);\n ProcessDim(dim + 1, o2);\n end;\n end;\n var\n i: Integer;\n v: TValue;\n begin\n Result := TSuperObject.Create(stArray);\n ArrayData := @Value.TypeData.ArrayData;\n idx := 0;\n if ArrayData.DimCount = 1 then\n for i := 0 to ArrayData.ElCount - 1 do\n begin\n v := Value.GetArrayElement(i);\n Result.AsArray.Add(toJSon(v, index))\n end\n else\n ProcessDim(1, Result);\n end;\n\n procedure ToDynArray;\n var\n i: Integer;\n v: TValue;\n begin\n Result := TSuperObject.Create(stArray);\n for i := 0 to Value.GetArrayLength - 1 do\n begin\n v := Value.GetArrayElement(i);\n Result.AsArray.Add(toJSon(v, index));\n end;\n end;\n\n procedure ToClassRef;\n begin\n if TValueData(Value).FAsClass <> nil then\n Result := TSuperObject.Create(string(\n TValueData(Value).FAsClass.UnitName + '.' +\n TValueData(Value).FAsClass.ClassName)) else\n Result := nil;\n end;\n\n procedure ToInterface;\n begin\n if TValueData(Value).FHeapData <> nil then\n TValueData(Value).FHeapData.QueryInterface(ISuperObject, Result) else\n Result := nil;\n end;\n\nvar\n Serial: TSerialToJson;\nbegin\n if not SerialToJson.TryGetValue(value.TypeInfo, Serial) then\n case Value.Kind of\n tkInt64: ToInt64;\n tkChar: ToChar;\n tkSet, tkInteger, tkEnumeration: ToInteger;\n tkFloat: ToFloat;\n tkString, tkLString, tkUString, tkWString: ToString;\n tkClass: ToClass;\n tkWChar: ToWChar;\n tkVariant: ToVariant;\n tkRecord: ToRecord;\n tkArray: ToArray;\n tkDynArray: ToDynArray;\n tkClassRef: ToClassRef;\n tkInterface: ToInterface;\n else\n result := nil;\n end else\n Result := Serial(Self, value, index);\nend;\n\n{ TSuperObjectHelper }\n\nconstructor TSuperObjectHelper.FromJson(const obj: ISuperObject; ctx: TSuperRttiContext = nil);\nvar\n v: TValue;\n ctxowned: Boolean;\nbegin\n if ctx = nil then\n begin\n ctx := TSuperRttiContext.Create;\n ctxowned := True;\n end else\n ctxowned := False;\n try\n v := Self;\n if not ctx.FromJson(v.TypeInfo, obj, v) then\n raise Exception.Create('Invalid object');\n finally\n if ctxowned then\n ctx.Free;\n end;\nend;\n\nconstructor TSuperObjectHelper.FromJson(const str: string; ctx: TSuperRttiContext = nil);\nbegin\n FromJson(SO(str), ctx);\nend;\n\nfunction TSuperObjectHelper.ToJson(ctx: TSuperRttiContext = nil): ISuperObject;\nvar\n v: TValue;\n ctxowned: boolean;\nbegin\n if ctx = nil then\n begin\n ctx := TSuperRttiContext.Create;\n ctxowned := True;\n end else\n ctxowned := False;\n try\n v := Self;\n Result := ctx.ToJson(v, SO);\n finally\n if ctxowned then\n ctx.Free;\n end;\nend;\n\n{$ENDIF}\n\n{$IFDEF DEBUG}\ninitialization\n\nfinalization\n Assert(debugcount = 0, 'Memory leak');\n{$ENDIF}\nend.\n\n"
},
{
"path": "lib/xedit/lz4/lz4.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n \n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\nunit lz4;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows, lz4Common;\n\nconst\n LZ4_VERSION_MAJOR = 1;\n LZ4_VERSION_MINOR = 5;\n LZ4_VERSION_RELEASE = 0;\n LZ4_MEMORY_USAGE = 14;\n LZ4_STREAMSIZE_U64 = (1 shl (LZ4_MEMORY_USAGE - 3)) + 4;\n LZ4_STREAMSIZE = LZ4_STREAMSIZE_U64 * sizeof(int64);\n LZ4_MAX_INPUT_SIZE = $7E000000;\n LZ4_UNALIGNED_ACCESS = 1;\n LZ4_STREAMDECODESIZE_U64 = 4;\n\ntype\n PLZ4_stream_t = ^LZ4_stream_t;\n\n LZ4_stream_t = record\n table: array [0 .. LZ4_STREAMSIZE_U64 - 1] of int64;\n end;\n\n PLZ4_streamDecode_t = ^LZ4_streamDecode_t;\n\n LZ4_streamDecode_t = record\n table: array [0 .. LZ4_STREAMDECODESIZE_U64 - 1] of int64;\n end;\n\nfunction LZ4_versionNumber: integer;\nfunction LZ4_compressBound(iSize: cardinal): cardinal;\nfunction LZ4_create(inputBuffer: pAnsiChar): pointer;\nfunction LZ4_createStream: PLZ4_stream_t;\nprocedure LZ4_freeStream(LZ4_streamPtr: PLZ4_stream_t);\nfunction LZ4_createStreamDecode: PLZ4_streamDecode_t;\nprocedure LZ4_freeStreamDecode(LZ4_stream: PLZ4_streamDecode_t);\nfunction LZ4_compress(source: pAnsiChar; dest: pAnsiChar; sourceSize: integer): integer;\nfunction LZ4_decompress_safe(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxDecompressedSize: integer): integer;\nfunction LZ4_compress_continue(LZ4_stream: pointer; const ASource: pointer; ADestination: pointer; AInputSize: integer): integer;\nfunction LZ4_saveDict(LZ4_streamPtr: PLZ4_stream_t; safeBuffer: pointer; dictSize: integer): integer;\nfunction LZ4_decompress_safe_continue(LZ4_streamDecode: PLZ4_streamDecode_t; source: pointer; dest: pointer; compressedSize: integer;\n maxDecompressedSize: integer): integer;\nfunction LZ4_compress_limitedOutput(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; maxOutputSize: integer): integer;\nfunction LZ4_compress_withState(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nfunction LZ4_compress_limitedOutput_withState(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer): integer;\nfunction LZ4_compress_limitedOutput_continue(LZ4_stream: PLZ4_stream_t; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer): integer;\nprocedure LZ4_resetStream(LZ4_stream: PLZ4_stream_t);\nfunction LZ4_loadDict(LZ4_dict: PLZ4_stream_t; dictionary: pAnsiChar; dictSize: integer): integer;\n// debug function\nfunction LZ4_compress_forceExtDict(LZ4_dict: PLZ4_stream_t; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nfunction LZ4_decompress_fast(source: pAnsiChar; dest: pAnsiChar; originalSize: integer): integer;\nfunction LZ4_decompress_fast_withPrefix64k(source: pAnsiChar; dest: pAnsiChar; originalSize: integer): integer;\nfunction LZ4_decompress_fast_usingDict(source: pAnsiChar; dest: pAnsiChar; originalSize: integer; const dictStart: pAnsiChar;\n dictSize: integer): integer;\nfunction LZ4_decompress_safe_withPrefix64k(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer): integer;\nfunction LZ4_decompress_safe_usingDict(const source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer;\n const dictStart: pAnsiChar; dictSize: integer): integer;\nfunction LZ4_decompress_safe_partial(const source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; targetOutputSize: integer;\n maxDecompressedSize: integer): integer;\nfunction LZ4_decompress_safe_forceExtDict(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer;\n const dictStart: pAnsiChar; dictSize: integer): integer;\n\n// replaced with move(source^, dest^, count)\n// procedure memmove(dest, source: pointer; count: integer); cdecl; external 'msvcrt.dll' name 'memmove';\n\nimplementation\n\nconst\n LZ4_HASHLOG = LZ4_MEMORY_USAGE - 2;\n HASHTABLESIZE = 1 shl LZ4_MEMORY_USAGE;\n HASH_SIZE_U32 = 1 shl LZ4_HASHLOG;\n\ntype\n limitedOutput_directive = (notLimited = 0, limitedOutput = 1);\n tableType_t = (byPtr, byU32, byU16);\n dict_directive = (noDict = 0, withPrefix64k, usingExtDict);\n dictIssue_directive = (noDictIssue = 0, dictSmall);\n endCondition_directive = (endOnOutputSize = 0, endOnInputSize = 1);\n earlyEnd_directive = (full = 0, partial = 1);\n\n PLZ4_stream_t_internal = ^LZ4_stream_t_internal;\n\n LZ4_stream_t_internal = record\n hashTable: array [0 .. HASH_SIZE_U32 - 1] of cardinal;\n currentOffset: cardinal;\n initCheck: cardinal;\n dictionary: pByte;\n bufferStart: pByte;\n dictSize: cardinal;\n end;\n\n PLZ4_streamDecode_t_internal = ^LZ4_streamDecode_t_internal;\n\n LZ4_streamDecode_t_internal = record\n externalDict: pByte;\n extDictSize: size_t;\n prefixEnd: pByte;\n prefixSize: size_t;\n end;\n\nvar\n LZ4_64Klimit: integer = 65536 + _MFLIMIT - 1;\n LZ4_skipTrigger: cardinal = 6;\n LZ4_minLength: integer = (_MFLIMIT + 1);\n\nfunction LZ4_versionNumber: integer;\nbegin\n result := LZ4_VERSION_MAJOR * 100 * 100 + LZ4_VERSION_MINOR * 100 + LZ4_VERSION_RELEASE;\nend;\n\nfunction LZ4_compressBound(iSize: cardinal): cardinal;\nbegin\n if (iSize) > cardinal(LZ4_MAX_INPUT_SIZE) then\n result := 0\n else\n result := iSize + (iSize div 255 + 16)\nend;\n\nprocedure LZ4_copy8(const dstPtr: pointer; const srcPtr: pointer); inline;\nbegin\n{$IFDEF WIN64}\n pUint64(dstPtr)^ := pUint64(srcPtr)^;\n{$ELSE}\n pCardinal(dstPtr)[0] := pCardinal(srcPtr)[0];\n pCardinal(dstPtr)[1] := pCardinal(srcPtr)[1];\n{$ENDIF}\nend;\n\nfunction LZ4_hashSequence(sequence: cardinal; tableType: tableType_t): cardinal; inline;\nconst\n SHL1 = (MINMATCH * 8) - (LZ4_HASHLOG + 1);\n SHL2 = ((MINMATCH * 8) - LZ4_HASHLOG);\nbegin\n if (tableType = byU16) then\n result := (sequence * 2654435761) shr SHL1\n else\n result := (sequence * 2654435761) shr SHL2;\nend;\n\nfunction LZ4_hashPosition(const p: pByte; tableType: tableType_t): cardinal; inline;\nbegin\n result := LZ4_hashSequence(pCardinal(p)^, tableType);\nend;\n\nprocedure LZ4_putPositionOnHash(const p: pByte; h: cardinal; tableBase: pointer; tableType: tableType_t; const srcBase: pByte); inline;\nbegin\n case tableType of\n byPtr: ppByte(tableBase)[h] := p;\n byU32: pCardinal(tableBase)[h] := cardinal(p - srcBase);\n byU16: pWord(tableBase)[h] := word(p - srcBase);\n end;\nend;\n\nfunction LZ4_getPositionOnHash(h: cardinal; tableBase: pointer; tableType: tableType_t; const srcBase: pByte): pByte; inline;\nbegin\n if (tableType = byPtr) then\n result := ppByte(tableBase)[h]\n else if (tableType = byU32) then\n result := pCardinal(tableBase)[h] + srcBase\n else\n result := pWord(tableBase)[h] + srcBase;\nend;\n\nfunction LZ4_getPosition(const p: pByte; tableBase: pointer; tableType: tableType_t; const srcBase: pByte): pByte; inline;\nvar\n h: cardinal;\nbegin\n h := LZ4_hashPosition(p, tableType);\n result := LZ4_getPositionOnHash(h, tableBase, tableType, srcBase);\nend;\n\nprocedure LZ4_putPosition(const p: pByte; tableBase: pointer; tableType: tableType_t; const srcBase: pByte); inline;\nvar\n h: cardinal;\nbegin\n h := LZ4_hashPosition(p, tableType);\n LZ4_putPositionOnHash(p, h, tableBase, tableType, srcBase);\nend;\n\nfunction LZ4_compress_generic(ctx: pointer; const source: pointer; dest: pointer; inputSize: integer; maxOutputSize: integer;\n outputLimited: limitedOutput_directive; tableType: tableType_t; dict: dict_directive; dictIssue: dictIssue_directive): integer; inline;\nvar\n lowRefLimit: pByte;\n match: pByte;\n refDelta: size_t;\n ip: pByte;\n\n dictPtr: PLZ4_stream_t_internal;\n base: pByte;\n lowLimit: pByte;\n dictionary: pByte;\n dictEnd: pByte;\n dictDelta: size_t;\n anchor: pByte;\n iend: pByte;\n mflimit: pByte;\n matchlimit: pByte;\n op: pByte;\n olimit: pByte;\n forwardH: cardinal;\n lastRun: integer;\n token: pByte;\n forwardIp: pByte;\n step: cardinal;\n searchMatchNb: cardinal;\n h: cardinal;\n litLength: cardinal;\n len: integer;\n matchLength: cardinal;\n limit: pByte;\n more: cardinal;\n booleanValue: boolean;\nlabel\n _last_literals, _next_match;\nbegin\n match := nil;\n dictPtr := ctx;\n ip := pByte(source);\n lowRefLimit := ip - dictPtr.dictSize;\n dictionary := dictPtr.dictionary;\n dictEnd := dictionary + dictPtr.dictSize;\n dictDelta := dictEnd - pByte(source);\n anchor := pByte(source);\n iend := ip + inputSize;\n mflimit := iend - _MFLIMIT;\n matchlimit := iend - LASTLITERALS;\n\n op := pByte(dest);\n olimit := op + maxOutputSize;\n refDelta := 0;\n\n if cardinal(inputSize) > cardinal(LZ4_MAX_INPUT_SIZE) then\n exit(0);\n\n case dict of\n withPrefix64k:\n begin\n base := pByte(source) - dictPtr.currentOffset;\n lowLimit := pByte(source) - dictPtr.dictSize;\n end;\n usingExtDict:\n begin\n base := pByte(source) - dictPtr.currentOffset;\n lowLimit := pByte(source);\n end;\n else\n begin\n base := pByte(source);\n lowLimit := pByte(source);\n end;\n end;\n\n if ((tableType = byU16) and (inputSize >= LZ4_64Klimit)) then\n exit(0);\n if (inputSize < LZ4_minLength) then\n goto _last_literals;\n\n LZ4_putPosition(ip, ctx, tableType, base);\n inc(ip);\n forwardH := LZ4_hashPosition(ip, tableType);\n\n while true do\n begin\n forwardIp := ip;\n step := 1;\n searchMatchNb := (1 shl LZ4_skipTrigger);\n while true do\n begin\n h := forwardH;\n ip := forwardIp;\n inc(forwardIp, step);\n step := searchMatchNb shr LZ4_skipTrigger;\n inc(searchMatchNb);\n\n if forwardIp > mflimit then\n goto _last_literals;\n\n match := LZ4_getPositionOnHash(h, ctx, tableType, base);\n if (dict = usingExtDict) then\n begin\n if match < pByte(source) then\n begin\n refDelta := dictDelta;\n lowLimit := dictionary;\n end\n else\n begin\n refDelta := 0;\n lowLimit := pByte(source);\n end;\n end;\n forwardH := LZ4_hashPosition(forwardIp, tableType);\n LZ4_putPositionOnHash(ip, h, ctx, tableType, base);\n if (dictIssue = dictSmall) and (match < lowRefLimit) then\n continue;\n if not(tableType = byU16) and (match + MAX_DISTANCE < ip) then\n continue;\n if (pCardinal(match + refDelta)^ <> pCardinal(ip)^) then\n continue;\n break;\n end;\n\n while (ip > anchor) and (match + refDelta > lowLimit) and (ip[-1] = match[refDelta - 1]) do\n begin\n dec(ip);\n dec(match);\n end;\n litLength := cardinal(ip - anchor);\n token := op;\n inc(op);\n if (outputLimited <> notLimited) and (op + litLength + (2 + 1 + LASTLITERALS) + (litLength div 255) > olimit) then\n exit(0);\n if (litLength >= RUN_MASK) then\n begin\n len := integer(litLength - RUN_MASK);\n token^ := (RUN_MASK shl ML_BITS);\n while len >= 255 do\n begin\n op^ := 255;\n inc(op);\n dec(len, 255);\n end;\n op^ := BYTE(len);\n inc(op);\n end\n else\n token^ := BYTE(litLength shl ML_BITS);\n LZ4_wildCopy(op, anchor, op + litLength);\n inc(op, litLength);\n _next_match:\n pWord(op)^ := word(ip - match);\n inc(op, 2);\n\n if (dict = usingExtDict) and (lowLimit = dictionary) then\n begin\n inc(match, refDelta);\n limit := ip + (dictEnd - match);\n if (limit > matchlimit) then\n limit := matchlimit;\n matchLength := LZ4_count(ip + MINMATCH, match + MINMATCH, limit);\n inc(ip, MINMATCH + matchLength);\n if (ip = limit) then\n begin\n more := LZ4_count(ip, pByte(source), matchlimit);\n inc(matchLength, more);\n inc(ip, more);\n end;\n end\n else\n begin\n matchLength := LZ4_count(ip + MINMATCH, match + MINMATCH, matchlimit);\n inc(ip, MINMATCH + matchLength);\n end;\n if (outputLimited <> notLimited) and (op + (1 + LASTLITERALS) + (matchLength shr 8) > olimit) then\n exit(0);\n if (matchLength >= ML_MASK) then\n begin\n inc(token^, ML_MASK);\n dec(matchLength, ML_MASK);\n while matchLength >= 510 do\n begin\n pWord(op)^ := $FFFF;\n inc(op, 2);\n // op^ := 255;\n // inc(op);\n // op^ := 255;\n // inc(op);\n dec(matchLength, 510);\n end;\n if (matchLength >= 255) then\n begin\n dec(matchLength, 255);\n op^ := 255;\n inc(op);\n end;\n op^ := BYTE(matchLength);\n inc(op);\n end\n else\n inc(token^, BYTE(matchLength));\n\n anchor := ip;\n if (ip > mflimit) then\n break;\n LZ4_putPosition(ip - 2, ctx, tableType, base);\n match := LZ4_getPosition(ip, ctx, tableType, base);\n if (dict = usingExtDict) then\n begin\n if match < pByte(source) then\n begin\n refDelta := dictDelta;\n lowLimit := dictionary;\n end\n else\n begin\n refDelta := 0;\n lowLimit := pByte(source);\n end;\n end;\n LZ4_putPosition(ip, ctx, tableType, base);\n\n if dictIssue = dictSmall then\n booleanValue := match >= lowRefLimit\n else\n booleanValue := true;\n if (booleanValue and (match + MAX_DISTANCE >= ip)\n and (pCardinal(match + refDelta)^ = pCardinal(ip)^)) then\n begin\n token := op;\n inc(op);\n token^ := 0;\n goto _next_match;\n end;\n inc(ip);\n forwardH := LZ4_hashPosition(ip, tableType);\n end;\n\n_last_literals:\n lastRun := integer(iend - anchor);\n if (outputLimited <> notLimited) and ((op - pByte(dest)) + lastRun + 1 + ((lastRun + 255 - RUN_MASK) div 255) >\n maxOutputSize)\n then\n exit(0);\n if lastRun >= integer(RUN_MASK) then\n begin\n op^ := (RUN_MASK shl ML_BITS);\n inc(op);\n dec(lastRun, RUN_MASK);\n while lastRun >= 255 do\n begin\n op^ := 255;\n inc(op);\n dec(lastRun, 255);\n end;\n op^ := BYTE(lastRun);\n inc(op);\n end\n else\n begin\n op^ := BYTE(lastRun shl ML_BITS);\n inc(op);\n end;\n move(anchor^, op^, iend - anchor);\n inc(op, iend - anchor);\n\n result := integer(op - pByte(dest));\nend;\n\nfunction LZ4_compress(source: pAnsiChar; dest: pAnsiChar; sourceSize: integer): integer;\nvar\n ctx: array [0 .. LZ4_STREAMSIZE_U64 - 1] of uint64;\nbegin\n fillchar(ctx, sizeof(ctx), 0);\n if sourceSize < LZ4_64Klimit then\n result := LZ4_compress_generic(@ctx, source, dest, sourceSize, 0, notLimited, byU16, noDict, noDictIssue)\n else\n begin\n{$IFDEF WIN64}\n result := LZ4_compress_generic(@ctx, source, dest, sourceSize, 0, notLimited, byU32, noDict,\n noDictIssue)\n{$ELSE}\n result := LZ4_compress_generic(@ctx, source, dest, sourceSize, 0, notLimited, byPtr, noDict, noDictIssue);\n{$ENDIF}\n end;\nend;\n\nfunction LZ4_decompress_generic(const source: pointer; const dest: pointer; inputSize: integer; outputSize: integer;\n endOnInput: integer; partialDecoding: integer; targetOutputSize: integer; dict: integer;\n const lowPrefix: pByte; const dictStart: pByte; const dictSize: size_t): integer; inline;\nvar\n ip: pByte;\n iend: pByte;\n op: pByte;\n oend: pByte;\n cpy: pByte;\n oexit: pByte;\n lowLimit: pByte;\n dictEnd: pByte;\n safeDecode: boolean;\n checkOffset: boolean;\n token: cardinal;\n length: size_t;\n match: pByte;\n s: cardinal;\n booleantest: boolean;\n copySize: size_t;\n endOfMatch: pByte;\n copyFrom: pByte;\n dec64: size_t;\nconst\n dec32table: array [0 .. 7] of size_t = (4, 1, 2, 1, 4, 4, 4, 4);\n dec64table: array [0 .. 7] of size_t = (0, 0, 0, size_t(-1), 0, 1, 2, 3);\nlabel\n _output_error;\nbegin\n ip := pByte(source);\n iend := ip + inputSize;\n op := pByte(dest);\n oend := op + outputSize;\n oexit := op + targetOutputSize;\n lowLimit := lowPrefix - dictSize;\n dictEnd := pByte(dictStart) + dictSize;\n safeDecode := (endOnInput = integer(endOnInputSize));\n checkOffset := ((safeDecode) and (dictSize < 65536));\n\n if (partialDecoding <> 0) and (oexit > oend - _MFLIMIT) then\n oexit := oend - _MFLIMIT;\n if (endOnInput <> 0) and (outputSize = 0) then\n begin\n if (inputSize = 1) and (ip^ = 0) then\n exit(0)\n else\n exit(-1);\n end;\n if (endOnInput = 0) and (outputSize = 0) then\n begin\n if ip^ = 0 then\n exit(1)\n else\n exit(-1);\n end;\n\n while true do\n begin\n token := ip^;\n inc(ip);\n length := token shr ML_BITS;\n if length = RUN_MASK then\n begin\n while true do\n begin\n s := ip^;\n inc(ip);\n inc(length, s);\n if endOnInput <> 0 then\n begin\n if not(ip < iend - RUN_MASK) then\n break;\n end;\n if s <> 255 then\n break;\n end;\n if safeDecode and (size_t(op + length) < size_t(op)) then\n goto _output_error;\n if safeDecode and (size_t(ip + length) < size_t(ip)) then\n goto _output_error;\n end;\n cpy := op + length;\n if partialDecoding <> 0 then\n booleantest := cpy > oexit\n else\n booleantest := cpy > oend - _MFLIMIT;\n\n if ((endOnInput <> 0) and ((booleantest) or (ip + length > iend - (2 + 1 + LASTLITERALS))))\n or ((endOnInput = 0) and (cpy > oend - COPYLENGTH)) then\n begin\n if partialDecoding <> 0 then\n begin\n if (cpy > oend) then\n goto _output_error;\n if ((endOnInput <> 0) and (ip + length > iend)) then\n goto _output_error;\n end\n else\n begin\n if ((endOnInput = 0) and (cpy <> oend)) then\n goto _output_error;\n if ((endOnInput <> 0) and ((ip + length <> iend) or (cpy > oend))) then\n goto _output_error;\n end;\n move(ip^, op^, length);\n inc(ip, length);\n inc(op, length);\n break;\n end;\n LZ4_wildCopy(op, ip, cpy);\n inc(ip, length);\n op := cpy;\n match := cpy - LZ4_read16(ip); // LZ4_readLE16 = LZ4_read16 for unaligned\n inc(ip, 2);\n\n if checkOffset and (match < lowLimit) then\n goto _output_error;\n\n length := token and ML_MASK;\n if length = ML_MASK then\n begin\n while true do\n begin\n if ((endOnInput <> 0) and (ip > iend - LASTLITERALS)) then\n goto _output_error;\n s := ip^;\n inc(ip);\n inc(length, s);\n if s <> 255 then\n break;\n end;\n if safeDecode and (size_t(op + length) < size_t(op)) then\n goto _output_error;\n end;\n inc(length, MINMATCH);\n if (dict = integer(usingExtDict)) and (match < lowPrefix) then\n begin\n if op + length > oend - LASTLITERALS then\n goto _output_error;\n if (length <= size_t(lowPrefix - match)) then\n begin\n match := dictEnd - (lowPrefix - match);\n move(match^, op^, length);\n inc(op, length);\n end\n else\n begin\n copySize := size_t(lowPrefix - match);\n move((dictEnd - copySize)^, op^, copySize);\n inc(op, copySize);\n copySize := length - copySize;\n if copySize > size_t(op - lowPrefix) then\n begin\n endOfMatch := op + copySize;\n copyFrom := lowPrefix;\n while (op < endOfMatch) do\n begin\n op^ := copyFrom^;\n inc(op);\n inc(copyFrom);\n end;\n end\n else\n begin\n move(lowPrefix^, op^, copySize);\n inc(op, copySize);\n end;\n end;\n continue;\n end;\n cpy := op + length;\n if (op - match) < 8 then\n begin\n dec64 := dec64table[op - match];\n op[0] := match[0];\n op[1] := match[1];\n op[2] := match[2];\n op[3] := match[3];\n inc(match, dec32table[op - match]);\n pCardinal(op + 4)^ := pCardinal(match)^;\n inc(op, 8);\n dec(match, dec64);\n end\n else\n begin\n{$IFDEF WIN64}\n pUint64(op)^ := pUint64(match)^;\n{$ELSE}\n pCardinal(op)[0] := pCardinal(match)[0];\n pCardinal(op)[1] := pCardinal(match)[1];\n{$ENDIF}\n inc(op, 8);\n inc(match, 8);\n end;\n\n if cpy > oend - 12 then\n begin\n if (cpy > oend - LASTLITERALS) then\n goto _output_error;\n if (op < oend - 8) then\n begin\n LZ4_wildCopy(op, match, oend - 8);\n inc(match, (oend - 8) - op);\n op := oend - 8;\n end;\n while (op < cpy) do\n begin\n op^ := match^;\n inc(op);\n inc(match);\n end;\n end\n else\n LZ4_wildCopy(op, match, cpy);\n op := cpy;\n end;\n if (endOnInput <> 0) then\n result := integer(op - pByte(dest))\n else\n result := integer(ip - pByte(source));\n exit;\n_output_error:\n result := -(ip - pByte(source)) - 1;\nend;\n\nfunction LZ4_decompress_safe(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxDecompressedSize: integer): integer;\nbegin\n result := LZ4_decompress_generic(source, dest, compressedSize, maxDecompressedSize, integer(endOnInputSize), integer(full), 0,\n integer(noDict), pByte(dest), nil, 0);\nend;\n\nfunction LZ4_createStream: PLZ4_stream_t;\nbegin\n result := allocmem(8 * LZ4_STREAMSIZE_U64);\nend;\n\nprocedure LZ4_freeStream(LZ4_streamPtr: PLZ4_stream_t);\nbegin\n freemem(LZ4_streamPtr);\nend;\n\nfunction LZ4_createStreamDecode: PLZ4_streamDecode_t;\nbegin\n result := allocmem(sizeof(uint64) * LZ4_STREAMDECODESIZE_U64);\nend;\n\nprocedure LZ4_freeStreamDecode(LZ4_stream: PLZ4_streamDecode_t);\nbegin\n freemem(LZ4_stream);\nend;\n\nprocedure LZ4_renormDictT(LZ4_dict: PLZ4_stream_t_internal; src: pByte);\nvar\n delta: cardinal;\n dictEnd: pByte;\n i: integer;\nbegin\n if (LZ4_dict.currentOffset > $80000000) or\n (size_t(LZ4_dict.currentOffset) > size_t(src)) then\n begin\n delta := LZ4_dict.currentOffset - 65536;\n dictEnd := LZ4_dict.dictionary + LZ4_dict.dictSize;\n for i := 0 to HASH_SIZE_U32 - 1 do\n begin\n if (LZ4_dict.hashTable[i] < delta) then\n LZ4_dict.hashTable[i] := 0\n else\n dec(LZ4_dict.hashTable[i], delta);\n end;\n LZ4_dict.currentOffset := 65536;\n if (LZ4_dict.dictSize > 65536) then\n LZ4_dict.dictSize := 65536;\n LZ4_dict.dictionary := dictEnd - LZ4_dict.dictSize;\n end;\nend;\n\nfunction LZ4_compress_continue_generic(LZ4_stream: pointer; source: pointer; dest: pointer; inputSize: integer; maxOutputSize: integer;\n limit: limitedOutput_directive): integer; inline;\nvar\n streamPtr: PLZ4_stream_t_internal;\n dictEnd: pByte;\n smallest: pByte;\n sourceEnd: pByte;\n res: integer;\nbegin\n streamPtr := PLZ4_stream_t_internal(LZ4_stream);\n dictEnd := streamPtr.dictionary + streamPtr.dictSize;\n smallest := pByte(source);\n if (streamPtr.initCheck <> 0) then\n exit(0);\n if (streamPtr.dictSize > 0) and (smallest > dictEnd) then\n smallest := dictEnd;\n LZ4_renormDictT(streamPtr, smallest);\n sourceEnd := pByte(source) + inputSize;\n if (sourceEnd > streamPtr.dictionary) and (sourceEnd < dictEnd) then\n begin\n streamPtr.dictSize := cardinal(dictEnd - sourceEnd);\n if (streamPtr.dictSize > 65536) then\n streamPtr.dictSize := 65536;\n if (streamPtr.dictSize < 4) then\n streamPtr.dictSize := 0;\n streamPtr.dictionary := dictEnd - streamPtr.dictSize;\n end;\n if dictEnd = pByte(source) then\n begin\n if (streamPtr.dictSize < 65536) and (streamPtr.dictSize < streamPtr.currentOffset) then\n res := LZ4_compress_generic(LZ4_stream, source, dest, inputSize, maxOutputSize, limit, byU32, withPrefix64k, dictSmall)\n else\n res := LZ4_compress_generic(LZ4_stream, source, dest, inputSize, maxOutputSize, limit, byU32, withPrefix64k, noDictIssue);\n inc(streamPtr.dictSize, cardinal(inputSize));\n inc(streamPtr.currentOffset, cardinal(inputSize));\n exit(res);\n end;\n if (streamPtr.dictSize < 65536) and (streamPtr.dictSize < streamPtr.currentOffset) then\n res := LZ4_compress_generic(LZ4_stream, source, dest, inputSize, maxOutputSize, limit, byU32, usingExtDict, dictSmall)\n else\n res := LZ4_compress_generic(LZ4_stream, source, dest, inputSize, maxOutputSize, limit, byU32, usingExtDict, noDictIssue);\n streamPtr.dictionary := pByte(source);\n streamPtr.dictSize := cardinal(inputSize);\n inc(streamPtr.currentOffset, cardinal(inputSize));\n result := res;\nend;\n\nfunction LZ4_compress_continue(LZ4_stream: pointer; const ASource: pointer; ADestination: pointer; AInputSize: integer): integer;\nbegin\n result := LZ4_compress_continue_generic(LZ4_stream, ASource, ADestination, AInputSize, 0, notLimited);\nend;\n\nfunction LZ4_saveDict(LZ4_streamPtr: PLZ4_stream_t; safeBuffer: pointer; dictSize: integer): integer;\nvar\n dict: PLZ4_stream_t_internal;\n previousDictEnd: pByte;\nbegin\n dict := PLZ4_stream_t_internal(LZ4_streamPtr);\n previousDictEnd := dict.dictionary + dict.dictSize;\n if cardinal(dictSize) > 65536 then\n dictSize := 65536;\n if cardinal(dictSize) > dict.dictSize then\n dictSize := dict.dictSize;\n move((previousDictEnd - dictSize)^, safeBuffer^, dictSize);\n // memmove(safeBuffer, (previousDictEnd - dictSize), dictSize);\n dict.dictionary := pByte(safeBuffer);\n dict.dictSize := cardinal(dictSize);\n result := dictSize;\nend;\n\nfunction LZ4_decompress_safe_continue(LZ4_streamDecode: PLZ4_streamDecode_t; source: pointer; dest: pointer; compressedSize: integer;\n maxDecompressedSize: integer): integer;\nvar\n lz4sd: PLZ4_streamDecode_t_internal;\n res: integer;\nbegin\n lz4sd := PLZ4_streamDecode_t_internal(LZ4_streamDecode);\n if lz4sd.prefixEnd = pByte(dest) then\n begin\n res := LZ4_decompress_generic(source, dest, compressedSize, maxDecompressedSize,\n integer(endOnInputSize), integer(full), 0,\n integer(usingExtDict), lz4sd.prefixEnd - lz4sd.prefixSize, lz4sd.externalDict, lz4sd.extDictSize);\n if (res <= 0) then\n exit(res);\n inc(lz4sd.prefixSize, res);\n inc(lz4sd.prefixEnd, res);\n end\n else\n begin\n lz4sd.extDictSize := lz4sd.prefixSize;\n lz4sd.externalDict := lz4sd.prefixEnd - lz4sd.extDictSize;\n res := LZ4_decompress_generic(source, dest, compressedSize, maxDecompressedSize,\n integer(endOnInputSize), integer(full), 0,\n integer(usingExtDict), pByte(dest), lz4sd.externalDict, lz4sd.extDictSize);\n if (res <= 0) then\n exit(res);\n lz4sd.prefixSize := res;\n lz4sd.prefixEnd := pByte(dest) + res;\n end;\n result := res;\nend;\n\nprocedure LZ4_init(lz4ds: PLZ4_stream_t_internal; base: pByte);\nbegin\n fillchar(lz4ds^, LZ4_STREAMSIZE, 0);\n lz4ds.bufferStart := base;\nend;\n\nfunction LZ4_create(inputBuffer: pAnsiChar): pointer;\nvar\n lz4ds: pointer;\nbegin\n lz4ds := allocmem(8 * LZ4_STREAMSIZE_U64);\n LZ4_init(PLZ4_stream_t_internal(lz4ds), pByte(inputBuffer));\n result := lz4ds;\nend;\n\nfunction LZ4_compress_limitedOutput(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; maxOutputSize: integer): integer;\nvar\n ctx: array [0 .. LZ4_STREAMSIZE_U64 - 1] of uint64;\nbegin\n fillchar(ctx, sizeof(ctx), 0);\n if inputSize < LZ4_64Klimit then\n result := LZ4_compress_generic(@ctx, source, dest, inputSize, maxOutputSize, limitedOutput, byU16, noDict, noDictIssue)\n else\n begin\n{$IFDEF WIN64}\n result := LZ4_compress_generic(@ctx, source, dest, inputSize, maxOutputSize, limitedOutput, byU32, noDict, noDictIssue);\n{$ELSE}\n result := LZ4_compress_generic(@ctx, source, dest, inputSize, maxOutputSize, limitedOutput, byPtr, noDict, noDictIssue);\n{$ENDIF}\n end;\nend;\n\nfunction LZ4_compress_withState(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nbegin\n if ((size_t(state) and 3) <> 0) then\n exit(0); // Error : state is not aligned on 4-bytes boundary\n fillchar(state^, LZ4_STREAMSIZE, 0);\n if inputSize < LZ4_64Klimit then\n result := LZ4_compress_generic(state, source, dest, inputSize, 0, notLimited, byU16, noDict, noDictIssue)\n else\n begin\n{$IFDEF WIN64}\n result := LZ4_compress_generic(state, source, dest, inputSize, 0, notLimited, byU32, noDict, noDictIssue);\n{$ELSE}\n result := LZ4_compress_generic(state, source, dest, inputSize, 0, notLimited, byPtr, noDict, noDictIssue);\n{$ENDIF}\n end;\nend;\n\nfunction LZ4_compress_limitedOutput_withState(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer): integer;\nbegin\n if ((size_t(state) and 3) <> 0) then\n exit(0); // Error : state is not aligned on 4-bytes boundary\n fillchar(state^, LZ4_STREAMSIZE, 0);\n if inputSize < LZ4_64Klimit then\n result := LZ4_compress_generic(state, source, dest, inputSize, maxOutputSize, limitedOutput, byU16, noDict, noDictIssue)\n else\n begin\n{$IFDEF WIN64}\n result := LZ4_compress_generic(state, source, dest, inputSize, maxOutputSize, limitedOutput, byU32, noDict, noDictIssue);\n{$ELSE}\n result := LZ4_compress_generic(state, source, dest, inputSize, maxOutputSize, limitedOutput, byPtr, noDict, noDictIssue);\n{$ENDIF}\n end;\nend;\n\nfunction LZ4_compress_limitedOutput_continue(LZ4_stream: PLZ4_stream_t; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer): integer;\nbegin\n result := LZ4_compress_continue_generic(LZ4_stream, source, dest, inputSize, maxOutputSize, limitedOutput);\nend;\n\nfunction LZ4_compress_forceExtDict(LZ4_dict: PLZ4_stream_t; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nvar\n streamPtr: PLZ4_stream_t_internal;\n dictEnd: pByte;\n smallest: pByte;\nbegin\n streamPtr := PLZ4_stream_t_internal(LZ4_dict);\n dictEnd := streamPtr.dictionary + streamPtr.dictSize;\n smallest := dictEnd;\n if smallest > pByte(source) then\n smallest := pByte(source);\n LZ4_renormDictT(PLZ4_stream_t_internal(LZ4_dict), smallest);\n result := LZ4_compress_generic(LZ4_dict, source, dest, inputSize, 0, notLimited, byU32, usingExtDict, noDictIssue);\n streamPtr.dictionary := pByte(source);\n streamPtr.dictSize := cardinal(inputSize);\n inc(streamPtr.currentOffset, cardinal(inputSize));\nend;\n\nprocedure LZ4_resetStream(LZ4_stream: PLZ4_stream_t);\nbegin\n fillchar(LZ4_stream^, sizeof(LZ4_stream_t), 0);\nend;\n\nfunction LZ4_loadDict(LZ4_dict: PLZ4_stream_t; dictionary: pAnsiChar; dictSize: integer): integer;\nvar\n dict: PLZ4_stream_t_internal;\n p: pByte;\n dictEnd: pByte;\n base: pByte;\nbegin\n dict := PLZ4_stream_t_internal(LZ4_dict);\n p := pByte(dictionary);\n dictEnd := p + dictSize;\n if (dict.initCheck <> 0) then\n LZ4_resetStream(LZ4_dict); // Uninitialized structure detected\n if dictSize < MINMATCH then\n begin\n dict.dictionary := Nil;\n dict.dictSize := 0;\n exit(0);\n end;\n if (p <= dictEnd - 65536) then\n p := dictEnd - 65536;\n base := p - dict.currentOffset;\n dict.dictionary := p;\n dict.dictSize := cardinal(dictEnd - p);\n inc(dict.currentOffset, dict.dictSize);\n while (p <= dictEnd - MINMATCH) do\n begin\n LZ4_putPosition(p, dict, byU32, base);\n inc(p, 3);\n end;\n\n result := dict.dictSize;\nend;\n\nfunction LZ4_decompress_fast(source: pAnsiChar; dest: pAnsiChar; originalSize: integer): integer;\nbegin\n result := LZ4_decompress_generic(source, dest, 0, originalSize, integer(endOnOutputSize), integer(full), 0, integer(withPrefix64k),\n pByte(dest - 65536), Nil, 65536);\nend;\n\nfunction LZ4_decompress_fast_withPrefix64k(source: pAnsiChar; dest: pAnsiChar; originalSize: integer): integer;\nbegin\n result := LZ4_decompress_generic(source, dest, 0, originalSize, integer(endOnOutputSize), integer(full), 0, integer(withPrefix64k),\n pByte(dest) - 65536, Nil, 65536);\nend;\n\nfunction LZ4_decompress_usingDict_generic(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer;\n safe: integer; dictStart: pAnsiChar; dictSize: integer): integer; inline;\nbegin\n if dictSize = 0 then\n exit(LZ4_decompress_generic(source, dest, compressedSize, maxOutputSize, safe, integer(full), 0, integer(noDict),\n pByte(dest), Nil, 0));\n if (dictStart + dictSize = dest) then\n begin\n if dictSize >= integer(65536 - 1) then\n exit(LZ4_decompress_generic(source, dest, compressedSize, maxOutputSize, safe, integer(full), 0, integer(withPrefix64k),\n pByte(dest) - 65536, Nil, 0));\n exit(LZ4_decompress_generic(source, dest, compressedSize, maxOutputSize, safe, integer(full), 0, integer(noDict),\n pByte(dest) - dictSize, Nil, 0));\n end;\n result := LZ4_decompress_generic(source, dest, compressedSize, maxOutputSize, safe, integer(full), 0, integer(usingExtDict),\n pByte(dest), pByte(dictStart), dictSize);\nend;\n\nfunction LZ4_decompress_fast_usingDict(source: pAnsiChar; dest: pAnsiChar; originalSize: integer; const dictStart: pAnsiChar;\n dictSize: integer): integer;\nbegin\n result := LZ4_decompress_usingDict_generic(source, dest, 0, originalSize, 0, dictStart, dictSize);\nend;\n\nfunction LZ4_decompress_safe_withPrefix64k(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer): integer;\nbegin\n result := LZ4_decompress_generic(source, dest, compressedSize, maxOutputSize, integer(endOnInputSize), integer(full), 0,\n integer(withPrefix64k), pByte(dest) - 65536, Nil, 65536);\nend;\n\nfunction LZ4_decompress_safe_usingDict(const source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer;\n const dictStart: pAnsiChar; dictSize: integer): integer;\nbegin\n result := LZ4_decompress_usingDict_generic(source, dest, compressedSize, maxOutputSize, 1, dictStart, dictSize);\nend;\n\nfunction LZ4_decompress_safe_partial(const source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; targetOutputSize: integer;\n maxDecompressedSize: integer): integer;\nbegin\n result := LZ4_decompress_generic(source, dest, compressedSize, maxDecompressedSize, integer(endOnInputSize), integer(partial),\n targetOutputSize, integer(noDict), pByte(dest), Nil, 0);\nend;\n\nfunction LZ4_decompress_safe_forceExtDict(source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxOutputSize: integer;\n const dictStart: pAnsiChar; dictSize: integer): integer;\nbegin\n result := LZ4_decompress_generic(source, dest, compressedSize, maxOutputSize, integer(endOnInputSize), integer(full), 0,\n integer(usingExtDict), pByte(dest), pByte(dictStart), dictSize);\nend;\n\nend.\n"
},
{
"path": "lib/xedit/lz4/lz4Common.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\n\nunit lz4common;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows;\n\ntype\n ppByte = ^pByte;\n {$IFDEF WIN32}\n size_t = Cardinal;\n {$ENDIF WIN32}\n {$IFDEF WIN64}\n size_t = UInt64;\n {$ENDIF WIN64}\n psize_t = ^size_t;\n\nconst\n MINMATCH = 4;\n COPYLENGTH = 8;\n LASTLITERALS = 5;\n _MFLIMIT = COPYLENGTH + MINMATCH;\n MAXD_LOG = 16;\n MAX_DISTANCE = (1 shl MAXD_LOG) - 1;\n STEPSIZE = sizeof(size_t);\n ML_BITS = 4;\n ML_MASK = (1 shl ML_BITS) - 1;\n RUN_BITS = 8 - ML_BITS;\n RUN_MASK = (1 shl RUN_BITS) - 1;\n\nfunction LZ4_read32(const memPtr: pointer): cardinal;\nfunction LZ4_read64(const memPtr: pointer): uint64; inline;\nfunction LZ4_count(pIn: pByte; pMatch: pByte; const pInLimit: pByte): cardinal;\nfunction LZ4_read_ARCH(const p: pointer): size_t; inline;\nfunction LZ4_read16(const memPtr: pointer): word; inline;\nprocedure LZ4_writeLE16(memPtr: pointer; value: word); inline;\nprocedure LZ4_wildCopy(dstPtr: pointer; const srcPtr: pointer; dstEnd: pointer);\n\nimplementation\n\nfunction LZ4_read32(const memPtr: pointer): cardinal;\nbegin\n result := pCardinal(memPtr)^;\nend;\n\n{$IFDEF WIN64}\n\n\nfunction LZ4_NbCommonBytesx64(value: size_t): cardinal;\nasm\n bsf rax, rcx // value comes in rcx register\n shr eax, 3\nend;\n{$ENDIF}\n\n\nfunction LZ4_count(pIn: pByte; pMatch: pByte; const pInLimit: pByte): cardinal;\nvar\n pStart: pByte;\n diff: size_t;\n incValue: cardinal;\n\n calcedPByte: pByte;\nbegin\n pStart := pIn;\n calcedPByte := pInLimit - (STEPSIZE - 1);\n\n while pIn < calcedPByte do\n begin\n diff := LZ4_read_ARCH(pMatch) xor LZ4_read_ARCH(pIn);\n if (diff = 0) then\n begin\n inc(pIn, STEPSIZE);\n inc(pMatch, STEPSIZE);\n continue;\n end;\n{$IFDEF WIN32}\n asm\n bsf eax, diff\n shr eax, 3\n mov incValue, eax\n end;\n{$ELSE}\n incValue := LZ4_NbCommonBytesx64(diff); // x64 mode does not allow asm inline\n{$ENDIF}\n inc(pIn, incValue);\n exit(cardinal(pIn - pStart));\n end;\n{$IFDEF WIN64}\n if (pIn < (pInLimit - 3)) and (pCardinal(pMatch)^ = pCardinal(pIn)^) then\n begin\n inc(pIn, 4);\n inc(pMatch, 4);\n end;\n{$ENDIF}\n if ((pIn < (pInLimit - 1)) and (pWord(pMatch)^ = pWord(pIn)^)) then\n begin\n inc(pIn, 2);\n inc(pMatch, 2);\n end;\n if ((pIn < pInLimit) and (pMatch^ = pIn^)) then\n inc(pIn);\n result := cardinal(pIn - pStart);\nend;\n\nfunction LZ4_read_ARCH(const p: pointer): size_t; inline;\nbegin\n{$IFDEF WIN64}\n result := size_t(pUint64(p)^)\n{$ELSE}\n result := size_t(pCardinal(p)^);\n{$ENDIF}\nend;\n\nfunction LZ4_read16(const memPtr: pointer): word; inline;\nbegin\n result := pWord(memPtr)^;\nend;\n\nfunction LZ4_read64(const memPtr: pointer): uint64; inline;\nbegin\n result := pUint64(memPtr)^;\nend;\n\n{$IFDEF WILDCOPY_ASM}\n{$IFDEF WIN32}\n\n\nprocedure LZ4_wildCopy; // (dstPtr: pointer; const srcPtr: pointer; dstEnd: pointer);\nasm\n push edi\n push esi\n mov edi, eax\n mov esi, edx\n // copyCount := (((e - d) - 1) div 8) * 8 + 8;\n sub ecx, eax // (e - d)\n dec ecx\t\t // e - d) - 1)\n shr ecx, 3 // ((e - d) - 1) div 8)\n shl ecx, 3\t // ((e - d) - 1) div 8) * 8\n add ecx, 8 // ((e - d) - 1) div 8) * 8 + 8\n\n // if copyCount <= 0 then\n // copyCount := 8;\n mov eax, 8\n cmp ecx, 0\n cmovbe ecx, eax\n shr ecx, 2\n rep movsd\n pop esi\n pop edi\nend;\n\n{$ELSE}\n\n\nprocedure LZ4_wildCopy; // (dstPtr: pointer; const srcPtr: pointer; dstEnd: pointer);\nasm\n mov r10, rdi\n mov r11, rsi\n mov rdi, rcx\n mov rsi, rdx\n // copyCount := (((e - d) - 1) div 8) * 8 + 8;\n sub r8, rcx // (dstEnd - dest)\n mov rax, 8\n dec r8\t\t // e - d) - 1)\n shr r8, 3\t // ((e - d) - 1) div 8)\n shl r8, 3\t // ((e - d) - 1) div 8) * 8\n add r8, rax\t // ((e - d) - 1) div 8) * 8 + 8\n cmp r8, 0\n cmovbe r8, rax\n mov rcx, r8\n shr rcx, 3\n rep movsq\n mov rdi, r10\n mov rsi, r11\nend;\n{$ENDIF}\n{$ELSE}\n\n\nprocedure LZ4_wildCopy(dstPtr: pointer; const srcPtr: pointer; dstEnd: pointer); inline;\nvar\n d: pByte;\n s: pByte;\n e: pByte;\nbegin\n d := dstPtr;\n s := srcPtr;\n e := dstEnd;\n repeat\n{$IFDEF WIN32}\n pCardinal(d)[0] := pCardinal(s)[0];\n pCardinal(d)[1] := pCardinal(s)[1];\n{$ELSE}\n pUint64(d)^ := pUint64(s)^;\n{$ENDIF}\n inc(d, 8);\n inc(s, 8);\n until not(d < e);\nend;\n\n{$ENDIF}\n\n\nprocedure LZ4_writeLE16(memPtr: pointer; value: word); inline;\nbegin\n pWord(memPtr)^ := value;\n\nend;\n\nend.\n"
},
{
"path": "lib/xedit/lz4/lz4HC.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\n\nunit lz4HC;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows, lz4Common;\n\nconst\n LZ4_STREAMHCSIZE_U64 = 32774;\n\ntype\n PLZ4_streamHC_t = ^LZ4_streamHC_t;\n\n LZ4_streamHC_t = record\n table: array [0 .. LZ4_STREAMHCSIZE_U64 - 1] of uint64;\n end;\n\nfunction LZ4_createStreamHC: PLZ4_streamHC_t;\nprocedure LZ4_freeStreamHC(LZ4_streamHCPtr: PLZ4_streamHC_t);\nfunction LZ4_compressHC2(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; compressionLevel: integer): integer;\nfunction LZ4_compressHC(source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nfunction LZ4_compressHC_limitedOutput(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; maxOutputSize: integer): integer;\nfunction LZ4_compressHC2_limitedOutput(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; maxOutputSize: integer;\n compressionLevel: integer): integer;\nfunction LZ4_compressHC_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nfunction LZ4_compressHC2_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n compressionLevel: integer): integer;\nfunction LZ4_compressHC_limitedOutput_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer): integer;\nfunction LZ4_compressHC2_limitedOutput_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer; compressionLevel: integer): integer;\nfunction LZ4_createHC(inputBuffer: pAnsiChar): pointer;\nfunction LZ4_compressHC_continue(LZ4_streamHCPtr: PLZ4_streamHC_t; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nfunction LZ4_loadDictHC(LZ4_streamHCPtr: PLZ4_streamHC_t; dictionary: pAnsiChar; dictSize: integer): integer;\nfunction LZ4_compressHC_limitedOutput_continue(LZ4_streamHCPtr: PLZ4_streamHC_t; const source: pAnsiChar; dest: pAnsiChar;\n inputSize: integer; maxOutputSize: integer): integer;\nprocedure LZ4_resetStreamHC(LZ4_streamHCPtr: PLZ4_streamHC_t; compressionLevel: integer);\nfunction LZ4_saveDictHC(LZ4_streamHCPtr: PLZ4_streamHC_t; safeBuffer: pAnsiChar; dictSize: integer): integer;\n\nimplementation\n\nconst\n DICTIONARY_LOGSIZE = 16;\n MAXD = (1 shl DICTIONARY_LOGSIZE);\n HASH_LOG = (DICTIONARY_LOGSIZE - 1);\n HASHTABLESIZE = (1 shl HASH_LOG);\n OPTIMAL_ML = integer((ML_MASK - 1) + MINMATCH);\n\n g_maxCompressionLevel: integer = 16;\n LZ4HC_compressionLevel_default: integer = 8;\n\ntype\n PLZ4HC_Data_Structure = ^LZ4HC_Data_Structure;\n\n LZ4HC_Data_Structure = record\n hashTable: array [0 .. HASHTABLESIZE - 1] of cardinal;\n chainTable: array [0 .. MAXD - 1] of word;\n _end: pByte;\n base: pByte;\n dictBase: pByte;\n inputBuffer: pByte;\n dictLimit: cardinal;\n lowLimit: cardinal;\n nextToUpdate: cardinal;\n compressionLevel: cardinal;\n end;\n\n limitedOutput_directive = (noLimit = 0, limitedOutput = 1);\n\nfunction LZ4_createStreamHC: PLZ4_streamHC_t;\nbegin\n result := allocmem(sizeof(LZ4_streamHC_t));\nend;\n\nprocedure LZ4_freeStreamHC(LZ4_streamHCPtr: PLZ4_streamHC_t);\nbegin\n freemem(LZ4_streamHCPtr);\nend;\n\nprocedure LZ4HC_init(hc4: PLZ4HC_Data_Structure; const start: pByte);\nbegin\n fillchar(hc4.hashTable, sizeof(hc4.hashTable), 0);\n fillchar(hc4.chainTable, sizeof(hc4.chainTable), 255);\n hc4.nextToUpdate := 65536;\n hc4.base := start - 65536;\n hc4.inputBuffer := start;\n hc4._end := start;\n hc4.dictBase := start - 65536;\n hc4.dictLimit := 65536;\n hc4.lowLimit := 65536;\nend;\n\nfunction HASH_FUNCTION(i: cardinal): cardinal; inline;\nbegin\n result := (i * 2654435761) shr ((MINMATCH * 8) - HASH_LOG);\nend;\n\nfunction LZ4HC_hashPtr(const ptr: pointer): cardinal; inline;\nbegin\n result := HASH_FUNCTION(pCardinal(ptr)^);\nend;\n\nprocedure LZ4HC_Insert(hc4: PLZ4HC_Data_Structure; const ip: pByte); inline;\nvar\n chainTable: pWord;\n hashTable: pCardinal;\n base: pByte;\n target: cardinal;\n idx: cardinal;\n h: cardinal;\n delta: size_t;\nbegin\n chainTable := @hc4.chainTable;\n hashTable := @hc4.hashTable;\n base := hc4.base;\n target := cardinal(ip - base);\n idx := hc4.nextToUpdate;\n\n while idx < target do\n begin\n h := LZ4HC_hashPtr(base + idx);\n delta := idx - hashTable[h];\n if (delta > MAX_DISTANCE) then\n delta := MAX_DISTANCE;\n chainTable[idx and $FFFF] := word(delta);\n hashTable[h] := idx;\n inc(idx);\n end;\n hc4.nextToUpdate := target;\nend;\n\nfunction LZ4HC_InsertAndFindBestMatch(hc4: PLZ4HC_Data_Structure; const ip: pByte; const iLimit: pByte;\n const matchpos: ppByte; const maxNbAttempts: integer): integer; inline;\nvar\n chainTable: pWord;\n hashTable: pCardinal;\n base: pByte;\n dictBase: pByte;\n dictLimit: cardinal;\n lowLimit: cardinal;\n matchIndex: cardinal;\n match: pByte;\n nbAttempts: integer;\n ml: size_t;\n mlt: size_t;\n vLimit: pByte;\nbegin\n chainTable := @hc4.chainTable;\n hashTable := @hc4.hashTable;\n base := hc4.base;\n dictBase := hc4.dictBase;\n dictLimit := hc4.dictLimit;\n if hc4.lowLimit + 65536 > cardinal(ip - base) then\n lowLimit := hc4.lowLimit\n else\n lowLimit := cardinal(ip - base) - 65535;\n nbAttempts := maxNbAttempts;\n ml := 0;\n LZ4HC_Insert(hc4, ip);\n matchIndex := hashTable[LZ4HC_hashPtr(ip)];\n while (matchIndex >= lowLimit) and (nbAttempts > 0) do\n begin\n dec(nbAttempts);\n if matchIndex >= dictLimit then\n begin\n match := base + matchIndex;\n if ((match + ml)^ = (ip + ml)^) and (pCardinal(match)^ = pCardinal(ip)^) then\n begin\n mlt := LZ4_count(ip + MINMATCH, match + MINMATCH, iLimit) + MINMATCH;\n if mlt > ml then\n begin\n ml := mlt;\n matchpos^ := match;\n end;\n end;\n end\n else\n begin\n match := dictBase + matchIndex;\n if pCardinal(match)^ = pCardinal(ip)^ then\n begin\n vLimit := ip + (dictLimit - matchIndex);\n if (vLimit > iLimit) then\n vLimit := iLimit;\n mlt := LZ4_count(ip + MINMATCH, match + MINMATCH, vLimit) + MINMATCH;\n if ((ip + mlt = vLimit) and (vLimit < iLimit)) then\n inc(mlt, LZ4_count(ip + mlt, base + dictLimit, iLimit));\n if (mlt > ml) then\n begin\n ml := mlt;\n matchpos^ := base + matchIndex;\n end; // virtual matchpos\n end;\n end;\n dec(matchIndex, chainTable[matchIndex and $FFFF]);\n end;\n result := integer(ml);\nend;\n\nfunction LZ4HC_InsertAndGetWiderMatch(hc4: PLZ4HC_Data_Structure; const ip: pByte; const iLowLimit: pByte;\n const iHighLimit: pByte; longest: integer; const matchpos: ppByte; const startpos: ppByte; const maxNbAttempts: integer): integer; inline;\nvar\n chainTable: pWord;\n hashTable: pCardinal;\n base: pByte;\n dictLimit: cardinal;\n lowLimit: cardinal;\n dictBase: pByte;\n match: pByte;\n matchIndex: cardinal;\n nbAttempts: integer;\n delta: integer;\n startt: pByte;\n tmpMatch: pByte;\n matchEnd: pByte;\n mlt: size_t;\n back: integer;\n vLimit: pByte;\nbegin\n chainTable := @hc4.chainTable;\n hashTable := @hc4.hashTable;\n base := hc4.base;\n dictLimit := hc4.dictLimit;\n if (hc4.lowLimit + 65536 > cardinal(ip - base)) then\n lowLimit := hc4.lowLimit\n else\n lowLimit := cardinal(ip - base) - 65535;\n dictBase := hc4.dictBase;\n nbAttempts := maxNbAttempts;\n delta := integer(ip - iLowLimit);\n LZ4HC_Insert(hc4, ip);\n matchIndex := hashTable[LZ4HC_hashPtr(ip)];\n while (matchIndex >= lowLimit) and (nbAttempts > 0) do\n begin\n dec(nbAttempts);\n if matchIndex >= dictLimit then\n begin\n match := base + matchIndex;\n if ((iLowLimit + longest)^ = (match - delta + longest)^) then\n if pCardinal(match)^ = pCardinal(ip)^ then\n begin\n startt := ip;\n tmpMatch := match;\n matchEnd := ip + MINMATCH + LZ4_count(ip + MINMATCH, match + MINMATCH, iHighLimit);\n while (startt > iLowLimit) and (tmpMatch > iLowLimit) and (startt[-1] = tmpMatch[-1]) do\n begin\n dec(startt);\n dec(tmpMatch);\n end;\n if (matchEnd - startt) > longest then\n begin\n longest := integer(matchEnd - startt);\n matchpos^ := tmpMatch;\n startpos^ := startt;\n end;\n end;\n end\n else\n begin\n match := dictBase + matchIndex;\n if pCardinal(match)^ = pCardinal(ip)^ then\n begin\n back := 0;\n vLimit := ip + (dictLimit - matchIndex);\n if vLimit > iHighLimit then\n vLimit := iHighLimit;\n mlt := LZ4_count(ip + MINMATCH, match + MINMATCH, vLimit) + MINMATCH;\n if (ip + mlt = vLimit) and (vLimit < iHighLimit) then\n inc(mlt, LZ4_count(ip + mlt, base + dictLimit, iHighLimit));\n while ((ip + back > iLowLimit) and (matchIndex + cardinal(back) > lowLimit) and (ip[back - 1] = match[back - 1])) do\n dec(back);\n dec(mlt, back);\n if integer(mlt) > longest then\n begin\n longest := integer(mlt);\n matchpos^ := base + matchIndex + back;\n startpos^ := ip + back;\n end;\n end;\n end;\n dec(matchIndex, chainTable[matchIndex and $FFFF]);\n end;\n result := longest;\nend;\n\nfunction LZ4HC_encodeSequence(const ip: ppByte; op: ppByte; const anchor: ppByte; matchLength: integer;\n const match: pByte; limitedOutputBuffer: limitedOutput_directive; oend: pByte): integer; inline;\nvar\n length: integer;\n token: pByte;\n len: integer;\nbegin\n length := integer(ip^ - anchor^);\n token := op^;\n inc(op^);\n if (limitedOutputBuffer <> noLimit) and ((op^ + (length shr 8) + length + (2 + 1 + LASTLITERALS)) > oend) then\n exit(1);\n\n if length >= integer(RUN_MASK) then\n begin\n token^ := (RUN_MASK shl ML_BITS);\n len := length - RUN_MASK;\n while len > 254 do\n begin\n op^^ := 255;\n inc(op^);\n dec(len, 255)\n end;\n op^^ := byte(len);\n inc(op^);\n end\n else\n token^ := byte(length shl ML_BITS);\n\n LZ4_wildCopy(op^, anchor^, op^ + length);\n\n inc(op^, length);\n pWord(op^)^ := word(ip^ - match); // ?\n inc(op^, 2);\n\n length := integer(matchLength - MINMATCH);\n if (limitedOutputBuffer <> noLimit) and (op^ + (length shr 8) + (1 + LASTLITERALS) > oend) then\n exit(1);\n if length >= integer(ML_MASK) then\n begin\n inc(token^, ML_MASK);\n dec(length, ML_MASK);\n while length > 509 do\n begin\n op^^ := 255;\n inc(op^);\n op^^ := 255;\n inc(op^);\n dec(length, 510);\n end;\n if (length > 254) then\n begin\n dec(length, 255);\n op^^ := 255;\n inc(op^);\n end;\n op^^ := byte(length);\n inc(op^);\n end\n else\n inc(token^, byte(length));\n inc(ip^, matchLength);\n anchor^ := ip^;\n result := 0;\nend;\n\nfunction LZ4HC_compress_generic(ctxvoid: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer; compressionLevel: integer; limit: limitedOutput_directive): integer;\nvar\n ctx: PLZ4HC_Data_Structure;\n ip: pByte;\n anchor: pByte;\n iend: pByte;\n mflimit: pByte;\n matchlimit: pByte;\n op: pByte;\n oend: pByte;\n maxNbAttempts: cardinal;\n ml, ml2, ml3, ml0: integer;\n ref: pByte;\n start2: pByte;\n ref2: pByte;\n start3: pByte;\n ref3: pByte;\n start0: pByte;\n ref0: pByte;\n correction: integer;\n new_ml: integer;\n lastRun: integer;\nlabel\n _Search2, _Search3;\nbegin\n ctx := ctxvoid;\n ip := pByte(source);\n anchor := ip;\n iend := ip + inputSize;\n mflimit := iend - _MFLIMIT;\n matchlimit := (iend - LASTLITERALS);\n op := pByte(dest);\n oend := op + maxOutputSize;\n ref := nil;\n start2 := nil;\n ref2 := nil;\n start3 := nil;\n ref3 := nil;\n\n // init\n if compressionLevel > g_maxCompressionLevel then\n compressionLevel := g_maxCompressionLevel;\n if (compressionLevel < 1) then\n compressionLevel := LZ4HC_compressionLevel_default;\n maxNbAttempts := 1 shl (compressionLevel - 1);\n inc(ctx._end, inputSize);\n inc(ip);\n\n // Main Loop\n while ip < mflimit do\n begin\n ml := LZ4HC_InsertAndFindBestMatch(ctx, ip, matchlimit, (@ref), maxNbAttempts);\n if (ml = 0) then\n begin\n inc(ip);\n continue;\n end;\n\n // saved, in case we would skip too much\n start0 := ip;\n ref0 := ref;\n ml0 := ml;\n _Search2:\n\n if ip + ml < mflimit then\n ml2 := LZ4HC_InsertAndGetWiderMatch(ctx, ip + ml - 2, ip + 1, matchlimit, ml, @ref2, @start2, maxNbAttempts)\n else\n ml2 := ml;\n\n if (ml2 = ml) then // No better match\n begin\n if LZ4HC_encodeSequence(@ip, @op, @anchor, ml, ref, limit, oend) > 0 then\n exit(0);\n continue;\n end;\n\n if start0 < ip then\n begin\n if start2 < ip + ml0 then // empirical\n begin\n ip := start0;\n ref := ref0;\n ml := ml0;\n end;\n end;\n\n // Here, start0==ip\n if ((start2 - ip) < 3) then // First Match too small : removed\n begin\n ml := ml2;\n ip := start2;\n ref := ref2;\n goto _Search2;\n end;\n\n _Search3:\n\n if (start2 - ip) < OPTIMAL_ML then\n begin\n new_ml := ml;\n if new_ml > OPTIMAL_ML then\n new_ml := OPTIMAL_ML;\n if ip + new_ml > start2 + ml2 - MINMATCH then\n new_ml := integer(start2 - ip) + ml2 - MINMATCH;\n correction := new_ml - integer(start2 - ip);\n if (correction > 0) then\n begin\n inc(start2, correction);\n inc(ref2, correction);\n dec(ml2, correction);\n end;\n end;\n // Now, we have start2 = ip+new_ml, with new_ml = min(ml, OPTIMAL_ML=18)\n\n if start2 + ml2 < mflimit then\n ml3 := LZ4HC_InsertAndGetWiderMatch(ctx, start2 + ml2 - 3, start2, matchlimit, ml2, @ref3, @start3, maxNbAttempts)\n else\n ml3 := ml2;\n\n if (ml3 = ml2) then // No better match : 2 sequences to encode\n begin\n // ip & ref are known; Now for ml\n if start2 < ip + ml then\n ml := integer(start2 - ip);\n // Now, encode 2 sequences\n if LZ4HC_encodeSequence(@ip, @op, @anchor, ml, ref, limit, oend) <> 0 then\n exit(0);\n ip := start2;\n if LZ4HC_encodeSequence(@ip, @op, @anchor, ml2, ref2, limit, oend) <> 0 then\n exit(0);\n continue;\n end;\n\n if start3 < ip + ml + 3 then // Not enough space for match 2 : remove it\n begin\n if start3 >= (ip + ml) then // can write Seq1 immediately ==> Seq2 is removed, so Seq3 becomes Seq1\n begin\n if start2 < ip + ml then\n begin\n correction := integer(ip + ml - start2);\n inc(start2, correction);\n inc(ref2, correction);\n dec(ml2, correction);\n if ml2 < MINMATCH then\n begin\n start2 := start3;\n ref2 := ref3;\n ml2 := ml3;\n end;\n end;\n if LZ4HC_encodeSequence(@ip, @op, @anchor, ml, ref, limit, oend) <> 0 then\n exit(0);\n ip := start3;\n ref := ref3;\n ml := ml3;\n\n start0 := start2;\n ref0 := ref2;\n ml0 := ml2;\n goto _Search2;\n end;\n start2 := start3;\n ref2 := ref3;\n ml2 := ml3;\n goto _Search3;\n end;\n\n (*\n * OK, now we have 3 ascending matches; let's write at least the first one\n * ip & ref are known; Now for ml\n *)\n if start2 < ip + ml then\n begin\n if (start2 - ip) < integer(ML_MASK) then\n begin\n if ml > OPTIMAL_ML then\n ml := OPTIMAL_ML;\n if ip + ml > start2 + ml2 - MINMATCH then\n ml := integer(start2 - ip) + ml2 - MINMATCH;\n correction := ml - integer(start2 - ip);\n if correction > 0 then\n begin\n inc(start2, correction);\n inc(ref2, correction);\n dec(ml2, correction);\n end;\n end\n else\n ml := integer(start2 - ip);\n end;\n if LZ4HC_encodeSequence(@ip, @op, @anchor, ml, ref, limit, oend) <> 0 then\n exit(0);\n\n ip := start2;\n ref := ref2;\n ml := ml2;\n\n start2 := start3;\n ref2 := ref3;\n ml2 := ml3;\n\n goto _Search3;\n end;\n\n lastRun := integer(iend - anchor);\n if (limit <> noLimit) and ((op - pByte(dest)) + lastRun + 1 + ((lastRun + 255 - RUN_MASK) div 255) > maxOutputSize) then\n exit(0);\n if lastRun >= integer(RUN_MASK) then\n begin\n op^ := RUN_MASK shl ML_BITS;\n inc(op);\n dec(lastRun, RUN_MASK);\n while lastRun > 254 do\n begin\n op^ := 255;\n inc(op);\n dec(lastRun, 255);\n end;\n op^ := byte(lastRun);\n inc(op);\n end\n else\n begin\n op^ := byte(lastRun shl ML_BITS);\n inc(op);\n end;\n move(anchor^, op^, iend - anchor);\n inc(op, iend - anchor);\n result := integer(op - pByte(dest));\nend;\n\nfunction LZ4_compressHC2(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; compressionLevel: integer): integer;\nvar\n ctx: LZ4HC_Data_Structure;\nbegin\n fillchar(ctx, sizeof(LZ4HC_Data_Structure), 0);\n LZ4HC_init(@ctx, pByte(source));\n result := LZ4HC_compress_generic(@ctx, source, dest, inputSize, 0, compressionLevel, noLimit);\nend;\n\nfunction LZ4_compressHC(source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nbegin\n result := LZ4_compressHC2(source, dest, inputSize, 0);\nend;\n\nfunction LZ4_compressHC_limitedOutput(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; maxOutputSize: integer): integer;\nbegin\n result := LZ4_compressHC2_limitedOutput(source, dest, inputSize, maxOutputSize, 0);\nend;\n\nfunction LZ4_compressHC2_limitedOutput(const source: pAnsiChar; dest: pAnsiChar; inputSize: integer; maxOutputSize: integer;\n compressionLevel: integer): integer;\nvar\n ctx: LZ4HC_Data_Structure;\nbegin\n fillchar(ctx, sizeof(LZ4HC_Data_Structure), 0);\n LZ4HC_init(@ctx, pByte(source));\n result := LZ4HC_compress_generic(@ctx, source, dest, inputSize, maxOutputSize, compressionLevel, limitedOutput);\nend;\n\nfunction LZ4_compressHC_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nbegin\n result := LZ4_compressHC2_withStateHC(state, source, dest, inputSize, 0);\nend;\n\nfunction LZ4_compressHC2_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n compressionLevel: integer): integer;\nbegin\n if (size_t(state) and (sizeof(pointer) - 1)) <> 0 then\n exit(0); // Error : : state is not aligned for pointers (32 or 64 bits) */\n LZ4HC_init(PLZ4HC_Data_Structure(state), pByte(source));\n result := LZ4HC_compress_generic(state, source, dest, inputSize, 0, compressionLevel, noLimit);\nend;\n\nfunction LZ4_compressHC_limitedOutput_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer): integer;\nbegin\n result := LZ4_compressHC2_limitedOutput_withStateHC(state, source, dest, inputSize, maxOutputSize, 0);\nend;\n\nfunction LZ4_compressHC2_limitedOutput_withStateHC(state: pointer; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer;\n maxOutputSize: integer; compressionLevel: integer): integer;\nbegin\n if (size_t(state) and (sizeof(pointer) - 1)) <> 0 then\n exit(0); // Error : : state is not aligned for pointers (32 or 64 bits) */\n LZ4HC_init(PLZ4HC_Data_Structure(state), pByte(source));\n result := LZ4HC_compress_generic(state, source, dest, inputSize, maxOutputSize, compressionLevel, limitedOutput);\nend;\n\nfunction LZ4_createHC(inputBuffer: pAnsiChar): pointer;\nvar\n hc4: pointer;\nbegin\n hc4 := allocmem(sizeof(LZ4HC_Data_Structure));\n LZ4HC_init(PLZ4HC_Data_Structure(hc4), pByte(inputBuffer));\n result := hc4;\nend;\n\nprocedure LZ4HC_setExternalDict(ctxPtr: PLZ4HC_Data_Structure; const newBlock: pByte);\nbegin\n if ctxPtr._end >= ctxPtr.base + 4 then\n LZ4HC_Insert(ctxPtr, ctxPtr._end - 3); // Referencing remaining dictionary content\n // Only one memory segment for extDict, so any previous extDict is lost at this stage\n ctxPtr.lowLimit := ctxPtr.dictLimit;\n ctxPtr.dictLimit := cardinal(ctxPtr._end - ctxPtr.base);\n ctxPtr.dictBase := ctxPtr.base;\n ctxPtr.base := newBlock - ctxPtr.dictLimit;\n ctxPtr._end := newBlock;\n ctxPtr.nextToUpdate := ctxPtr.dictLimit; // match referencing will resume from there\nend;\n\nfunction LZ4_compressHC_continue_generic(ctxPtr: PLZ4HC_Data_Structure;\n const source: pAnsiChar; dest: pAnsiChar;\n inputSize: integer; maxOutputSize: integer; limit: limitedOutput_directive): integer;\nvar\n dictSize: size_t;\n sourceEnd: pByte;\n dictBegin: pByte;\n dictEnd: pByte;\nbegin\n // auto-init if forgotten\n if (ctxPtr.base = Nil) then\n LZ4HC_init(ctxPtr, pByte(source));\n\n // Check overflow\n if size_t(ctxPtr._end - ctxPtr.base) > 2147483648 then\n begin\n dictSize := size_t(ctxPtr._end - ctxPtr.base) - ctxPtr.dictLimit;\n if (dictSize > 65536) then\n dictSize := 65536;\n LZ4_loadDictHC(PLZ4_streamHC_t(ctxPtr), pAnsiChar(ctxPtr._end) - dictSize, integer(dictSize));\n end;\n\n // Check if blocks follow each other\n if (pByte(source) <> ctxPtr._end) then\n LZ4HC_setExternalDict(ctxPtr, pByte(source));\n\n // Check overlapping input/dictionary space\n sourceEnd := pByte(source) + inputSize;\n dictBegin := ctxPtr.dictBase + ctxPtr.lowLimit;\n dictEnd := ctxPtr.dictBase + ctxPtr.dictLimit;\n if (sourceEnd > dictBegin) and (pByte(source) < dictEnd) then\n begin\n if sourceEnd > dictEnd then\n sourceEnd := dictEnd;\n ctxPtr.lowLimit := cardinal(sourceEnd - ctxPtr.dictBase);\n if ctxPtr.dictLimit - ctxPtr.lowLimit < 4 then\n ctxPtr.lowLimit := ctxPtr.dictLimit;\n end;\n result := LZ4HC_compress_generic(ctxPtr, source, dest, inputSize, maxOutputSize, ctxPtr.compressionLevel, limit);\nend;\n\nfunction LZ4_compressHC_continue(LZ4_streamHCPtr: PLZ4_streamHC_t; const source: pAnsiChar; dest: pAnsiChar; inputSize: integer): integer;\nbegin\n result := LZ4_compressHC_continue_generic(PLZ4HC_Data_Structure(LZ4_streamHCPtr), source, dest, inputSize, 0, noLimit);\nend;\n\nfunction LZ4_loadDictHC(LZ4_streamHCPtr: PLZ4_streamHC_t; dictionary: pAnsiChar; dictSize: integer): integer;\nvar\n ctxPtr: PLZ4HC_Data_Structure;\nbegin\n ctxPtr := PLZ4HC_Data_Structure(LZ4_streamHCPtr);\n if dictSize > 65536 then\n begin\n inc(dictionary, dictSize - 65536);\n dictSize := 65536;\n end;\n LZ4HC_init(ctxPtr, pByte(dictionary));\n if (dictSize >= 4) then\n LZ4HC_Insert(ctxPtr, pByte(dictionary) + (dictSize - 3));\n ctxPtr._end := pByte(dictionary) + dictSize;\n result := dictSize;\nend;\n\nfunction LZ4_compressHC_limitedOutput_continue(LZ4_streamHCPtr: PLZ4_streamHC_t; const source: pAnsiChar; dest: pAnsiChar;\n inputSize: integer; maxOutputSize: integer): integer;\nbegin\n result := LZ4_compressHC_continue_generic(PLZ4HC_Data_Structure(LZ4_streamHCPtr), source, dest, inputSize, maxOutputSize,\n limitedOutput);\nend;\n\nprocedure LZ4_resetStreamHC(LZ4_streamHCPtr: PLZ4_streamHC_t; compressionLevel: integer);\nbegin\n PLZ4HC_Data_Structure(LZ4_streamHCPtr).base := Nil;\n PLZ4HC_Data_Structure(LZ4_streamHCPtr).compressionLevel := cardinal(compressionLevel);\nend;\n\nfunction LZ4_saveDictHC(LZ4_streamHCPtr: PLZ4_streamHC_t; safeBuffer: pAnsiChar; dictSize: integer): integer;\nvar\n streamPtr: PLZ4HC_Data_Structure;\n prefixSize: integer;\n endIndex: cardinal;\nbegin\n streamPtr := PLZ4HC_Data_Structure(LZ4_streamHCPtr);\n prefixSize := integer((streamPtr._end - (streamPtr.base + streamPtr.dictLimit)));\n if dictSize > 65536 then\n dictSize := 65536;\n if dictSize < 4 then\n dictSize := 0;\n if (dictSize > prefixSize) then\n dictSize := prefixSize;\n move((streamPtr._end - dictSize)^, safeBuffer^, dictSize);\n endIndex := cardinal(streamPtr._end - streamPtr.base);\n streamPtr._end := pByte(safeBuffer) + dictSize;\n streamPtr.base := streamPtr._end - endIndex;\n streamPtr.dictLimit := endIndex - cardinal(dictSize);\n streamPtr.lowLimit := endIndex - cardinal(dictSize);\n if streamPtr.nextToUpdate < streamPtr.dictLimit then\n streamPtr.nextToUpdate := streamPtr.dictLimit;\n result:=dictSize;\nend;\n\nend.\n"
},
{
"path": "lib/xedit/lz4/lz4frame.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\nunit lz4frame;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows, xxHash, lz4frame_static, lz4, lz4HC, lz4common;\n\nconst\n LZ4F_VERSION = 100;\n LZ4F_MAGICNUMBER = $184D2204;\n _1BIT = $01;\n _2BITS = $03;\n _3BITS = $07;\n _4BITS = $0F;\n _8BITS = $FF;\n LZ4F_BLOCKUNCOMPRESSED_FLAG: cardinal = $80000000;\n\ntype\n LZ4F_errorCode_t = size_t;\n PLZ4F_decompressionContext_t = pointer;\n PLZ4F_compressionContext_t = pointer;\n blockSizeID_t = (LZ4F_default = 0, max64KB = 4, max256KB = 5, max1MB = 6, max4MB = 7);\n blockMode_t = (blockLinked = 0, blockIndependent);\n contentChecksum_t = (noContentChecksum = 0, contentChecksumEnabled);\n LZ4F_lastBlockStatus = (notDone, fromTmpBuffer, fromSrcBuffer);\n\n PLZ4F_frameInfo_t = ^LZ4F_frameInfo_t;\n\n LZ4F_frameInfo_t = record\n blockSizeID: blockSizeID_t;\n blockMode: blockMode_t;\n contentChecksumFlag: contentChecksum_t;\n reserved: array [0 .. 4] of cardinal;\n end;\n\n PLZ4F_preferences_t = ^LZ4F_preferences_t;\n\n LZ4F_preferences_t = record\n frameInfo: LZ4F_frameInfo_t;\n compressionLevel: cardinal;\n autoFlush: cardinal;\n reserved: array [0 .. 3] of cardinal;\n end;\n\n PLZ4F_compressOptions_t = ^LZ4F_compressOptions_t;\n\n LZ4F_compressOptions_t = record\n stableSrc: cardinal;\n reserved: array [0 .. 2] of cardinal;\n end;\n\n PLZ4F_cctx_internal_t = ^LZ4F_cctx_internal_t;\n\n LZ4F_cctx_internal_t = record\n prefs: LZ4F_preferences_t;\n version: cardinal;\n cStage: cardinal;\n maxBlockSize: size_t;\n maxBufferSize: size_t;\n tmpBuff: pByte;\n tmpIn: pByte;\n tmpInSize: size_t;\n xxh: XXH32_state_t;\n lz4CtxPtr: pointer;\n lz4CtxLevel: cardinal;\n end;\n\n PLZ4F_dctx_internal_t = ^LZ4F_dctx_internal_t;\n\n LZ4F_dctx_internal_t = record\n frameInfo: LZ4F_frameInfo_t;\n version: cardinal;\n dStage: cardinal;\n maxBlockSize: size_t;\n maxBufferSize: size_t;\n srcExpect: pByte;\n tmpIn: pByte;\n tmpInSize: size_t;\n tmpInTarget: size_t;\n tmpOutBuffer: pByte;\n dict: pByte;\n dictSize: size_t;\n tmpOut: pByte;\n tmpOutSize: size_t;\n tmpOutStart: size_t;\n xxh: XXH32_state_t;\n header: array [0 .. 7] of byte;\n end;\n\n PLZ4F_decompressOptions_t = ^LZ4F_decompressOptions_t;\n\n LZ4F_decompressOptions_t = record\n stableDst: cardinal;\n reserved: array [0 .. 2] of cardinal;\n end;\n\nconst\n LZ4F_BLOCKSIZEID_DEFAULT = max64KB;\n LZ4F_MAXHEADERFRAME_SIZE = 7;\n\nfunction LZ4F_createDecompressionContext(var LZ4F_decompressionContextPtr: PLZ4F_compressionContext_t; versionNumber: cardinal)\n : LZ4F_errorCode_t;\nfunction LZ4F_isError(code: LZ4F_errorCode_t): boolean;\nfunction LZ4F_compressFrame(dstBuffer: pointer; dstMaxSize: size_t; const srcBuffer: pointer; srcSize: size_t;\n const preferencesPtr: PLZ4F_preferences_t): size_t;\nfunction LZ4F_compressBound(srcSize: size_t; const preferencesPtr: PLZ4F_preferences_t): size_t;\nfunction LZ4F_compressFrameBound(srcSize: size_t; const preferencesPtr: PLZ4F_preferences_t): size_t;\nfunction LZ4F_compressBegin(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n preferencesPtr: PLZ4F_preferences_t): size_t;\nfunction LZ4F_compressUpdate(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n const srcBuffer: pointer; srcSize: size_t; compressOptionsPtr: PLZ4F_compressOptions_t): size_t;\nfunction LZ4F_compressEnd(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n const compressOptionsPtr: PLZ4F_compressOptions_t): size_t;\nfunction LZ4F_flush(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n compressOptionsPtr: PLZ4F_compressOptions_t): size_t;\nfunction LZ4F_decompress(decompressionContext: PLZ4F_decompressionContext_t;\n dstBuffer: pointer; dstSizePtr: psize_t; const srcBuffer: pointer; srcSizePtr: psize_t;\n decompressOptionsPtr: PLZ4F_decompressOptions_t): size_t;\nfunction LZ4F_createCompressionContext(var LZ4F_compressionContextPtr: PLZ4F_compressionContext_t; version: cardinal): LZ4F_errorCode_t;\nfunction LZ4F_freeCompressionContext(LZ4F_compressionContext: PLZ4F_compressionContext_t): LZ4F_errorCode_t;\nfunction LZ4F_getFrameInfo(decompressionContext: PLZ4F_decompressionContext_t; frameInfoPtr: PLZ4F_frameInfo_t; const srcBuffer: pointer;\n srcSizePtr: psize_t): LZ4F_errorCode_t;\nfunction LZ4F_freeDecompressionContext(LZ4F_decompressionContext: PLZ4F_decompressionContext_t): LZ4F_errorCode_t;\nfunction LZ4F_getErrorName(code : LZ4F_errorCode_t ): pAnsiChar;\n\nimplementation\n\nvar\n minHClevel: cardinal = 3;\n\ntype\n dStage_t = (dstage_getHeader = 0, dstage_storeHeader, dstage_decodeHeader,\n dstage_getCBlockSize, dstage_storeCBlockSize, dstage_decodeCBlockSize,\n dstage_copyDirect,\n dstage_getCBlock, dstage_storeCBlock, dstage_decodeCBlock,\n dstage_decodeCBlock_intoDst, dstage_decodeCBlock_intoTmp, dstage_flushOut,\n dstage_getSuffix, dstage_storeSuffix, dstage_checkSuffix);\n\nfunction LZ4F_getBlockSize(blockSizeID: cardinal): size_t; forward;\n\nfunction LZ4F_createDecompressionContext(var LZ4F_decompressionContextPtr: PLZ4F_compressionContext_t; versionNumber: cardinal)\n : LZ4F_errorCode_t;\nvar\n dctxPtr: PLZ4F_dctx_internal_t;\nbegin\n dctxPtr := allocmem(sizeof(LZ4F_dctx_internal_t));\n if dctxPtr = nil then\n exit(LZ4F_errorCode_t(-integer(ERROR_GENERIC)));\n dctxPtr.version := versionNumber;\n LZ4F_decompressionContextPtr := dctxPtr;\n result := LZ4F_errorCode_t(OK_NoError);\nend;\n\nfunction LZ4F_isError(code: LZ4F_errorCode_t): boolean;\nbegin\n result := code > LZ4F_errorCode_t(-integer(ERROR_maxCode));\nend;\n\nfunction LZ4F_getErrorName(code : LZ4F_errorCode_t ): pAnsiChar;\nbegin\n result:= 'Unspecified error code';\n if LZ4F_isError(code) then exit (pAnsiChar(LZ4F_errorStrings[-integer(code)]));\nend;\n\nfunction LZ4F_compressFrameBound(srcSize: size_t; const preferencesPtr: PLZ4F_preferences_t): size_t;\nvar\n prefs: LZ4F_preferences_t;\n headerSize: size_t;\n streamSize: size_t;\n proposedBSID: blockSizeID_t;\n maxBlockSize: size_t;\nbegin\n fillchar(prefs, sizeof(LZ4F_preferences_t), 0);\n if (preferencesPtr <> Nil) then\n prefs := preferencesPtr^;\n proposedBSID := max64KB;\n maxBlockSize := 65536;\n while (prefs.frameInfo.blockSizeID > proposedBSID) do\n begin\n if srcSize <= maxBlockSize then\n begin\n prefs.frameInfo.blockSizeID := proposedBSID;\n break;\n end;\n inc(proposedBSID);\n maxBlockSize := maxBlockSize shl 2;\n end;\n prefs.autoFlush := 1;\n headerSize := 7; // basic header size (no option) including magic number\n streamSize := LZ4F_compressBound(srcSize, @prefs);\n result := headerSize + streamSize;\nend;\n\nfunction LZ4F_compressFrame(dstBuffer: pointer; dstMaxSize: size_t; const srcBuffer: pointer; srcSize: size_t;\n const preferencesPtr: PLZ4F_preferences_t): size_t;\nvar\n cctxI: LZ4F_cctx_internal_t;\n prefs: LZ4F_preferences_t;\n options: LZ4F_compressOptions_t;\n errorCode: LZ4F_errorCode_t;\n dstStart: pByte;\n dstPtr: pByte;\n dstEnd: pByte;\n proposedBSID: blockSizeID_t;\n maxBlockSize: size_t;\nbegin\n fillchar(cctxI, sizeof(LZ4F_cctx_internal_t), 0);\n fillchar(prefs, sizeof(LZ4F_preferences_t), 0);\n fillchar(options, sizeof(LZ4F_compressOptions_t), 0);\n dstStart := pByte(dstBuffer);\n dstPtr := dstStart;\n dstEnd := dstStart + dstMaxSize;\n cctxI.version := LZ4F_VERSION;\n cctxI.maxBufferSize := 5 * 1048576;\n if (preferencesPtr <> Nil) then\n prefs := preferencesPtr^;\n proposedBSID := max64KB;\n maxBlockSize := 65536;\n while (prefs.frameInfo.blockSizeID > proposedBSID) do\n begin\n if (srcSize <= maxBlockSize) then\n begin\n prefs.frameInfo.blockSizeID := proposedBSID;\n break;\n end;\n inc(proposedBSID);\n maxBlockSize := maxBlockSize shl 2;\n end;\n prefs.autoFlush := 1;\n if (srcSize <= LZ4F_getBlockSize(cardinal(prefs.frameInfo.blockSizeID))) then\n prefs.frameInfo.blockMode := blockIndependent; // no need for linked blocks\n\n options.stableSrc := 1;\n\n if (dstMaxSize < LZ4F_compressFrameBound(srcSize, @prefs)) then\n exit(size_t(-integer(ERROR_dstMaxSize_tooSmall)));\n\n errorCode := LZ4F_compressBegin(@cctxI, dstBuffer, dstMaxSize, @prefs); // write header\n if (LZ4F_isError(errorCode)) then\n exit(errorCode);\n inc(dstPtr, errorCode); // header size\n\n dec(dstMaxSize, errorCode);\n errorCode := LZ4F_compressUpdate(@cctxI, dstPtr, dstMaxSize, srcBuffer, srcSize, @options);\n if (LZ4F_isError(errorCode)) then\n exit(errorCode);\n inc(dstPtr, errorCode);\n errorCode := LZ4F_compressEnd(@cctxI, dstPtr, dstEnd - dstPtr, @options); // flush last block, and generate suffix\n if LZ4F_isError(errorCode) then\n exit(errorCode);\n inc(dstPtr, errorCode);\n\n freemem(cctxI.lz4CtxPtr);\n\n result := dstPtr - dstStart;\nend;\n\nfunction LZ4F_getBlockSize(blockSizeID: cardinal): size_t;\nconst\n blockSizes: array [0 .. 3] of size_t = (65536, 4 * 65536, 16 * 65536, 64 * 65536);\nbegin\n if (blockSizeID = 0) then\n blockSizeID := cardinal(LZ4F_BLOCKSIZEID_DEFAULT);\n dec(blockSizeID, 4);\n if (blockSizeID > 3) then\n exit(size_t(-integer(ERROR_maxBlockSize_invalid)));\n result := blockSizes[blockSizeID];\nend;\n\nfunction LZ4F_compressBound(srcSize: size_t; const preferencesPtr: PLZ4F_preferences_t): size_t;\nvar\n prefsNull: LZ4F_preferences_t;\n prefsPtr: PLZ4F_preferences_t;\n bid: blockSizeID_t;\n blockSize: size_t;\n nbBlocks: cardinal;\n lastBlockSize: size_t;\n blockInfo: size_t;\n frameEnd: size_t;\nbegin\n fillchar(prefsNull, sizeof(LZ4F_preferences_t), 0);\n if preferencesPtr = Nil then\n prefsPtr := @prefsNull\n else\n prefsPtr := preferencesPtr;\n bid := prefsPtr.frameInfo.blockSizeID;\n blockSize := LZ4F_getBlockSize(cardinal(bid));\n nbBlocks := cardinal(srcSize div blockSize) + 1;\n if prefsPtr.autoFlush <> 0 then\n lastBlockSize := srcSize mod blockSize\n else\n lastBlockSize := blockSize;\n blockInfo := 4; // default, without block CRC option\n frameEnd := 4 + (cardinal(prefsPtr.frameInfo.contentChecksumFlag) * 4);\n result := (blockInfo * nbBlocks) + (blockSize * (nbBlocks - 1)) + lastBlockSize + frameEnd;\nend;\n\nprocedure LZ4F_writeLE32(dstPtr: pByte; value32: cardinal);\nbegin\n dstPtr[0] := byte(value32);\n dstPtr[1] := byte(value32 shr 8);\n dstPtr[2] := byte(value32 shr 16);\n dstPtr[3] := byte(value32 shr 24);\nend;\n\nfunction LZ4F_headerChecksum(const header: pByte; length: size_t): byte;\nvar\n xxh: cardinal;\nbegin\n xxh := XXH32(header, cardinal(length), 0);\n result := byte(xxh shr 8);\nend;\n\nfunction LZ4F_compressBegin(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n preferencesPtr: PLZ4F_preferences_t): size_t;\nvar\n prefNull: LZ4F_preferences_t;\n cctxPtr: PLZ4F_cctx_internal_t;\n dstStart: pByte;\n dstPtr: pByte;\n headerStart: pByte;\n requiredBuffSize: size_t;\n targetCtxLevel: cardinal;\nbegin\n fillchar(prefNull, sizeof(LZ4F_preferences_t), 0);\n cctxPtr := PLZ4F_cctx_internal_t(compressionContext);\n dstStart := pByte(dstBuffer);\n dstPtr := dstStart;\n if (dstMaxSize < LZ4F_MAXHEADERFRAME_SIZE) then\n exit(size_t(-integer(ERROR_dstMaxSize_tooSmall)));\n if (cctxPtr.cStage <> 0) then\n exit(size_t(-integer(ERROR_GENERIC)));\n if (preferencesPtr = Nil) then\n preferencesPtr := @prefNull;\n cctxPtr.prefs := preferencesPtr^;\n // ctx Management\n if cctxPtr.prefs.compressionLevel < minHClevel then\n targetCtxLevel := 1\n else\n targetCtxLevel := 2;\n if cctxPtr.lz4CtxLevel < targetCtxLevel then\n begin\n freemem(cctxPtr.lz4CtxPtr);\n if (cctxPtr.prefs.compressionLevel < minHClevel) then\n cctxPtr.lz4CtxPtr := LZ4_createStream()\n else\n cctxPtr.lz4CtxPtr := LZ4_createStreamHC();\n cctxPtr.lz4CtxLevel := targetCtxLevel;\n end;\n // Buffer Management\n if cardinal(cctxPtr.prefs.frameInfo.blockSizeID) = 0 then\n cctxPtr.prefs.frameInfo.blockSizeID := LZ4F_BLOCKSIZEID_DEFAULT;\n cctxPtr.maxBlockSize := LZ4F_getBlockSize(cardinal(cctxPtr.prefs.frameInfo.blockSizeID));\n\n requiredBuffSize := cctxPtr.maxBlockSize + (cardinal(cctxPtr.prefs.frameInfo.blockMode = blockLinked) * 131072);\n if preferencesPtr.autoFlush <> 0 then\n requiredBuffSize := cardinal(cctxPtr.prefs.frameInfo.blockMode = blockLinked) * 65536; // just needs dict\n\n if (cctxPtr.maxBufferSize < requiredBuffSize) then\n begin\n cctxPtr.maxBufferSize := requiredBuffSize;\n freemem(cctxPtr.tmpBuff);\n cctxPtr.tmpBuff := allocmem(requiredBuffSize);\n if (cctxPtr.tmpBuff = Nil) then\n exit(size_t(-integer(ERROR_allocation_failed)));\n end;\n cctxPtr.tmpIn := cctxPtr.tmpBuff;\n cctxPtr.tmpInSize := 0;\n XXH32_reset(@cctxPtr.xxh, 0);\n if cctxPtr.prefs.compressionLevel < minHClevel then\n LZ4_resetStream(PLZ4_stream_t(cctxPtr.lz4CtxPtr))\n else\n LZ4_resetStreamHC(cctxPtr.lz4CtxPtr, cctxPtr.prefs.compressionLevel);\n\n // Magic Number\n LZ4F_writeLE32(dstPtr, LZ4F_MAGICNUMBER);\n inc(dstPtr, 4);\n headerStart := dstPtr;\n // FLG Byte\n dstPtr^ := ((1 and _2BITS) shl 6) // Version('01')\n + ((cardinal(cctxPtr.prefs.frameInfo.blockMode) and _1BIT) shl 5) // Block mode\n + byte((cardinal(cctxPtr.prefs.frameInfo.contentChecksumFlag) and _1BIT) shl 2); // Stream checksum\n\n inc(dstPtr);\n\n // BD Byte\n dstPtr^ := byte((cardinal(cctxPtr.prefs.frameInfo.blockSizeID) and _3BITS) shl 4);\n inc(dstPtr);\n\n // *CRC Byte\n dstPtr^ := LZ4F_headerChecksum(headerStart, 2);\n inc(dstPtr);\n cctxPtr.cStage := 1; // header written, wait for data block\n result := dstPtr - dstStart;\nend;\n\ntype\n compressFunc_t = function(ctx: pointer; const src: pAnsiChar; dst: pAnsiChar; srcSize: integer; dstSize: integer;\n level: integer): integer;\n\nfunction LZ4F_localLZ4_compress_limitedOutput_withState(ctx: pointer; const src: pAnsiChar; dst: pAnsiChar; srcSize: integer;\n dstSize: integer; level: integer): integer;\nbegin\n result := LZ4_compress_limitedOutput_withState(ctx, src, dst, srcSize, dstSize);\nend;\n\nfunction LZ4F_localLZ4_compress_limitedOutput_continue(ctx: pointer; const src: pAnsiChar; dst: pAnsiChar; srcSize: integer;\n dstSize: integer; level: integer): integer;\nbegin\n result := LZ4_compress_limitedOutput_continue(PLZ4_stream_t(ctx), src, dst, srcSize, dstSize);\nend;\n\nfunction LZ4F_localLZ4_compressHC_limitedOutput_continue(ctx: pointer; const src: pAnsiChar; dst: pAnsiChar; srcSize: integer;\n dstSize: integer; level: integer): integer;\nbegin\n result := LZ4_compressHC_limitedOutput_continue(PLZ4_streamHC_t(ctx), src, dst, srcSize, dstSize);\nend;\n\nfunction LZ4F_localSaveDict(cctxPtr: PLZ4F_cctx_internal_t): integer;\nbegin\n if cctxPtr.prefs.compressionLevel < minHClevel then\n result := LZ4_saveDict(PLZ4_stream_t(cctxPtr.lz4CtxPtr), pAnsiChar(cctxPtr.tmpBuff), 65536)\n else\n result := LZ4_saveDictHC(PLZ4_streamHC_t(cctxPtr.lz4CtxPtr), pAnsiChar(cctxPtr.tmpBuff), 65536);\nend;\n\nfunction LZ4F_selectCompression(blockMode: blockMode_t; level: cardinal): compressFunc_t;\nbegin\n if level < minHClevel then\n begin\n if (blockMode = blockIndependent) then\n exit(@LZ4F_localLZ4_compress_limitedOutput_withState);\n exit(@LZ4F_localLZ4_compress_limitedOutput_continue);\n end;\n if (blockMode = blockIndependent) then\n exit(@LZ4_compressHC2_limitedOutput_withStateHC);\n exit(@LZ4F_localLZ4_compressHC_limitedOutput_continue);\nend;\n\nfunction LZ4F_compressBlock(dst: pointer; const src: pointer; srcSize: size_t; compress: compressFunc_t; lz4ctx: pointer;\n level: integer): integer;\nvar\n cSizePtr: pByte;\n cSize: cardinal;\nbegin\n cSizePtr := dst;\n cSize := cardinal(compress(lz4ctx, src, pAnsiChar(cSizePtr + 4), integer(srcSize), integer(srcSize - 1), level));\n LZ4F_writeLE32(cSizePtr, cSize);\n if (cSize = 0) then // compression failed\n begin\n cSize := srcSize;\n LZ4F_writeLE32(cSizePtr, cSize + LZ4F_BLOCKUNCOMPRESSED_FLAG);\n move(src^, (cSizePtr + 4)^, srcSize);\n end;\n result := cSize + 4;\nend;\n\nfunction LZ4F_compressUpdate(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n const srcBuffer: pointer; srcSize: size_t; compressOptionsPtr: PLZ4F_compressOptions_t): size_t;\nvar\n cOptionsNull: LZ4F_compressOptions_t;\n cctxPtr: PLZ4F_cctx_internal_t;\n blockSize: size_t;\n srcPtr: pByte;\n srcEnd: pByte;\n dstStart: pByte;\n dstPtr: pByte;\n lastBlockCompressed: LZ4F_lastBlockStatus;\n compress: compressFunc_t;\n sizeToCopy: size_t;\n realDictSize: integer;\nbegin\n fillchar(cOptionsNull, sizeof(LZ4F_compressOptions_t), 0);\n cctxPtr := PLZ4F_cctx_internal_t(compressionContext);\n blockSize := cctxPtr.maxBlockSize;\n srcPtr := srcBuffer;\n srcEnd := srcPtr + srcSize;\n dstStart := dstBuffer;\n dstPtr := dstStart;\n lastBlockCompressed := notDone;\n if cctxPtr.cStage <> 1 then\n exit(size_t(-integer(ERROR_GENERIC)));\n if dstMaxSize < LZ4F_compressBound(srcSize, @(cctxPtr.prefs)) then\n exit(size_t(-integer(ERROR_dstMaxSize_tooSmall)));\n if compressOptionsPtr = Nil then\n compressOptionsPtr := @cOptionsNull;\n // select compression function\n compress := LZ4F_selectCompression(cctxPtr.prefs.frameInfo.blockMode, cctxPtr.prefs.compressionLevel);\n // complete tmp buffer\n if cctxPtr.tmpInSize > 0 then // some data already within tmp buffer\n begin\n sizeToCopy := blockSize - cctxPtr.tmpInSize;\n if sizeToCopy > srcSize then\n begin\n // add src to tmpIn buffer\n move(srcBuffer^, (cctxPtr.tmpIn + cctxPtr.tmpInSize)^, srcSize);\n srcPtr := srcEnd;\n inc(cctxPtr.tmpInSize, srcSize);\n // still needs some CRC\n end\n else\n begin\n // complete tmpIn block and then compress it\n lastBlockCompressed := fromTmpBuffer;\n move(srcBuffer^, (cctxPtr.tmpIn + cctxPtr.tmpInSize)^, sizeToCopy);\n inc(srcPtr, sizeToCopy);\n inc(dstPtr, LZ4F_compressBlock(dstPtr, cctxPtr.tmpIn, blockSize, compress, cctxPtr.lz4CtxPtr, cctxPtr.prefs.compressionLevel));\n\n if (cctxPtr.prefs.frameInfo.blockMode = blockLinked) then\n inc(cctxPtr.tmpIn, blockSize);\n cctxPtr.tmpInSize := 0;\n end;\n end;\n while size_t(srcEnd - srcPtr) >= blockSize do\n begin\n // compress full block\n lastBlockCompressed := fromSrcBuffer;\n inc(dstPtr, LZ4F_compressBlock(dstPtr, srcPtr, blockSize, compress, cctxPtr.lz4CtxPtr, cctxPtr.prefs.compressionLevel));\n inc(srcPtr, blockSize);\n end;\n if ((cctxPtr.prefs.autoFlush <> 0) and (srcPtr < srcEnd)) then\n begin\n // compress remaining input < blockSize\n lastBlockCompressed := fromSrcBuffer;\n inc(dstPtr, LZ4F_compressBlock(dstPtr, srcPtr, srcEnd - srcPtr, compress, cctxPtr.lz4CtxPtr, cctxPtr.prefs.compressionLevel));\n srcPtr := srcEnd;\n end;\n\n // preserve dictionary if necessary\n if ((cctxPtr.prefs.frameInfo.blockMode = blockLinked) and (lastBlockCompressed = fromSrcBuffer)) then\n begin\n if compressOptionsPtr.stableSrc <> 0 then\n cctxPtr.tmpIn := cctxPtr.tmpBuff\n else\n begin\n realDictSize := LZ4F_localSaveDict(cctxPtr);\n if (realDictSize = 0) then\n exit(size_t(-integer(ERROR_GENERIC)));\n cctxPtr.tmpIn := cctxPtr.tmpBuff + realDictSize;\n end;\n end;\n // keep tmpIn within limits\n if ((cctxPtr.tmpIn + blockSize) > (cctxPtr.tmpBuff + cctxPtr.maxBufferSize))\n // necessarily blockLinked && lastBlockCompressed==fromTmpBuffer\n and (cctxPtr.prefs.autoFlush = 0) then\n begin\n LZ4F_localSaveDict(cctxPtr);\n cctxPtr.tmpIn := cctxPtr.tmpBuff + 65536;\n end;\n // some input data left, necessarily < blockSize\n if srcPtr < srcEnd then\n begin\n // fill tmp buffer\n sizeToCopy := srcEnd - srcPtr;\n move(srcPtr^, (cctxPtr.tmpIn)^, sizeToCopy);\n cctxPtr.tmpInSize := sizeToCopy;\n end;\n if (cctxPtr.prefs.frameInfo.contentChecksumFlag = contentChecksumEnabled) then\n XXH32_update(@(cctxPtr.xxh), srcBuffer, cardinal(srcSize));\n result := dstPtr - dstStart;\nend;\n\nfunction LZ4F_flush(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n compressOptionsPtr: PLZ4F_compressOptions_t): size_t;\nvar\n cOptionsNull: LZ4F_compressOptions_t;\n cctxPtr: PLZ4F_cctx_internal_t;\n dstStart: pByte;\n dstPtr: pByte;\n compress: compressFunc_t;\nbegin\n fillchar(cOptionsNull, sizeof(LZ4F_compressOptions_t), 0);\n cctxPtr := PLZ4F_cctx_internal_t(compressionContext);\n dstStart := pByte(dstBuffer);\n dstPtr := dstStart;\n if cctxPtr.tmpInSize = 0 then\n exit(0); // nothing to flush\n if cctxPtr.cStage <> 1 then\n exit(size_t(-integer(ERROR_GENERIC)));\n if (dstMaxSize < (cctxPtr.tmpInSize + 16)) then\n exit(size_t(-integer(ERROR_dstMaxSize_tooSmall)));\n (* Not used\n if (compressOptionsPtr = Nil) then\n compressOptionsPtr := @cOptionsNull;\n *)\n // select compression function\n compress := LZ4F_selectCompression(cctxPtr.prefs.frameInfo.blockMode, cctxPtr.prefs.compressionLevel);\n // compress tmp buffer\n inc(dstPtr, LZ4F_compressBlock(dstPtr, cctxPtr.tmpIn, cctxPtr.tmpInSize, compress, cctxPtr.lz4CtxPtr, cctxPtr.prefs.compressionLevel));\n if (cctxPtr.prefs.frameInfo.blockMode = blockLinked) then\n inc(cctxPtr.tmpIn, cctxPtr.tmpInSize);\n cctxPtr.tmpInSize := 0;\n // keep tmpIn within limits\n if ((cctxPtr.tmpIn + cctxPtr.maxBlockSize) > (cctxPtr.tmpBuff + cctxPtr.maxBufferSize)) then // necessarily blockLinked\n begin\n LZ4F_localSaveDict(cctxPtr);\n cctxPtr.tmpIn := cctxPtr.tmpBuff + 65536;\n end;\n result := dstPtr - dstStart;\nend;\n\nfunction LZ4F_compressEnd(compressionContext: PLZ4F_compressionContext_t; dstBuffer: pointer; dstMaxSize: size_t;\n const compressOptionsPtr: PLZ4F_compressOptions_t): size_t;\nvar\n cctxPtr: PLZ4F_cctx_internal_t;\n dstStart: pByte;\n dstPtr: pByte;\n errorCode: size_t;\n xxh: cardinal;\nbegin\n cctxPtr := PLZ4F_cctx_internal_t(compressionContext);\n dstStart := pByte(dstBuffer);\n dstPtr := dstStart;\n errorCode := LZ4F_flush(compressionContext, dstBuffer, dstMaxSize, compressOptionsPtr);\n if LZ4F_isError(errorCode) then\n exit(errorCode);\n inc(dstPtr, errorCode);\n LZ4F_writeLE32(dstPtr, 0);\n inc(dstPtr, 4); // endMark\n if cctxPtr.prefs.frameInfo.contentChecksumFlag = contentChecksumEnabled then\n begin\n xxh := XXH32_digest(@(cctxPtr.xxh));\n LZ4F_writeLE32(dstPtr, xxh);\n inc(dstPtr, 4); // content Checksum\n end;\n cctxPtr.cStage := 0; // state is now re-usable (with identical preferences)\n\n result := dstPtr - dstStart;\nend;\n\nfunction LZ4F_readLE32(const srcPtr: pByte): cardinal;\nvar\n value32: cardinal;\nbegin\n value32 := srcPtr[0];\n inc(value32, (srcPtr[1] shl 8));\n inc(value32, (srcPtr[2] shl 16));\n inc(value32, (srcPtr[3] shl 24));\n result := value32;\nend;\n\nfunction LZ4F_decodeHeader(dctxPtr: PLZ4F_dctx_internal_t; srcPtr: pByte; srcSize: size_t): size_t;\nvar\n FLG, BD, HC: byte;\n version, blockMode, blockChecksumFlag, contentSizeFlag, contentChecksumFlag, dictFlag, blockSizeID: cardinal;\n bufferNeeded: size_t;\nbegin\n // need to decode header to get frameInfo\n if srcSize < 7 then\n exit(size_t(-integer(ERROR_GENERIC))); // minimal header size\n // control magic number\n if (LZ4F_readLE32(srcPtr) <> LZ4F_MAGICNUMBER) then\n exit(size_t(-integer(ERROR_GENERIC)));\n inc(srcPtr, 4);\n // Flags\n FLG := srcPtr[0];\n version := (FLG shr 6) and _2BITS;\n blockMode := (FLG shr 5) and _1BIT;\n blockChecksumFlag := (FLG shr 4) and _1BIT;\n contentSizeFlag := (FLG shr 3) and _1BIT;\n contentChecksumFlag := (FLG shr 2) and _1BIT;\n dictFlag := (FLG shr 0) and _1BIT;\n BD := srcPtr[1];\n blockSizeID := (BD shr 4) and _3BITS;\n // check\n HC := LZ4F_headerChecksum(srcPtr, 2);\n if (HC <> srcPtr[2]) then\n exit(size_t(-integer(ERROR_GENERIC))); // Bad header checksum error\n\n // validate\n if version <> 1 then\n exit(size_t(-integer(ERROR_GENERIC))); // Version Number, only supported value\n if blockChecksumFlag <> 0 then\n exit(size_t(-integer(ERROR_GENERIC))); // Only supported value for the time being\n if contentSizeFlag <> 0 then\n exit(size_t(-integer(ERROR_GENERIC))); // Only supported value for the time being\n if ((FLG shr 1) and _1BIT) <> 0 then\n exit(size_t(-integer(ERROR_GENERIC)));\n /// Reserved bit\n if dictFlag <> 0 then\n exit(size_t(-integer(ERROR_GENERIC))); // Only supported value for the time being\n if (BD shr 7) and _1BIT <> 0 then\n exit(size_t(-integer(ERROR_GENERIC)));\n /// Reserved bit\n if blockSizeID < 4 then\n exit(size_t(-integer(ERROR_GENERIC))); // Only supported values for the time being\n if (((BD shr 0) and _4BITS) <> 0) then\n exit(size_t(-integer(ERROR_GENERIC))); // Reserved bits\n // save\n dctxPtr.frameInfo.blockMode := blockMode_t(blockMode);\n dctxPtr.frameInfo.contentChecksumFlag := contentChecksum_t(contentChecksumFlag);\n dctxPtr.frameInfo.blockSizeID := blockSizeID_t(blockSizeID);\n dctxPtr.maxBlockSize := LZ4F_getBlockSize(blockSizeID);\n\n // init\n if (contentChecksumFlag <> 0) then\n XXH32_reset(@(dctxPtr.xxh), 0);\n\n // alloc\n bufferNeeded := dctxPtr.maxBlockSize + size_t (integer(dctxPtr.frameInfo.blockMode = blockLinked) * 131072);\n\n if bufferNeeded > dctxPtr.maxBufferSize then // tmp buffers too small\n begin\n freemem(dctxPtr.tmpIn);\n freemem(dctxPtr.tmpOutBuffer);\n dctxPtr.maxBufferSize := bufferNeeded;\n dctxPtr.tmpIn := allocmem(dctxPtr.maxBlockSize);\n if dctxPtr.tmpIn = Nil then\n exit(size_t(-integer(ERROR_GENERIC)));\n dctxPtr.tmpOutBuffer := allocmem(dctxPtr.maxBufferSize);\n if dctxPtr.tmpOutBuffer = Nil then\n exit(size_t(-integer(ERROR_GENERIC)));\n end;\n dctxPtr.tmpInSize := 0;\n dctxPtr.tmpInTarget := 0;\n dctxPtr.dict := dctxPtr.tmpOutBuffer;\n dctxPtr.dictSize := 0;\n dctxPtr.tmpOut := dctxPtr.tmpOutBuffer;\n dctxPtr.tmpOutStart := 0;\n dctxPtr.tmpOutSize := 0;\n\n result := 7;\nend;\n\nprocedure LZ4F_updateDict(dctxPtr: PLZ4F_dctx_internal_t; const dstPtr: pByte; dstSize: size_t; const dstPtr0: pByte; withinTmp: cardinal);\nvar\n preserveSize: size_t;\n copySize: size_t;\n oldDictEnd: pByte;\nbegin\n if dctxPtr.dictSize = 0 then\n dctxPtr.dict := pByte(dstPtr); // priority to dictionary continuity\n\n if dctxPtr.dict + dctxPtr.dictSize = dstPtr then // dictionary continuity\n begin\n inc(dctxPtr.dictSize, dstSize);\n exit;\n end;\n\n if size_t(dstPtr - dstPtr0) + dstSize >= 65536 then // dstBuffer large enough to become dictionary\n begin\n dctxPtr.dict := pByte(dstPtr0);\n dctxPtr.dictSize := size_t(dstPtr - dstPtr0) + dstSize;\n exit;\n end;\n\n if ((withinTmp <> 0) and (dctxPtr.dict = dctxPtr.tmpOutBuffer)) then\n begin\n // assumption : dctxPtr->dict + dctxPtr->dictSize == dctxPtr->tmpOut + dctxPtr->tmpOutStart\n inc(dctxPtr.dictSize, dstSize);\n exit;\n end;\n\n if withinTmp <> 0 then // copy relevant dict portion in front of tmpOut within tmpOutBuffer\n begin\n preserveSize := dctxPtr.tmpOut - dctxPtr.tmpOutBuffer;\n copySize := 65536 - dctxPtr.tmpOutSize;\n oldDictEnd := dctxPtr.dict + dctxPtr.dictSize - dctxPtr.tmpOutStart;\n if dctxPtr.tmpOutSize > 65536 then\n copySize := 0;\n if copySize > preserveSize then\n copySize := preserveSize;\n\n move((oldDictEnd - copySize)^, (dctxPtr.tmpOutBuffer + preserveSize - copySize)^, copySize);\n\n dctxPtr.dict := dctxPtr.tmpOutBuffer;\n dctxPtr.dictSize := preserveSize + dctxPtr.tmpOutStart + dstSize;\n exit;\n end;\n\n if dctxPtr.dict = dctxPtr.tmpOutBuffer then // copy dst into tmp to complete dict\n begin\n if dctxPtr.dictSize + dstSize > dctxPtr.maxBufferSize then // tmp buffer not large enough\n begin\n preserveSize := 65536 - dstSize; // note : dstSize < 64 KB\n move((dctxPtr.dict + dctxPtr.dictSize - preserveSize)^, (dctxPtr.dict)^, preserveSize);\n dctxPtr.dictSize := preserveSize;\n end;\n move(dstPtr^, (dctxPtr.dict + dctxPtr.dictSize)^, dstSize);\n inc(dctxPtr.dictSize, dstSize);\n exit;\n end;\n // join dict & dest into tmp\n\n preserveSize := 65536 - dstSize; // note : dstSize < 64 KB\n if preserveSize > dctxPtr.dictSize then\n preserveSize := dctxPtr.dictSize;\n move((dctxPtr.dict + dctxPtr.dictSize - preserveSize)^, dctxPtr.tmpOutBuffer^, preserveSize);\n move(dstPtr^, (dctxPtr.tmpOutBuffer + preserveSize)^, dstSize);\n dctxPtr.dict := dctxPtr.tmpOutBuffer;\n dctxPtr.dictSize := preserveSize + dstSize;\nend;\n\nfunction LZ4F_decompress_safe(const source: pAnsiChar; dest: pAnsiChar; compressedSize: integer; maxDecompressedSize: integer;\n const dictStart: pAnsiChar; dictSize: integer): integer;\nbegin\n result := LZ4_decompress_safe(source, dest, compressedSize, maxDecompressedSize);\nend;\n\nfunction LZ4F_decompress(decompressionContext: PLZ4F_decompressionContext_t;\n dstBuffer: pointer; dstSizePtr: psize_t;\n const srcBuffer: pointer; srcSizePtr: psize_t;\n decompressOptionsPtr: PLZ4F_decompressOptions_t): size_t;\ntype\n Tdecoder = function(const c1: pAnsiChar; c2: pAnsiChar; c3: integer; c4: integer; const c5: pAnsiChar; c6: integer): integer;\nvar\n dctxPtr: PLZ4F_dctx_internal_t;\n optionsNull: LZ4F_decompressOptions_t;\n srcStart: pByte;\n srcEnd: pByte;\n srcPtr: pByte;\n dstStart: pByte;\n dstEnd: pByte;\n dstPtr: pByte;\n selectedIn: pByte;\n doAnotherStage: cardinal;\n nextSrcSizeHint: size_t;\n sizeToCopy: size_t;\n errorCode: LZ4F_errorCode_t;\n nextCBlockSize: size_t;\n decodedSize: integer;\n decoder: Tdecoder;\n reservedDictSpace: size_t;\n suffixSize: size_t;\n readCRC: cardinal;\n resultCRC: cardinal;\n preserveSize: size_t;\n copySize: size_t;\n oldDictEnd: pByte;\n newDictSize: size_t;\nbegin\n dctxPtr := PLZ4F_dctx_internal_t(decompressionContext);\n fillchar(optionsNull, sizeof(LZ4F_decompressOptions_t), 0);\n srcStart := pByte(srcBuffer);\n srcEnd := srcStart + srcSizePtr^;\n srcPtr := srcStart;\n dstStart := pByte(dstBuffer);\n dstEnd := dstStart + dstSizePtr^;\n dstPtr := dstStart;\n selectedIn := Nil;\n doAnotherStage := 1;\n nextSrcSizeHint := 1;\n\n if decompressOptionsPtr = Nil then\n decompressOptionsPtr := @optionsNull;\n\n srcSizePtr^ := 0;\n dstSizePtr^ := 0;\n\n // expect to continue decoding src buffer where it left previously\n if dctxPtr.srcExpect <> Nil then\n begin\n if (srcStart <> dctxPtr.srcExpect) then\n exit(size_t(-integer(ERROR_GENERIC)));\n end;\n\n // programmed as a state machine\n\n while (doAnotherStage <> 0) do\n begin\n case dctxPtr.dStage of\n cardinal(dstage_getHeader):\n begin\n if srcEnd - srcPtr >= 7 then\n begin\n selectedIn := srcPtr;\n inc(srcPtr, 7);\n dctxPtr.dStage := cardinal(dstage_decodeHeader);\n end\n else\n begin\n dctxPtr.tmpInSize := 0;\n dctxPtr.dStage := cardinal(dstage_storeHeader);\n end;\n end;\n cardinal(dstage_storeHeader):\n begin\n sizeToCopy := 7 - dctxPtr.tmpInSize;\n if sizeToCopy > size_t(srcEnd - srcPtr) then\n sizeToCopy := srcEnd - srcPtr;\n move(srcPtr^, (pByte(@dctxPtr.header) + dctxPtr.tmpInSize)^, sizeToCopy);\n inc(dctxPtr.tmpInSize, sizeToCopy);\n inc(srcPtr, sizeToCopy);\n if (dctxPtr.tmpInSize < 7) then\n begin\n nextSrcSizeHint := (7 - dctxPtr.tmpInSize) + 4;\n doAnotherStage := 0; // no enough src, wait to get some more\n end\n else\n begin\n selectedIn := @dctxPtr.header;\n dctxPtr.dStage := cardinal(dstage_decodeHeader);\n end;\n end;\n cardinal(dstage_decodeHeader):\n begin\n errorCode := LZ4F_decodeHeader(dctxPtr, selectedIn, 7);\n if LZ4F_isError(errorCode) then\n exit(errorCode);\n dctxPtr.dStage := cardinal(dstage_getCBlockSize);\n end;\n cardinal(dstage_getCBlockSize):\n begin\n if (srcEnd - srcPtr) >= 4 then\n begin\n selectedIn := srcPtr;\n inc(srcPtr, 4);\n dctxPtr.dStage := cardinal(dstage_decodeCBlockSize);\n end\n else\n begin\n // not enough input to read cBlockSize field\n dctxPtr.tmpInSize := 0;\n dctxPtr.dStage := cardinal(dstage_storeCBlockSize);\n end;\n end;\n cardinal(dstage_storeCBlockSize):\n begin\n sizeToCopy := 4 - dctxPtr.tmpInSize;\n if sizeToCopy > size_t(srcEnd - srcPtr) then\n sizeToCopy := srcEnd - srcPtr;\n move(srcPtr^, (dctxPtr.tmpIn + dctxPtr.tmpInSize)^, sizeToCopy);\n inc(srcPtr, sizeToCopy);\n inc(dctxPtr.tmpInSize, sizeToCopy);\n if dctxPtr.tmpInSize < 4 then // not enough input to get full cBlockSize; wait for more\n begin\n nextSrcSizeHint := 4 - dctxPtr.tmpInSize;\n doAnotherStage := 0;\n end\n else\n begin\n selectedIn := dctxPtr.tmpIn;\n dctxPtr.dStage := cardinal(dstage_decodeCBlockSize);\n end;\n end;\n cardinal(dstage_decodeCBlockSize):\n begin\n nextCBlockSize := LZ4F_readLE32(selectedIn) and $7FFFFFFF;\n if (nextCBlockSize = 0) then\n dctxPtr.dStage := cardinal(dstage_getSuffix)\n else\n begin\n if (nextCBlockSize > dctxPtr.maxBlockSize) then\n exit(size_t(-integer(ERROR_GENERIC))); // invalid cBlockSize\n dctxPtr.tmpInTarget := nextCBlockSize;\n if (LZ4F_readLE32(selectedIn) and LZ4F_BLOCKUNCOMPRESSED_FLAG) <> 0 then\n dctxPtr.dStage := cardinal(dstage_copyDirect)\n else\n begin\n dctxPtr.dStage := cardinal(dstage_getCBlock);\n if dstPtr = dstEnd then\n begin\n nextSrcSizeHint := nextCBlockSize + 4;\n doAnotherStage := 0;\n end;\n end;\n end;\n end;\n cardinal(dstage_copyDirect): // uncompressed block\n begin\n sizeToCopy := dctxPtr.tmpInTarget;\n if size_t(srcEnd - srcPtr) < sizeToCopy then\n sizeToCopy := srcEnd - srcPtr; // not enough input to read full block\n if size_t(dstEnd - dstPtr) < sizeToCopy then\n sizeToCopy := dstEnd - dstPtr;\n move(srcPtr^, dstPtr^, sizeToCopy);\n if (dctxPtr.frameInfo.contentChecksumFlag <> noContentChecksum) then\n XXH32_update(@(dctxPtr.xxh), srcPtr, cardinal(sizeToCopy));\n // dictionary management\n if (dctxPtr.frameInfo.blockMode = blockLinked) then\n LZ4F_updateDict(dctxPtr, dstPtr, sizeToCopy, dstStart, 0);\n inc(srcPtr, sizeToCopy);\n inc(dstPtr, sizeToCopy);\n if sizeToCopy = dctxPtr.tmpInTarget then // all copied\n dctxPtr.dStage := cardinal(dstage_getCBlockSize)\n else\n begin\n dec(dctxPtr.tmpInTarget, sizeToCopy); // still need to copy more\n nextSrcSizeHint := dctxPtr.tmpInTarget + 4;\n doAnotherStage := 0;\n end;\n end;\n cardinal(dstage_getCBlock):\n begin\n if size_t(srcEnd - srcPtr) < dctxPtr.tmpInTarget then\n begin\n dctxPtr.tmpInSize := 0;\n dctxPtr.dStage := cardinal(dstage_storeCBlock);\n end\n else\n begin\n selectedIn := srcPtr;\n inc(srcPtr, dctxPtr.tmpInTarget);\n dctxPtr.dStage := cardinal(dstage_decodeCBlock);\n end;\n end;\n cardinal(dstage_storeCBlock):\n begin\n sizeToCopy := dctxPtr.tmpInTarget - dctxPtr.tmpInSize;\n if sizeToCopy > size_t(srcEnd - srcPtr) then\n sizeToCopy := srcEnd - srcPtr;\n\n move(srcPtr^, (dctxPtr.tmpIn + dctxPtr.tmpInSize)^, sizeToCopy);\n inc(dctxPtr.tmpInSize, sizeToCopy);\n inc(srcPtr, sizeToCopy);\n if (dctxPtr.tmpInSize < dctxPtr.tmpInTarget) then // need more input\n begin\n nextSrcSizeHint := (dctxPtr.tmpInTarget - dctxPtr.tmpInSize) + 4;\n doAnotherStage := 0;\n end\n else\n begin\n selectedIn := dctxPtr.tmpIn;\n dctxPtr.dStage := cardinal(dstage_decodeCBlock);\n end;\n end;\n cardinal(dstage_decodeCBlock):\n begin\n if (size_t(dstEnd - dstPtr) < dctxPtr.maxBlockSize) then // not enough place into dst : decode into tmpOut\n dctxPtr.dStage := cardinal(dstage_decodeCBlock_intoTmp)\n else\n dctxPtr.dStage := cardinal(dstage_decodeCBlock_intoDst);\n end;\n\n cardinal(dstage_decodeCBlock_intoDst):\n begin\n if (dctxPtr.frameInfo.blockMode = blockLinked) then\n decoder := LZ4_decompress_safe_usingDict\n else\n decoder := LZ4F_decompress_safe;\n\n decodedSize := decoder(pAnsiChar(selectedIn), pAnsiChar(dstPtr), integer(dctxPtr.tmpInTarget),\n integer(dctxPtr.maxBlockSize), pAnsiChar(dctxPtr.dict), integer(dctxPtr.dictSize));\n if (decodedSize < 0) then\n exit(size_t(-integer(ERROR_GENERIC))); // decompression failed\n if (dctxPtr.frameInfo.contentChecksumFlag <> noContentChecksum) then\n XXH32_update(@(dctxPtr.xxh), dstPtr, decodedSize);\n // dictionary management\n if (dctxPtr.frameInfo.blockMode = blockLinked) then\n LZ4F_updateDict(dctxPtr, dstPtr, decodedSize, dstStart, 0);\n\n inc(dstPtr, decodedSize);\n dctxPtr.dStage := cardinal(dstage_getCBlockSize);\n end;\n cardinal(dstage_decodeCBlock_intoTmp):\n begin\n if (dctxPtr.frameInfo.blockMode = blockLinked) then\n decoder := LZ4_decompress_safe_usingDict\n else\n decoder := LZ4F_decompress_safe;\n // ensure enough place for tmpOut\n if dctxPtr.frameInfo.blockMode = blockLinked then\n begin\n if (dctxPtr.dict = dctxPtr.tmpOutBuffer) then\n begin\n if (dctxPtr.dictSize > 131072) then\n begin\n move((dctxPtr.dict + dctxPtr.dictSize - 65536)^, dctxPtr.dict^, 65536);\n dctxPtr.dictSize := 65536;\n end;\n dctxPtr.tmpOut := dctxPtr.dict + dctxPtr.dictSize;\n end\n else // dict not within tmp\n begin\n reservedDictSpace := dctxPtr.dictSize;\n if (reservedDictSpace > 65536) then\n reservedDictSpace := 65536;\n dctxPtr.tmpOut := dctxPtr.tmpOutBuffer + reservedDictSpace;\n end;\n end;\n // Decode\n decodedSize := decoder(pAnsiChar(selectedIn), pAnsiChar(dctxPtr.tmpOut), integer(dctxPtr.tmpInTarget),\n integer(dctxPtr.maxBlockSize), pAnsiChar(dctxPtr.dict), integer(dctxPtr.dictSize));\n if decodedSize < 0 then\n exit(size_t(-integer(ERROR_decompressionFailed))); // decompression failed\n if (dctxPtr.frameInfo.contentChecksumFlag <> noContentChecksum) then\n XXH32_update(@(dctxPtr.xxh), dctxPtr.tmpOut, decodedSize);\n dctxPtr.tmpOutSize := decodedSize;\n dctxPtr.tmpOutStart := 0;\n dctxPtr.dStage := cardinal(dstage_flushOut);\n end;\n cardinal(dstage_flushOut): // flush decoded data from tmpOut to dstBuffer\n begin\n sizeToCopy := dctxPtr.tmpOutSize - dctxPtr.tmpOutStart;\n if (sizeToCopy > size_t(dstEnd - dstPtr)) then\n sizeToCopy := dstEnd - dstPtr;\n move((dctxPtr.tmpOut + dctxPtr.tmpOutStart)^, dstPtr^, sizeToCopy);\n // dictionary management\n if (dctxPtr.frameInfo.blockMode = blockLinked) then\n LZ4F_updateDict(dctxPtr, dstPtr, sizeToCopy, dstStart, 1);\n\n inc(dctxPtr.tmpOutStart, sizeToCopy);\n inc(dstPtr, sizeToCopy);\n // end of flush ?\n if (dctxPtr.tmpOutStart = dctxPtr.tmpOutSize) then\n dctxPtr.dStage := cardinal(dstage_getCBlockSize)\n else\n begin\n nextSrcSizeHint := 4;\n doAnotherStage := 0; // still some data to flush\n end;\n end;\n cardinal(dstage_getSuffix):\n begin\n suffixSize := cardinal(dctxPtr.frameInfo.contentChecksumFlag) * 4;\n if (suffixSize = 0) then // frame completed\n begin\n nextSrcSizeHint := 0;\n dctxPtr.dStage := cardinal(dstage_getHeader);\n doAnotherStage := 0;\n end\n else\n begin\n if ((srcEnd - srcPtr) >= 4) then // CRC present\n begin\n selectedIn := srcPtr;\n inc(srcPtr, 4);\n dctxPtr.dStage := cardinal(dstage_checkSuffix);\n end\n else\n begin\n dctxPtr.tmpInSize := 0;\n dctxPtr.dStage := cardinal(dstage_storeSuffix);\n end;\n end;\n end;\n cardinal(dstage_storeSuffix):\n begin\n sizeToCopy := 4 - dctxPtr.tmpInSize;\n if (sizeToCopy > size_t(srcEnd - srcPtr)) then\n sizeToCopy := srcEnd - srcPtr;\n move(srcPtr^, (dctxPtr.tmpIn + dctxPtr.tmpInSize)^, sizeToCopy);\n inc(srcPtr, sizeToCopy);\n inc(dctxPtr.tmpInSize, sizeToCopy);\n if (dctxPtr.tmpInSize < 4) then // not enough input to read complete suffix\n begin\n nextSrcSizeHint := 4 - dctxPtr.tmpInSize;\n doAnotherStage := 0;\n end\n else\n begin\n selectedIn := dctxPtr.tmpIn;\n dctxPtr.dStage := cardinal(dstage_checkSuffix);\n end;\n end;\n cardinal(dstage_checkSuffix):\n begin\n readCRC := LZ4F_readLE32(selectedIn);\n resultCRC := XXH32_digest(@(dctxPtr.xxh));\n if (readCRC <> resultCRC) then\n exit(size_t(-integer(ERROR_checksum_invalid)));\n nextSrcSizeHint := 0;\n dctxPtr.dStage := cardinal(dstage_getHeader);\n doAnotherStage := 0;\n end;\n end;\n end;\n // preserve dictionary within tmp if necessary\n if (dctxPtr.frameInfo.blockMode = blockLinked)\n and (dctxPtr.dict <> dctxPtr.tmpOutBuffer)\n and (decompressOptionsPtr.stableDst = 0)\n and (cardinal(dctxPtr.dStage - 1) < cardinal(cardinal(dstage_getSuffix) - 1)) then\n begin\n if dctxPtr.dStage = cardinal(dstage_flushOut) then\n begin\n preserveSize := dctxPtr.tmpOut - dctxPtr.tmpOutBuffer;\n copySize := 65536 - dctxPtr.tmpOutSize;\n oldDictEnd := dctxPtr.dict + dctxPtr.dictSize - dctxPtr.tmpOutStart;\n if dctxPtr.tmpOutSize > 65536 then\n copySize := 0;\n if copySize > preserveSize then\n copySize := preserveSize;\n move((oldDictEnd - copySize)^, (dctxPtr.tmpOutBuffer + preserveSize - copySize)^, copySize);\n\n dctxPtr.dict := dctxPtr.tmpOutBuffer;\n dctxPtr.dictSize := preserveSize + dctxPtr.tmpOutStart;\n end\n else\n begin\n newDictSize := dctxPtr.dictSize;\n oldDictEnd := dctxPtr.dict + dctxPtr.dictSize;\n if newDictSize > 65536 then\n newDictSize := 65536;\n\n move((oldDictEnd - newDictSize)^, (dctxPtr.tmpOutBuffer)^, newDictSize);\n\n dctxPtr.dict := dctxPtr.tmpOutBuffer;\n dctxPtr.dictSize := newDictSize;\n dctxPtr.tmpOut := dctxPtr.tmpOutBuffer + newDictSize;\n end;\n end;\n if (srcPtr < srcEnd) then // function must be called again with following source data\n dctxPtr.srcExpect := srcPtr\n else\n dctxPtr.srcExpect := Nil;\n srcSizePtr^ := (srcPtr - srcStart);\n dstSizePtr^ := (dstPtr - dstStart);\n result := nextSrcSizeHint;\nend;\n\nfunction LZ4F_createCompressionContext(var LZ4F_compressionContextPtr: PLZ4F_compressionContext_t; version: cardinal): LZ4F_errorCode_t;\nvar\n cctxPtr: PLZ4F_cctx_internal_t;\nbegin\n cctxPtr := allocmem(sizeof(LZ4F_cctx_internal_t));\n if cctxPtr = Nil then\n exit(LZ4F_errorCode_t(-integer(ERROR_allocation_failed)));\n\n cctxPtr.version := version;\n cctxPtr.cStage := 0; // Next stage : write header\n\n LZ4F_compressionContextPtr := PLZ4F_compressionContext_t(cctxPtr);\n result := cardinal(OK_NoError);\nend;\n\nfunction LZ4F_freeCompressionContext(LZ4F_compressionContext: PLZ4F_compressionContext_t): LZ4F_errorCode_t;\nvar\n cctxPtr: PLZ4F_cctx_internal_t;\nbegin\n cctxPtr := PLZ4F_cctx_internal_t(LZ4F_compressionContext);\n freemem(cctxPtr.lz4CtxPtr);\n freemem(cctxPtr.tmpBuff);\n freemem(LZ4F_compressionContext);\n result := cardinal(OK_NoError);\nend;\n\nfunction LZ4F_getFrameInfo(decompressionContext: PLZ4F_decompressionContext_t; frameInfoPtr: PLZ4F_frameInfo_t; const srcBuffer: pointer;\n srcSizePtr: psize_t): LZ4F_errorCode_t;\nvar\n dctxPtr: PLZ4F_dctx_internal_t;\n errorCode: LZ4F_errorCode_t;\nbegin\n dctxPtr := PLZ4F_dctx_internal_t(decompressionContext);\n if dctxPtr.dStage = cardinal(dstage_getHeader) then\n begin\n errorCode := LZ4F_decodeHeader(dctxPtr, srcBuffer, srcSizePtr^);\n if LZ4F_isError(errorCode) then\n exit(errorCode);\n srcSizePtr^ := errorCode;\n frameInfoPtr^ := dctxPtr.frameInfo;\n dctxPtr.srcExpect := Nil;\n dctxPtr.dStage := cardinal(dstage_getCBlockSize);\n exit(4);\n end;\n srcSizePtr^ := 0;\n frameInfoPtr^ := dctxPtr.frameInfo;\n result := 0;\nend;\n\nfunction LZ4F_freeDecompressionContext(LZ4F_decompressionContext: PLZ4F_decompressionContext_t): LZ4F_errorCode_t;\nvar\n dctxPtr: PLZ4F_dctx_internal_t;\nbegin\n dctxPtr := PLZ4F_dctx_internal_t(LZ4F_decompressionContext);\n freemem(dctxPtr.tmpIn);\n freemem(dctxPtr.tmpOutBuffer);\n freemem(dctxPtr);\n result := cardinal(OK_NoError);\nend;\n\nend.\n"
},
{
"path": "lib/xedit/lz4/lz4frame_static.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\n\nunit lz4frame_static;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows;\n\ntype\n LZ4F_LIST_ERRORS = (\n OK_NoError = 0,\n ERROR_GENERIC,\n ERROR_maxBlockSize_invalid,\n ERROR_blockMode_invalid,\n ERROR_contentChecksumFlag_invalid,\n ERROR_compressionLevel_invalid,\n ERROR_allocation_failed,\n ERROR_srcSize_tooLarge,\n ERROR_dstMaxSize_tooSmall,\n ERROR_decompressionFailed,\n ERROR_checksum_invalid,\n ERROR_maxCode);\n\nconst\n LZ4F_errorStrings : array[0..11] of AnsiString =\n (\n 'OK_NoError',\n 'ERROR_GENERIC',\n 'ERROR_maxBlockSize_invalid',\n 'ERROR_blockMode_invalid',\n 'ERROR_contentChecksumFlag_invalid',\n 'ERROR_compressionLevel_invalid',\n 'ERROR_allocation_failed',\n 'ERROR_srcSize_tooLarge',\n 'ERROR_dstMaxSize_tooSmall',\n 'ERROR_decompressionFailed',\n 'ERROR_checksum_invalid',\n 'ERROR_maxCode'\n );\n\nimplementation\n\nend.\n"
},
{
"path": "lib/xedit/lz4/lz4io.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\n\n\nunit lz4io;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows, Classes, SysUtils, Math, lz4frame_static, xxHash, lz4, lz4common, lz4frame, lz4HC;\n\n\nconst\n LZ4_BLOCKSIZEID_DEFAULT = 7;\n ENDOFSTREAM = uint64(-1);\n LZ4S_MAGICNUMBER = $184D2204;\n LZ4S_SKIPPABLE0 = $184D2A50;\n LZ4S_SKIPPABLEMASK = $FFFFFFF0;\n LEGACY_MAGICNUMBER = $184C2102;\n MAGICNUMBER_SIZE = 4;\n LEGACY_BLOCKSIZE = 8388608;\n MIN_STREAM_BUFSIZE = 196608;\n\nvar\n lz4_overwrite_file: boolean = true;\n globalblockSizeID: integer = LZ4_BLOCKSIZEID_DEFAULT;\n blockIndependence: integer = 1;\n streamChecksum: integer = 1;\n\nfunction LZ4IO_compressFilename_Legacy(input_filename: string; output_filename: string; compressionLevel: integer): integer;\nfunction LZ4IO_compressFilename(input_filename: string; output_filename: string; compressionLevel: integer): integer;\nfunction LZ4IO_decompressFilename(input_filename: string; output_filename: string): integer;\nprocedure lz4DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;\n const OutBuf: Pointer; BufSize: Integer);\n\nimplementation\n\nconst\n minBlockSizeID: integer = 4;\n maxBlockSizeID: integer = 7;\n\nfunction reportError(err: string): integer;\nbegin\n //LZ4Client.Memo.Lines.Add(err);\n result := 0;\nend;\n\nprocedure LZ4IO_writeLE32(p: pointer; value32: cardinal);\nvar\n dstPtr: pByte;\nbegin\n dstPtr := p;\n dstPtr[0] := byte(value32);\n dstPtr[1] := byte(value32 shr 8);\n dstPtr[2] := byte(value32 shr 16);\n dstPtr[3] := byte(value32 shr 24);\nend;\n\nfunction LZ4IO_compressFilename_Legacy(input_filename: string; output_filename: string; compressionLevel: integer): integer;\ntype\n TCompressionFunction =\n function(c1: pAnsiChar; c2: pAnsiChar; c3: integer): integer;\nvar\n compressionFunction: TCompressionFunction;\n filesize: uint64;\n compressedfilesize: uint64;\n in_buff: pAnsiChar;\n out_buff: pAnsiChar;\n fileIn: TFileSTream;\n fileOut: TFileSTream;\n sizeCheck: size_t;\n outSize, inSize: cardinal;\nbegin\n filesize := 0;\n compressedfilesize := MAGICNUMBER_SIZE;\n\n if (compressionLevel < 3) then\n compressionFunction := LZ4_compress\n else\n compressionFunction := LZ4_compressHC;\n fileIn := TFileSTream.Create(input_filename, fmOpenRead);\n fileOut := TFileSTream.Create(output_filename, fmCreate);\n\n in_buff := allocmem(LEGACY_BLOCKSIZE);\n out_buff := allocmem(LZ4_compressBound(LEGACY_BLOCKSIZE));\n try\n if (in_buff = nil) or (out_buff = nil) then\n exit(reportError('Allocation error : not enough memory'));\n LZ4IO_writeLE32(out_buff, LEGACY_MAGICNUMBER);\n sizeCheck := fileOut.Write(out_buff^, MAGICNUMBER_SIZE);\n if sizeCheck <> MAGICNUMBER_SIZE then\n exit(reportError('Write error : cannot write header'));\n while true do\n begin\n inSize := fileIn.Read(in_buff^, LEGACY_BLOCKSIZE);\n if inSize <= 0 then\n break;\n inc(filesize, inSize);\n outSize := compressionFunction(in_buff, out_buff + 4, inSize);\n inc(compressedfilesize, outSize + 4);\n LZ4IO_writeLE32(out_buff, outSize);\n sizeCheck := fileOut.Write(out_buff^, outSize + 4);\n if sizeCheck <> size_t(outSize + 4) then\n exit(reportError('Write error : cannot write compressed block'));\n end;\n finally\n if in_buff <> nil then\n freemem(in_buff);\n if out_buff <> nil then\n freemem(out_buff);\n fileIn.Free;\n fileOut.Free;\n result := 0;\n end;\nend;\n\nfunction LZ4IO_setBlockSizeID(bsid: integer): integer;\nconst\n blockSizeTable: array [0 .. 3] of integer = (65536, 262144, 1048576, 4194304);\nbegin\n if (bsid < minBlockSizeID) or (bsid > maxBlockSizeID) then\n exit(-1);\n globalblockSizeID := bsid;\n result := blockSizeTable[globalblockSizeID - minBlockSizeID];\nend;\n\nfunction LZ4IO_compressFilename(input_filename: string; output_filename: string; compressionLevel: integer): integer;\nvar\n filesize: uint64;\n errorCode: LZ4F_errorCode_t;\n ctx: PLZ4F_compressionContext_t;\n blockSize: integer;\n fileIn: TFileSTream;\n fileOut: TFileSTream;\n prefs: LZ4F_preferences_t;\n in_buff: pAnsiChar;\n out_buff: pAnsiChar;\n outBuffSize: size_t;\n headerSize: size_t;\n sizeCheck: size_t;\n readSize: size_t;\n outSize: size_t;\nbegin\n result := 0;\n filesize := 0;\n errorCode := LZ4F_createCompressionContext(ctx, LZ4F_VERSION);\n if (LZ4F_isError(errorCode)) then\n exit(reportError(format('Allocation error : can''t create LZ4F context: %s', [LZ4F_getErrorName(errorCode)])));\n fileIn := TFileSTream.Create(input_filename, fmOpenRead);\n fileOut := TFileSTream.Create(output_filename, fmCreate);\n blockSize := 1 shl (8 + 2 * globalblockSizeID);\n fillchar(prefs, sizeof(LZ4F_preferences_t), 0);\n\n prefs.autoFlush := 1;\n prefs.compressionLevel := compressionLevel;\n prefs.frameInfo.blockMode := blockMode_t(blockIndependence);\n prefs.frameInfo.blockSizeID := blockSizeID_t(globalblockSizeID);\n prefs.frameInfo.contentChecksumFlag := contentChecksum_t(streamChecksum);\n\n // Allocate Memory\n in_buff := allocmem(blockSize);\n outBuffSize := LZ4F_compressBound(blockSize, @prefs);\n out_buff := allocmem(outBuffSize);\n try\n if (in_buff = nil) or (out_buff = nil) then\n exit(reportError('Allocation error : not enough memory'));\n // Write Archive Header\n headerSize := LZ4F_compressBegin(ctx, out_buff, outBuffSize, @prefs);\n if (LZ4F_isError(headerSize)) then\n exit(reportError(format('File header generation failed: %s', [LZ4F_getErrorName(errorCode)])));\n sizeCheck := fileOut.Write(out_buff^, headerSize);\n if sizeCheck <> headerSize then\n exit(reportError('Write error : cannot write header'));\n\n readSize := fileIn.Read(in_buff^, blockSize);\n inc(filesize, readSize);\n while readSize > 0 do\n begin\n outSize := LZ4F_compressUpdate(ctx, out_buff, outBuffSize, in_buff, readSize, Nil);\n if (LZ4F_isError(outSize)) then\n exit(reportError(format('Compression failed: %s', [LZ4F_getErrorName(errorCode)])));\n sizeCheck := fileOut.Write(out_buff^, outSize);\n if sizeCheck <> outSize then\n exit(reportError('Write error : cannot write compressed block'));\n readSize := fileIn.Read(in_buff^, blockSize);\n inc(filesize, readSize);\n end;\n // End of Stream mark\n headerSize := LZ4F_compressEnd(ctx, out_buff, outBuffSize, Nil);\n if LZ4F_isError(headerSize) then\n exit(reportError(format('End of file generation failed: %s', [LZ4F_getErrorName(errorCode)])));\n sizeCheck := fileOut.Write(out_buff^, headerSize);\n if sizeCheck <> headerSize then\n exit(reportError('Write error : cannot write end of stream'));\n errorCode := LZ4F_freeCompressionContext(ctx);\n if LZ4F_isError(errorCode) then\n exit(reportError(format('Error : can''t free LZ4F context resource: %s', [LZ4F_getErrorName(errorCode)])));\n finally\n if in_buff <> nil then\n freemem(in_buff);\n if out_buff <> nil then\n freemem(out_buff);\n fileIn.Free;;\n fileOut.Free;\n end;\nend;\n\nfunction LZ4IO_readLE32(s: pointer): cardinal;\nvar\n srcPtr: pByte;\n value32: cardinal;\nbegin\n srcPtr := s;\n value32 := srcPtr[0];\n inc(value32, (srcPtr[1] shl 8));\n inc(value32, (srcPtr[2] shl 16));\n inc(value32, (srcPtr[3] shl 24));\n result := value32;\nend;\n\nfunction LZ4S_isSkippableMagicNumber(magic: cardinal): boolean;\nbegin\n result := (magic and LZ4S_SKIPPABLEMASK) = LZ4S_SKIPPABLE0;\nend;\n\nfunction decodeLZ4S(finput, foutput: TSTream): uint64;\nconst\n HEADERMAX = 20;\nvar\n filesize: uint64;\n inBuff: pAnsiChar;\n outBuff: pAnsiChar;\n headerBuff: array [0 .. HEADERMAX - 1] of ansiChar;\n sizeCheck, nextToRead, outBuffSize, inBuffSize: size_t;\n ctx: PLZ4F_decompressionContext_t;\n errorCode: LZ4F_errorCode_t;\n frameInfo: LZ4F_frameInfo_t;\n decodedBytes: size_t;\nbegin\n filesize := 0;\n errorCode := LZ4F_createDecompressionContext(ctx, LZ4F_VERSION);\n if LZ4F_isError(errorCode) then\n exit(reportError(format('Allocation error : can''t create context: %s', [LZ4F_getErrorName(errorCode)])));\n LZ4IO_writeLE32(@headerBuff, LZ4S_MAGICNUMBER);\n outBuffSize := 0;\n inBuffSize := 0;\n sizeCheck := MAGICNUMBER_SIZE;\n nextToRead := LZ4F_decompress(ctx, Nil, @outBuffSize, @headerBuff, @sizeCheck, Nil);\n if LZ4F_isError(nextToRead) then\n exit(reportError(format('Decompression error: %s', [LZ4F_getErrorName(errorCode)])));\n if nextToRead > HEADERMAX then\n exit(reportError(format('Header too large (%d>%d)', [integer(nextToRead), HEADERMAX])));\n sizeCheck := finput.Read(headerBuff, nextToRead);\n if sizeCheck <> nextToRead then\n exit(reportError('Read error'));\n nextToRead := LZ4F_decompress(ctx, Nil, @outBuffSize, @headerBuff, @sizeCheck, Nil);\n errorCode := LZ4F_getFrameInfo(ctx, @frameInfo, Nil, @inBuffSize);\n if LZ4F_isError(errorCode) then\n exit(reportError(format('can''t decode frame header: %s', [LZ4F_getErrorName(errorCode)])));\n outBuffSize := LZ4IO_setBlockSizeID(integer(frameInfo.blockSizeID));\n inBuffSize := outBuffSize + 4;\n inBuff := allocmem(inBuffSize);\n outBuff := allocmem(outBuffSize);\n try\n if (inBuff = nil) or (outBuff = nil) then\n exit(reportError('Allocation error : not enough memory'));\n while (nextToRead <> 0) do\n begin\n decodedBytes := outBuffSize;\n sizeCheck := finput.Read(inBuff^, nextToRead);\n if sizeCheck <> nextToRead then\n exit(reportError('Read error'));\n errorCode := LZ4F_decompress(ctx, outBuff, @decodedBytes, inBuff, @sizeCheck, Nil);\n if LZ4F_isError(errorCode) then\n exit(reportError(format('Decompression error: %s', [LZ4F_getErrorName(errorCode)])));\n if sizeCheck <> nextToRead then\n exit(reportError('Synchronization error'));\n nextToRead := errorCode;\n inc(filesize, decodedBytes);\n sizeCheck := foutput.Write(outBuff^, decodedBytes);\n if sizeCheck <> decodedBytes then\n exit(reportError('Write error : cannot write decoded block'));\n end;\n errorCode := LZ4F_freeDecompressionContext(ctx);\n if LZ4F_isError(errorCode) then\n exit(reportError(format('Error : can''t free LZ4F context resource: %s', [LZ4F_getErrorName(errorCode)])));\n finally\n if inBuff <> nil then\n freemem(inBuff);\n if outBuff <> nil then\n freemem(outBuff);\n result := filesize;\n end;\nend;\n\nfunction decodeLegacyStream(finput, foutput: TSTream): uint64;\nvar\n filesize: uint64;\n in_buff: pAnsiChar;\n out_buff: pAnsiChar;\n decodeSize: integer;\n sizeCheck: size_t;\n blockSize: cardinal;\nbegin\n filesize := 0;\n in_buff := allocmem(LZ4_compressBound(LEGACY_BLOCKSIZE));\n out_buff := allocmem(LEGACY_BLOCKSIZE);\n try\n if (in_buff = nil) or (out_buff = nil) then\n exit(reportError('Allocation error : not enough memory'));\n while true do\n begin\n sizeCheck := finput.Read(in_buff^, 4);\n if sizeCheck = 0 then\n break;\n blockSize := LZ4IO_readLE32(in_buff);\n if blockSize > LZ4_compressBound(LEGACY_BLOCKSIZE) then\n begin\n finput.Seek(-4, soFromCurrent);\n break;\n end;\n sizeCheck := finput.Read(in_buff^, blockSize);\n if sizeCheck <> blockSize then\n exit(reportError('Error reading input file'));\n decodeSize := LZ4_decompress_safe(in_buff, out_buff, blockSize, LEGACY_BLOCKSIZE);\n if (decodeSize < 0) then\n exit(reportError('Decoding Failed ! Corrupted input detected'));\n inc(filesize, decodeSize);\n sizeCheck := foutput.Write(out_buff^, decodeSize);\n if sizeCheck <> size_t(decodeSize) then\n exit(reportError('Write error : cannot write decoded block into output'));\n end;\n finally\n if in_buff <> nil then\n freemem(in_buff);\n if out_buff <> nil then\n freemem(out_buff);\n result := filesize;\n end;\nend;\n\nfunction selectDecoder(finput, foutput: TSTream): uint64;\nvar\n nbReadBytes: size_t;\n U32Store: array [0 .. MAGICNUMBER_SIZE - 1] of byte;\n magicNumber, Size: cardinal;\n newPos: uint64;\nbegin\n nbReadBytes := finput.Read(U32Store, MAGICNUMBER_SIZE);\n if nbReadBytes = 0 then\n exit(ENDOFSTREAM);\n if nbReadBytes <> MAGICNUMBER_SIZE then\n exit(reportError('Unrecognized header : Magic Number unreadable'));\n magicNumber := LZ4IO_readLE32(@U32Store);\n if LZ4S_isSkippableMagicNumber(magicNumber) then\n magicNumber := LZ4S_SKIPPABLE0;\n\n case magicNumber of\n LZ4S_MAGICNUMBER: result := decodeLZ4S(finput, foutput);\n LEGACY_MAGICNUMBER:\n begin\n result := decodeLegacyStream(finput, foutput);\n end;\n LZ4S_SKIPPABLE0:\n begin\n nbReadBytes := finput.Read(U32Store, 4);\n if (nbReadBytes <> 4) then\n exit(reportError('Stream error : skippable size unreadable'));\n Size := LZ4IO_readLE32(@U32Store);\n newPos := finput.Seek(Size, soFromCurrent);\n if newPos <> finput.Position then\n exit(reportError('Stream error : cannot skip skippable area'));\n result := selectDecoder(finput, foutput);\n end;\n else\n begin\n if finput.Position = MAGICNUMBER_SIZE then\n exit(reportError('Unrecognized header : file cannot be decoded'));\n reportError('Stream followed by unrecognized data');\n result := ENDOFSTREAM;\n end;\n end;\nend;\n\nfunction LZ4IO_decompressFilename(input_filename: string; output_filename: string): integer;\nvar\n fileIn: TFileSTream;\n fileOut: TFileSTream;\n decodedSize: int64;\n filesize: int64;\nbegin\n result := 0;\n filesize := 0;\n fileIn := TFileSTream.Create(input_filename, fmOpenRead);\n fileOut := TFileSTream.Create(output_filename, fmCreate);\n repeat\n decodedSize := selectDecoder(fileIn, fileOut);\n if decodedSize <> ENDOFSTREAM then\n inc(filesize, decodedSize);\n until decodedSize = ENDOFSTREAM;\n fileIn.Free;;\n fileOut.Free;\nend;\n\ntype\n TPreallocatedMemoryStream = class(TCustomMemoryStream)\n public\n constructor Create(Ptr: Pointer; Size: Int64);\n function Write(const Buffer; Count: Longint): Longint; override;\n end;\n\nconstructor TPreallocatedMemoryStream.Create(Ptr: Pointer; Size: Int64);\nbegin\n inherited Create;\n SetPointer(Ptr, Size);\nend;\n\nfunction TPreallocatedMemoryStream.Write(const Buffer; Count: Integer): Longint;\nbegin\n Result := Min(Count, Size-Position);\n System.Move(Buffer, Pointer(PByte(Memory) + Position)^, Result);\n Seek(Result, soCurrent);\nend;\n\nprocedure lz4DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;\n const OutBuf: Pointer; BufSize: Integer);\nvar\n stin, stout: TPreallocatedMemoryStream;\n decodedSize: int64;\n decompressedSize: int64;\nbegin\n stin := TPreallocatedMemoryStream.Create(InBuf, InBytes);\n stout := TPreallocatedMemoryStream.Create(OutBuf, BufSize);\n try\n decompressedSize := 0;\n repeat\n decodedSize := selectDecoder(stin, stout);\n if decodedSize <> ENDOFSTREAM then\n Inc(decompressedSize, decodedSize);\n until decodedSize = ENDOFSTREAM;\n\n if decompressedSize <> BufSize then\n Exception.Create('lz4 decompression size mismatch');\n\n //Move(stout.Memory^, OutBuf^, BufSize);\n finally\n stin.Free;\n stout.Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/xedit/lz4/xxHash.pas",
"content": "(*\n LZ4Delphi\n Copyright (C) 2015, Jose Pascoa (atelierwebgm@gmail.com)\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n *************************************************************************\n LZ4 - Fast LZ compression algorithm\n xxHash - Fast Hash algorithm\n LZ4 source repository : http://code.google.com/p/lz4/\n xxHash source repository : http://code.google.com/p/xxhash/\n Copyright (c) 2011-2014, Yann Collet\n BSD 2-Clause License (http://www.opensource.org/licenses/bsd-license.php)\n\n \n Redistribution and use in source and binary forms, with or without\n modification, are permitted provided that the following conditions are\n met:\n\n * Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n * Redistributions in binary form must reproduce the above\n copyright notice, this list of conditions and the following disclaimer\n in the documentation and/or other materials provided with the\n distribution.\n\n THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n \"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\n ******************************************************************************\n*)\n\nunit xxHash;\n{$POINTERMATH ON}\n\ninterface\n\nuses Windows, lz4common;\n\nconst\n PRIME32_1: cardinal = 2654435761;\n PRIME32_2: cardinal = 2246822519;\n PRIME32_3: cardinal = 3266489917;\n PRIME32_4: cardinal = 668265263;\n PRIME32_5: cardinal = 374761393;\n PRIME64_1: uint64 = 11400714785074694791;\n PRIME64_2: uint64 = 14029467366897019727;\n PRIME64_3: uint64 = 1609587929392839161;\n PRIME64_4: uint64 = 9650029242287828579;\n PRIME64_5: uint64 = 2870177450012600261;\n\ntype\n XXH_errorcode = (XXH_OK = 0, XXH_ERROR);\n XXH_endianess = (XXH_bigEndian = 0, XXH_littleEndian = 1);\n XXH_alignment = (XXH_aligned, XXH_unaligned);\n\n PXXH32_state_t = ^XXH32_state_t;\n\n XXH32_state_t = record\n ll: array [0 .. 5] of int64;\n end;\n\n PXXH_istate32_t = ^XXH_istate32_t;\n\n XXH_istate32_t = record\n total_len: uint64;\n seed: cardinal;\n v1: cardinal;\n v2: cardinal;\n v3: cardinal;\n v4: cardinal;\n mem32: array [0 .. 3] of cardinal;\n memsize: cardinal;\n end;\n\n PXXH64_state_t = ^XXH64_state_t;\n\n XXH64_state_t = record\n ll: array [0 .. 10] of int64;\n end;\n\n PXXH_istate64_t = ^XXH_istate64_t;\n\n XXH_istate64_t = record\n total_len: uint64;\n seed: uint64;\n v1: uint64;\n v2: uint64;\n v3: uint64;\n v4: uint64;\n mem64: array [0 .. 3] of uint64;\n memsize: cardinal;\n end;\n\nfunction XXH32(input: pointer; len: size_t; seed: cardinal): cardinal;\n\nfunction XXH32_reset(statePtr: PXXH32_state_t; seed: cardinal): XXH_errorcode;\nfunction XXH32_update(statePtr: PXXH32_state_t; Ainput: pointer; ALength: size_t): XXH_errorcode;\nfunction XXH32_digest(statePtr: PXXH32_state_t): cardinal;\nfunction XXH32_createState: PXXH32_state_t;\nprocedure XXH32_freeState(statePtr: PXXH32_state_t);\n// Obsolet in recent release\nfunction XXH32_init(seed: cardinal): PXXH32_state_t;\n\nfunction XXH64_reset(statePtr: PXXH64_state_t; seed: uint64): XXH_errorcode;\nfunction XXH64_update(statePtr: PXXH64_state_t; Ainput: pointer; ALength: size_t): XXH_errorcode;\nfunction XXH64_digest(statePtr: PXXH64_state_t): uint64;\nfunction XXH64_createState: PXXH64_state_t;\nprocedure XXH64_freeState(statePtr: PXXH64_state_t);\n// Obsolet in recent release\nfunction XXH64_init(seed: uint64): PXXH64_state_t;\n\nimplementation\n\ntype\n PU32_S = ^U32_S;\n\n U32_S = packed record\n v: cardinal;\n end;\n\n PU64_S = ^U64_S;\n\n U64_S = packed record\n v: uint64;\n end;\n\nfunction XXH_rotl32(x, r: cardinal): cardinal;\nasm\n mov eax, x\n mov ecx, r\n rol eax, cl\nend;\n\n(* Alternative\nfunction XXH_rotl32(x, r: cardinal): cardinal; inline;\nvar\n temp: cardinal;\nbegin\n temp := x;\n result := (x shl r) or (temp shr (32 - r));\nend;\n*)\n{$IFDEF CPUX64}\n\nfunction XXH_rotl64(x: uint64; r: cardinal): uint64;\nasm\n mov rax, x\n mov ecx, r\n rol rax, cl\nend;\n{$ELSE}\n\nfunction XXH_rotl64(x: uint64; r: cardinal): uint64; inline\nvar\n temp: uint64;\nbegin\n temp := x;\n result := (x shl r) or (temp shr (64 - r));\nend;\n\n{$ENDIF}\n\nfunction A32(x: pointer): cardinal; inline;\nbegin\n result := PU32_S(x).v;\nend;\n\nfunction A64(x: pointer): uint64; inline;\nbegin\n result := PU64_S(x).v;\nend;\n\nfunction XXH_readLE32_align(ptr: pointer; endian: XXH_endianess; align: XXH_alignment): cardinal; inline;\nbegin\n if align = XXH_unaligned then\n result := A32(ptr)\n else\n result := pcardinal(ptr)^;\nend;\n\nfunction XXH_readLE32(ptr: pointer): cardinal; inline;\nbegin\n result := XXH_readLE32_align(ptr, XXH_littleEndian, XXH_unaligned);\nend;\n\nfunction XXH_readLE64_align(ptr: pointer; endian: XXH_endianess; align: XXH_alignment): uint64; inline;\nbegin\n if align = XXH_unaligned then\n result := A64(ptr)\n else\n result := puint64(ptr)^;\nend;\n\nfunction XXH_readLE64(ptr: pointer): uint64; inline;\nbegin\n result := XXH_readLE64_align(ptr, XXH_littleEndian, XXH_unaligned);\nend;\n\nfunction XXH32_reset(statePtr: PXXH32_state_t; seed: cardinal): XXH_errorcode;\nvar\n state: PXXH_istate32_t;\nbegin\n state := PXXH_istate32_t(statePtr);\n state.seed := seed;\n state.v1 := seed + PRIME32_1 + PRIME32_2;\n state.v2 := seed + PRIME32_2;\n state.v3 := seed + 0;\n state.v4 := seed - PRIME32_1;\n state.total_len := 0;\n state.memsize := 0;\n result := XXH_OK;\nend;\n\nfunction XXH64_reset(statePtr: PXXH64_state_t; seed: uint64): XXH_errorcode;\nvar\n state: PXXH_istate64_t;\nbegin\n state := PXXH_istate64_t(statePtr);\n state.seed := seed;\n state.v1 := seed + PRIME64_1 + PRIME64_2;\n state.v2 := seed + PRIME64_2;\n state.v3 := seed + 0;\n state.v4 := seed - PRIME64_1;\n state.total_len := 0;\n state.memsize := 0;\n result := XXH_OK;\nend;\n\nfunction XXH32_update(statePtr: PXXH32_state_t; Ainput: pointer; ALength: size_t): XXH_errorcode;\nvar\n state: PXXH_istate32_t;\n p: pByte;\n bEnd: pByte;\n p32: pcardinal;\n limit: pByte;\n v1, v2, v3, v4: cardinal;\nbegin\n state := PXXH_istate32_t(statePtr);\n p := Ainput;\n bEnd := p + ALength;\n inc(state.total_len, ALength);\n\n if (state.memsize + ALength < 16) then\n begin\n move(Ainput^, (pByte(@state.mem32) + state.memsize)^, ALength);\n inc(state.memsize, cardinal(ALength));\n exit(XXH_OK);\n end;\n if state.memsize > 0 then\n begin\n move(Ainput^, (pByte(@state.mem32) + state.memsize)^, 16 - state.memsize);\n p32 := @state.mem32;\n inc(state.v1, XXH_readLE32(p32) * PRIME32_2);\n state.v1 := XXH_rotl32(state.v1, 13);\n state.v1 := state.v1 * PRIME32_1;\n inc(p32);\n inc(state.v2, XXH_readLE32(p32) * PRIME32_2);\n state.v2 := XXH_rotl32(state.v2, 13);\n state.v2 := state.v2 * PRIME32_1;\n inc(p32);\n inc(state.v3, XXH_readLE32(p32) * PRIME32_2);\n state.v3 := XXH_rotl32(state.v3, 13);\n state.v3 := state.v3 * PRIME32_1;\n inc(p32);\n inc(state.v4, XXH_readLE32(p32) * PRIME32_2);\n state.v4 := XXH_rotl32(state.v4, 13);\n state.v4 := state.v4 * PRIME32_1;\n// inc(p32);\n inc(p, 16 - state.memsize);\n state.memsize := 0;\n end;\n\n if p <= (bEnd - 16) then\n begin\n limit := bEnd - 16;\n v1 := state.v1;\n v2 := state.v2;\n v3 := state.v3;\n v4 := state.v4;\n repeat\n inc(v1, XXH_readLE32(p) * PRIME32_2);\n v1 := XXH_rotl32(v1, 13);\n v1 := v1 * PRIME32_1;\n inc(p, 4);\n inc(v2, XXH_readLE32(p) * PRIME32_2);\n v2 := XXH_rotl32(v2, 13);\n v2 := v2 * PRIME32_1;\n inc(p, 4);\n inc(v3, XXH_readLE32(p) * PRIME32_2);\n v3 := XXH_rotl32(v3, 13);\n v3 := v3 * PRIME32_1;\n inc(p, 4);\n inc(v4, XXH_readLE32(p) * PRIME32_2);\n v4 := XXH_rotl32(v4, 13);\n v4 := v4 * PRIME32_1;\n inc(p, 4);\n until p > limit;\n state.v1 := v1;\n state.v2 := v2;\n state.v3 := v3;\n state.v4 := v4;\n end;\n\n if p < bEnd then\n begin\n move(p^, state.mem32, bEnd - p);\n state.memsize := integer(bEnd - p);\n end;\n result := XXH_OK;\nend;\n\nfunction XXH64_update(statePtr: PXXH64_state_t; Ainput: pointer; ALength: size_t): XXH_errorcode;\nvar\n state: PXXH_istate64_t;\n p: pByte;\n bEnd: pByte;\n p64: puint64;\n limit: pByte;\n v1, v2, v3, v4: uint64;\nbegin\n state := PXXH_istate64_t(statePtr);\n p := Ainput;\n bEnd := p + ALength;\n inc(state.total_len, ALength);\n\n if (state.memsize + ALength < 32) then\n begin\n move(Ainput^, (pByte(@state.mem64) + state.memsize)^, ALength);\n inc(state.memsize, cardinal(ALength));\n exit(XXH_OK);\n end;\n\n if state.memsize > 0 then\n begin\n move(Ainput^, (pByte(@state.mem64) + state.memsize)^, 32 - state.memsize);\n p64 := @state.mem64;\n inc(state.v1, XXH_readLE64(p64) * PRIME64_2);\n state.v1 := XXH_rotl64(state.v1, 31);\n state.v1 := state.v1 * PRIME64_1;\n inc(p64);\n inc(state.v2, XXH_readLE64(p64) * PRIME64_2);\n state.v2 := XXH_rotl64(state.v2, 31);\n state.v2 := state.v2 * PRIME64_1;\n inc(p64);\n inc(state.v3, XXH_readLE64(p64) * PRIME64_2);\n state.v3 := XXH_rotl64(state.v3, 31);\n state.v3 := state.v3 * PRIME64_1;\n inc(p64);\n inc(state.v4, XXH_readLE64(p64) * PRIME64_2);\n state.v4 := XXH_rotl64(state.v4, 31);\n state.v4 := state.v4 * PRIME64_1;\n inc(p, 32 - state.memsize);\n state.memsize := 0;\n end;\n\n if (p + 32) <= bEnd then\n begin\n limit := bEnd - 32;\n v1 := state.v1;\n v2 := state.v2;\n v3 := state.v3;\n v4 := state.v4;\n repeat\n inc(v1, XXH_readLE64(p) * PRIME64_2);\n v1 := XXH_rotl64(v1, 31);\n v1 := v1 * PRIME64_1;\n inc(p, 8);\n inc(v2, XXH_readLE64(p) * PRIME64_2);\n v2 := XXH_rotl64(v2, 31);\n v2 := v2 * PRIME64_1;\n inc(p, 8);\n inc(v3, XXH_readLE64(p) * PRIME64_2);\n v3 := XXH_rotl64(v3, 31);\n v3 := v3 * PRIME64_1;\n inc(p, 8);\n inc(v4, XXH_readLE64(p) * PRIME64_2);\n v4 := XXH_rotl64(v4, 31);\n v4 := v4 * PRIME64_1;\n inc(p, 8);\n until p > limit;\n state.v1 := v1;\n state.v2 := v2;\n state.v3 := v3;\n state.v4 := v4;\n end;\n\n if p < bEnd then\n begin\n move(p^, state.mem64, bEnd - p);\n state.memsize := integer(bEnd - p);\n end;\n result := XXH_OK;\nend;\n\nfunction XXH32_digest(statePtr: PXXH32_state_t): cardinal;\nvar\n state: PXXH_istate32_t;\n p: pByte;\n bEnd: pByte;\n h32: cardinal;\nbegin\n state := PXXH_istate32_t(statePtr);\n p := @state.mem32;\n bEnd := pByte(@state.mem32) + state.memsize;\n\n if (state.total_len >= 16) then\n h32 := XXH_rotl32(state.v1, 1) + XXH_rotl32(state.v2, 7) + XXH_rotl32(state.v3, 12) + XXH_rotl32(state.v4, 18)\n else\n h32 := state.seed + PRIME32_5;\n\n inc(h32, state.total_len);\n\n while (p + 4) <= bEnd do\n begin\n inc(h32, XXH_readLE32(p) * PRIME32_3);\n h32 := XXH_rotl32(h32, 17) * PRIME32_4;\n inc(p, 4);\n end;\n\n while p < bEnd do\n begin\n inc(h32, p^ * PRIME32_5);\n h32 := XXH_rotl32(h32, 11) * PRIME32_1;\n inc(p);\n end;\n h32 := h32 xor (h32 shr 15);\n h32 := h32 * PRIME32_2;\n h32 := h32 xor (h32 shr 13);\n h32 := h32 * PRIME32_3;\n h32 := h32 xor (h32 shr 16);\n result := h32;\nend;\n\nfunction XXH64_digest(statePtr: PXXH64_state_t): uint64;\nvar\n state: PXXH_istate64_t;\n p: pByte;\n bEnd: pByte;\n h64: uint64;\n v1, v2, v3, v4: uint64;\n k1: uint64;\nbegin\n state := PXXH_istate64_t(statePtr);\n p := @state.mem64;\n bEnd := pByte(@state.mem64) + state.memsize;\n\n if state.total_len >= 32 then\n begin\n v1 := state.v1;\n v2 := state.v2;\n v3 := state.v3;\n v4 := state.v4;\n h64 := XXH_rotl64(v1, 1) + XXH_rotl64(v2, 7) + XXH_rotl64(v3, 12) + XXH_rotl64(v4, 18);\n v1 := v1 * PRIME64_2;\n v1 := XXH_rotl64(v1, 31);\n v1 := v1 * PRIME64_1;\n h64 := h64 xor v1;\n h64 := h64 * PRIME64_1 + PRIME64_4;\n\n v2 := v2 * PRIME64_2;\n v2 := XXH_rotl64(v2, 31);\n v2 := v2 * PRIME64_1;\n h64 := h64 xor v2;\n h64 := h64 * PRIME64_1 + PRIME64_4;\n\n v3 := v3 * PRIME64_2;\n v3 := XXH_rotl64(v3, 31);\n v3 := v3 * PRIME64_1;\n h64 := h64 xor v3;\n h64 := h64 * PRIME64_1 + PRIME64_4;\n\n v4 := v4 * PRIME64_2;\n v4 := XXH_rotl64(v4, 31);\n v4 := v4 * PRIME64_1;\n h64 := h64 xor v4;\n h64 := h64 * PRIME64_1 + PRIME64_4;\n end\n else\n h64 := state.seed + PRIME64_5;\n inc(h64, state.total_len);\n\n while (p + 8) <= bEnd do\n begin\n k1 := XXH_readLE64(p);\n k1 := k1 * PRIME64_2;\n k1 := XXH_rotl64(k1, 31);\n k1 := k1 * PRIME64_1;\n h64 := h64 xor k1;\n h64 := XXH_rotl64(h64, 27) * PRIME64_1 + PRIME64_4;\n inc(p, 8);\n end;\n if (p + 4) <= bEnd then\n begin\n h64 := h64 xor (uint64(XXH_readLE32(p)) * PRIME64_1);\n h64 := XXH_rotl64(h64, 23) * PRIME64_2 + PRIME64_3;\n inc(p, 4);\n end;\n\n while (p < bEnd) do\n begin\n h64 := h64 xor (p^ * PRIME64_5);\n h64 := XXH_rotl64(h64, 11) * PRIME64_1;\n inc(p);\n end;\n\n h64 := h64 xor (h64 shr 33);\n h64 := h64 * PRIME64_2;\n h64 := h64 xor (h64 shr 29);\n h64 := h64 * PRIME64_3;\n h64 := h64 xor (h64 shr 32);\n\n result := h64;\nend;\n\nfunction XXH32_createState: PXXH32_state_t;\nbegin\n result := allocmem(sizeof(XXH32_state_t));\nend;\n\nfunction XXH64_createState: PXXH64_state_t;\nbegin\n result := allocmem(sizeof(XXH64_state_t));\nend;\n\nprocedure XXH32_freeState(statePtr: PXXH32_state_t);\nbegin\n freemem(statePtr);\nend;\n\nprocedure XXH64_freeState(statePtr: PXXH64_state_t);\nbegin\n freemem(statePtr);\nend;\n\nfunction XXH32_init(seed: cardinal): PXXH32_state_t;\nbegin\n result := XXH32_createState;\n XXH32_reset(result, seed);\nend;\n\nfunction XXH64_init(seed: uint64): PXXH64_state_t;\nbegin\n result := XXH64_createState;\n XXH64_reset(result, seed);\nend;\n\nfunction XXH32_endian_align(input: pointer; len: size_t; seed: cardinal; endian: XXH_endianess; align: XXH_alignment): cardinal;\n function XXH_get32bits(p: pByte): cardinal;\n begin\n result := XXH_readLE32_align(p, endian, align);\n end;\n\nvar\n p: pByte;\n bEnd: pByte;\n h32: cardinal;\n limit: pByte;\n v1, v2, v3, v4: cardinal;\nbegin\n p := input;\n bEnd := p + len;\n if (len >= 16) then\n begin\n limit := bEnd - 16;\n v1 := seed + PRIME32_1 + PRIME32_2;\n v2 := seed + PRIME32_2;\n v3 := seed + 0;\n v4 := seed - PRIME32_1;\n while true do\n begin\n inc(v1, XXH_get32bits(p) * PRIME32_2);\n v1 := XXH_rotl32(v1, 13);\n v1 := v1 * PRIME32_1;\n inc(p, 4);\n\n inc(v2, XXH_get32bits(p) * PRIME32_2);\n v2 := XXH_rotl32(v2, 13);\n v2 := v2 * PRIME32_1;\n inc(p, 4);\n\n inc(v3, XXH_get32bits(p) * PRIME32_2);\n v3 := XXH_rotl32(v3, 13);\n v3 := v3 * PRIME32_1;\n inc(p, 4);\n\n inc(v4, XXH_get32bits(p) * PRIME32_2);\n v4 := XXH_rotl32(v4, 13);\n v4 := v4 * PRIME32_1;\n inc(p, 4);\n if p > limit then\n break;\n end;\n h32 := XXH_rotl32(v1, 1) + XXH_rotl32(v2, 7) + XXH_rotl32(v3, 12) + XXH_rotl32(v4, 18);\n end\n else\n h32 := seed + PRIME32_5;\n\n inc(h32, cardinal(len));\n while (p + 4 <= bEnd) do\n begin\n inc(h32, XXH_get32bits(p) * PRIME32_3);\n h32 := XXH_rotl32(h32, 17) * PRIME32_4;\n inc(p, 4);\n end;\n\n while (p < bEnd) do\n begin\n inc(h32, p^ * PRIME32_5);\n h32 := XXH_rotl32(h32, 11) * PRIME32_1;\n inc(p);\n end;\n\n h32 := h32 xor (h32 shr 15);\n h32 := h32 * PRIME32_2;\n h32 := h32 xor (h32 shr 13);\n h32 := h32 * PRIME32_3;\n h32 := h32 xor (h32 shr 16);\n\n result := h32;\nend;\n\nfunction XXH32(input: pointer; len: size_t; seed: cardinal): cardinal;\nbegin\n result := XXH32_endian_align(input, len, seed, XXH_littleEndian, XXH_unaligned);\nend;\n\nend.\n\n"
},
{
"path": "lib/xedit/wbBSA.pas",
"content": "{*******************************************************************************\n\n The contents of this file are subject to the Mozilla Public License\n Version 1.1 (the \"License\"); you may not use this file except in\n compliance with the License. You may obtain a copy of the License at\n http://www.mozilla.org/MPL/\n\n Software distributed under the License is distributed on an \"AS IS\"\n basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the\n License for the specific language governing rights and limitations\n under the License.\n\n*******************************************************************************}\n\nunit wbBSA;\n\n{$I wbDefines.inc}\n\ninterface\n\nuses\n Classes, SysUtils, IOUtils,\n wbInterface,\n ImagingDds;\n\nfunction wbCreateContainerHandler: IwbContainerHandler;\n\nimplementation\n\nuses\n wbStreams,\n zlibEx,\n lz4io;\n\nconst\n { https://github.com/Ethatron/bsaopt/blob/master/io/bsa.C }\n BSAHEADER_VERSION_OB = $67; // Oblivion\n BSAHEADER_VERSION_SK = $68; // Fallout3, Skyrim\n BSAHEADER_VERSION_SSE = $69; // Skyrim Special Edition\n BSAARCHIVE_COMPRESSFILES = $0004; // Whether the files are compressed in archive (invert file's compression flag)\n BSAARCHIVE_PREFIXFULLFILENAMES = $0100; // Whether the name is prefixed to the data?\n BSAFILE_COMPRESS = $40000000; // Whether the file is compressed\n { https://github.com/jonwd7/bae/blob/master/src/bsa.h }\n BA2HEADER_VERSION_FO4 = $01; // Fallout 4\n\ntype\n TwbContainerHandler = class(TInterfacedObject, IwbContainerHandler)\n private\n chContainers: array of IwbResourceContainer;\n protected\n procedure AddContainer(const aContainer: IwbResourceContainer);\n\n {---IwbContainerHandler---}\n procedure AddFolder(const aPath: string);\n procedure AddBSA(const aFileName: string);\n procedure AddBA2(const aFileName: string);\n\n function OpenResource(const aFileName: string): TDynResources;\n function OpenResourceData(const aContainerName, aFileName: string): TBytes;\n function ContainerExists(aContainerName: string): Boolean;\n procedure ContainerList(const aList: TStrings);\n procedure ContainerResourceList(const aContainerName: string; const aList: TStrings;\n const aFolder: string = '');\n function ResourceExists(const aFileName: string): Boolean;\n function ResolveHash(const aHash: Int64): TDynStrings;\n function ResourceCount(const aFileName: string; aContainers: TStrings = nil): Integer;\n procedure ResourceCopy(const aContainerName, aFileName, aPathOut: string);\n end;\n\n TwbBSAFileRec = record\n Name : string;\n Hash : Int64;\n Size : Cardinal;\n Offset : Cardinal;\n end;\n\n TwbBSAFolderRec = record\n Name : string;\n Hash : Int64;\n Files : array of TwbBSAFileRec;\n Map : TStringList;\n end;\n\n IwbBSAFileInternal = interface(IwbBSAFile)\n ['{A360B348-8F6B-4FC1-A869-9D5B833DCA5F}']\n function GetData(aOffset, aSize: Cardinal): TBytes;\n end;\n\n TwbBSAFile = class(TInterfacedObject, IwbResourceContainer, IwbBSAFile, IwbBSAFileInternal)\n private\n bfStream : TwbReadOnlyCachedFileStream;\n bfFileName : string;\n bfVersion : Cardinal;\n bfOffset : Cardinal;\n bfFlags : Cardinal;\n bfFileFlags : Cardinal;\n bfFolders : array of TwbBSAFolderRec;\n bfFolderMap : TStringList;\n\n procedure ReadDirectory;\n protected\n {---IwbResourceContainer---}\n function GetName: string;\n function OpenResource(const aFileName: string): IwbResource;\n function ResourceExists(const aFileName: string): Boolean;\n procedure ResourceList(const aList: TStrings; const aFolder: string = '');\n procedure ResolveHash(const aHash: Int64; var Results: TDynStrings);\n\n {---IwbBSAFile---}\n function GetFileName: string;\n\n {---IwbBSAFileInternal---}\n function GetData(aOffset, aSize: Cardinal):TBytes;\n public\n constructor Create(const aFileName: string);\n destructor Destroy; override;\n end;\n\n TwbBSAResource = class(TInterfacedObject, IwbResource)\n brFile : IwbBSAFileInternal;\n brOffset : Cardinal;\n brSize : Cardinal;\n protected\n {---IwbResource---}\n function GetContainer: IwbResourceContainer;\n function GetData: TBytes;\n public\n constructor Create(aFile: TwbBSAFile; aSize, aOffset: Cardinal);\n end;\n\n\n TwbBA2TexChunkRec = record\n Size : Cardinal;\n PackedSize : Cardinal;\n Offset : Int64;\n StartMip : Word;\n EndMip : Word;\n end;\n\n TwbBA2FileRec = record\n Name : string;\n NameHash : Cardinal;\n DirHash : Cardinal;\n Size : Cardinal;\n PackedSize : Cardinal;\n Offset : Int64;\n Height : Word;\n Width : Word;\n NumMips : Byte;\n DXGIFormat : Byte;\n CubeMaps : Word;\n TexChunks : array of TwbBA2TexChunkRec;\n end;\n\n IwbBA2FileInternal = interface(IwbBA2File)\n ['{87D66150-746E-4B37-B295-45C4221CDCBE}']\n procedure ReadData(var Buffer; Offset: Int64; Count: Longint);\n end;\n\n TwbBA2File = class(TInterfacedObject, IwbResourceContainer, IwbBA2File, IwbBA2FileInternal)\n private\n bfStream : TwbReadOnlyCachedFileStream;\n bfFileName : string;\n bfVersion : Cardinal;\n bfType : TwbSignature;\n bfFiles : array of TwbBA2FileRec;\n bfFolderMap : TStringList;\n\n procedure ReadDirectory;\n protected\n {---IwbResourceContainer---}\n function GetName: string;\n function OpenResource(const aFileName: string): IwbResource;\n function ResourceExists(const aFileName: string): Boolean;\n procedure ResourceList(const aList: TStrings; const aFolder: string = '');\n procedure ResolveHash(const aHash: Int64; var Results: TDynStrings);\n\n {---IwbBA2File---}\n function GetFileName: string;\n\n {---IwbBA2FileInternal---}\n procedure ReadData(var Buffer; Offset: Int64; Count: Longint);\n public\n constructor Create(const aFileName: string);\n destructor Destroy; override;\n end;\n\n TwbBA2Resource = class(TInterfacedObject, IwbResource)\n brFile : IwbBA2FileInternal;\n brFileRec : TwbBA2FileRec;\n protected\n {---IwbResource---}\n function GetContainer: IwbResourceContainer;\n function GetData: TBytes;\n public\n constructor Create(aFile: TwbBA2File; var aFileRec: TwbBA2FileRec);\n end;\n\n\n IwbFolderInternal = interface(IwbFolder)\n ['{6DF2B964-5AF7-4732-BD28-CD7600407A83}']\n end;\n\n TwbFolder = class(TInterfacedObject, IwbResourceContainer, IwbFolder, IwbFolderInternal)\n private\n fPath : string;\n protected\n {---IwbResourceContainer---}\n function GetName: string;\n function OpenResource(const aFileName: string): IwbResource;\n function ResourceExists(const aFileName: string): Boolean;\n procedure ResourceList(const aList: TStrings; const aFolder: string = '');\n procedure ResolveHash(const aHash: Int64; var Results: TDynStrings);\n\n {---IwbFolder---}\n function GetPathName: string;\n public\n constructor Create(const aPath: string);\n destructor Destroy; override;\n end;\n\n TwbFolderResource = class(TInterfacedObject, IwbResource)\n frFolder : IwbFolderInternal;\n frFileName : string;\n protected\n {---IwbResource---}\n function GetContainer: IwbResourceContainer;\n function GetData: TBytes;\n public\n constructor Create(aFolder: IwbFolderInternal; const aFileName: string);\n destructor Destroy; override;\n end;\n\n\nfunction wbCreateContainerHandler: IwbContainerHandler;\nbegin\n Result := TwbContainerHandler.Create;\nend;\n\n{ TwbContainerHandler }\n\nprocedure TwbContainerHandler.AddContainer(const aContainer: IwbResourceContainer);\nbegin\n SetLength(chContainers, Succ(Length(chContainers)));\n chContainers[High(chContainers)] := aContainer;\nend;\n\nfunction TwbContainerHandler.ContainerExists(aContainerName: string): Boolean;\nvar\n i: Integer;\nbegin\n Result := True;\n for i := Low(chContainers) to High(chContainers) do\n if SameText(chContainers[i].Name, aContainerName) then\n Exit;\n Result := False;\nend;\n\nprocedure TwbContainerHandler.AddBSA(const aFileName: string);\nbegin\n if not ContainerExists(aFileName) then\n AddContainer(TwbBSAFile.Create(aFileName));\nend;\n\nprocedure TwbContainerHandler.AddBA2(const aFileName: string);\nbegin\n if not ContainerExists(aFileName) then\n AddContainer(TwbBA2File.Create(aFileName));\nend;\n\nprocedure TwbContainerHandler.AddFolder(const aPath: string);\nbegin\n if not ContainerExists(aPath) then\n AddContainer(TwbFolder.Create(aPath));\nend;\n\nfunction TwbContainerHandler.OpenResource(const aFileName: string): TDynResources;\nvar\n i, j: Integer;\nbegin\n SetLength(Result, Length(chContainers));\n j := 0;\n for i := Low(chContainers) to High(chContainers) do begin\n Result[j] := chContainers[i].OpenResource(aFileName);\n if Assigned(Result[j]) then\n Inc(j);\n end;\n SetLength(Result, j);\nend;\n\nfunction TwbContainerHandler.OpenResourceData(const aContainerName, aFileName: string): TBytes;\nvar\n Res : TDynResources;\n i : Integer;\nbegin\n Res := OpenResource(aFileName);\n\n if Length(Res) = 0 then\n Exit;\n\n for i := High(Res) downto Low(Res) do\n if (aContainerName = '') or SameText(Res[i].Container.Name, aContainerName) then begin\n Result := Res[i].GetData;\n Break;\n end;\nend;\n\nprocedure TwbContainerHandler.ContainerList(const aList: TStrings);\nvar\n i: Integer;\nbegin\n if not Assigned(aList) then\n Exit;\n\n for i := Low(chContainers) to High(chContainers) do\n aList.Add(chContainers[i].Name);\nend;\n\nprocedure TwbContainerHandler.ContainerResourceList(const aContainerName: string; const aList: TStrings;\n const aFolder: string = '');\nvar\n i: Integer;\nbegin\n for i := Low(chContainers) to High(chContainers) do\n if SameText(chContainers[i].Name, aContainerName) then begin\n chContainers[i].ResourceList(aList, aFolder);\n Break;\n end;\nend;\n\nfunction TwbContainerHandler.ResourceExists(const aFileName: string): Boolean;\nvar\n i: Integer;\nbegin\n Result := False;\n for i := Low(chContainers) to High(chContainers) do\n if chContainers[i].ResourceExists(aFileName) then begin\n Result := True;\n Exit;\n end;\nend;\n\nfunction TwbContainerHandler.ResolveHash(const aHash: Int64): TDynStrings;\nvar\n i: Integer;\nbegin\n Result := nil;\n for i := Low(chContainers) to High(chContainers) do\n chContainers[i].ResolveHash(aHash, Result);\nend;\n\nfunction TwbContainerHandler.ResourceCount(const aFileName: string; aContainers: TStrings = nil): Integer;\nvar\n i: Integer;\nbegin\n Result := 0;\n for i := Low(chContainers) to High(chContainers) do\n if chContainers[i].ResourceExists(aFileName) then begin\n Inc(Result);\n if Assigned(aContainers) then\n aContainers.Add(chContainers[i].Name);\n end;\nend;\n\nprocedure TwbContainerHandler.ResourceCopy(const aContainerName, aFileName, aPathOut: string);\nvar\n fn, dir : string;\n aData : TBytes;\n res : TDynResources;\n i, residx : integer;\nbegin\n if aPathOut = '' then\n raise Exception.Create('Destination path is not specified');\n\n res := OpenResource(aFileName);\n\n if Length(res) = 0 then\n raise Exception.Create('Resource doesn''t exist');\n\n residx := High(res);\n for i := High(res) to Low(res) do\n if (aContainerName = '') or SameText(res[i].Container.Name, aContainerName) then begin\n residx := i;\n Break;\n end;\n\n // file name is provided instead of path\n if TPath.HasExtension(aPathOut) then\n fn := aPathOut\n // destination path is provided\n else\n fn := IncludeTrailingPathDelimiter(aPathOut) + aFileName;\n\n // create distination directory\n dir := ExtractFilePath(fn);\n if not DirectoryExists(dir) then\n if not ForceDirectories(dir) then\n raise Exception.Create('Unable to create destination directory ' + dir);\n\n // direct copy if file is loose, with overwriting\n if ExtractFileExt(res[residx].Container.Name) = '' then begin\n TFile.Copy(res[residx].Container.Name + aFileName, fn, True);\n end\n // otherwise extract from BSA\n else begin\n aData := res[residx].GetData;\n // exception handled outside\n with TFileStream.Create(fn, fmCreate) do try\n WriteBuffer(aData[0], Length(aData));\n finally\n Free;\n end;\n end;\nend;\n\n\n{ TwbBSAFile }\n\nconstructor TwbBSAFile.Create(const aFileName: string);\nbegin\n bfFileName := aFileName;\n bfStream := TwbReadOnlyCachedFileStream.Create(aFileName);\n ReadDirectory;\nend;\n\ndestructor TwbBSAFile.Destroy;\nvar\n i: Integer;\nbegin\n FreeAndNil(bfStream);\n for i := Low(bfFolders) to High(bfFolders) do with bfFolders[i] do\n FreeAndNil(Map);\n FreeAndNil(bfFolderMap);\n inherited;\nend;\n\nfunction TwbBSAFile.GetData(aOffset, aSize: Cardinal): TBytes;\nvar\n IsCompressed : Boolean;\n Buffer : TBytes;\nbegin\n IsCompressed := (aSize and BSAFILE_COMPRESS) <> 0;\n if IsCompressed then\n aSize := aSize and not BSAFILE_COMPRESS;\n if (bfFlags and BSAARCHIVE_COMPRESSFILES) <> 0 then\n IsCompressed := not IsCompressed;\n bfStream.Position := aOffset;\n if (bfVersion >= BSAHEADER_VERSION_SK) and ((bfFlags and BSAARCHIVE_PREFIXFULLFILENAMES) <> 0) then\n // size - file name length (no terminator) - string length prefix\n aSize := aSize - Length(bfStream.ReadStringLen(False)) - 1;\n if IsCompressed then begin\n SetLength(Result, bfStream.ReadCardinal);\n aSize := aSize - 4;\n if (Length(Result) > 0) and (aSize > 0) then begin\n SetLength(Buffer, aSize);\n bfStream.ReadBuffer(Buffer[0], Length(Buffer));\n if bfVersion = BSAHEADER_VERSION_SSE then\n lz4DecompressToUserBuf(@Buffer[0], Length(Buffer), @Result[0], Length(Result))\n else\n DecompressToUserBuf(@Buffer[0], Length(Buffer), @Result[0], Length(Result));\n end;\n end else begin\n SetLength(Result, aSize);\n if aSize > 0 then\n bfStream.ReadBuffer(Result[0], aSize);\n end;\nend;\n\nfunction TwbBSAFile.GetFileName: string;\nbegin\n Result := bfFileName;\nend;\n\nfunction TwbBSAFile.GetName: string;\nbegin\n Result := GetFileName;\nend;\n\nfunction TwbBSAFile.OpenResource(const aFileName: string): IwbResource;\nvar\n lPath, lName: string;\n i, j: Integer;\nbegin\n Result := nil;\n lPath := ExtractFilePath(aFileName);\n SetLength(lPath, Pred(Length(lPath)));\n lName := ExtractFileName(aFileName);\n if bfFolderMap.Find(lPath, i) then\n with bfFolders[Integer(bfFolderMap.Objects[i])] do\n if Map.Find(lName, j) then\n with Files[Integer(Map.Objects[j])] do\n Result := TwbBSAResource.Create(Self, Size, Offset);\nend;\n\nfunction TwbBSAFile.ResourceExists(const aFileName: string): Boolean;\nvar\n lPath, lName: string;\n i: Integer;\nbegin\n Result := False;\n lPath := ExtractFilePath(aFileName);\n SetLength(lPath, Pred(Length(lPath)));\n lName := ExtractFileName(aFileName);\n if bfFolderMap.Find(lPath, i) then\n Result := bfFolders[Integer(bfFolderMap.Objects[i])].Map.IndexOf(lName) <> -1;\nend;\n\nprocedure TwbBSAFile.ResourceList(const aList: TStrings; const aFolder: string = '');\nvar\n i, j: Integer;\n Folder: string;\nbegin\n if not Assigned(aList) then\n Exit;\n Folder := ExcludeTrailingPathDelimiter(aFolder);\n for i := Low(bfFolders) to High(bfFolders) do with bfFolders[i] do\n if (aFolder = '') or SameText(Folder, Name) then\n for j := Low(Files) to High(Files) do\n aList.Add(Name + '\\' + Files[j].Name);\nend;\n\nprocedure TwbBSAFile.ReadDirectory;\nvar\n i, j : Integer;\n OldPos : Int64;\n NewPos : Int64;\n// FileCount : Cardinal;\n// totalFolderNameLength : Cardinal;\n totalFileNameLength : Cardinal;\nbegin\n if bfStream.ReadSignature <> 'BSA' then\n raise Exception.Create(bfFileName + ' is not a valid BSA file');\n bfVersion := bfStream.ReadCardinal;\n if not (bfVersion in [BSAHEADER_VERSION_OB, BSAHEADER_VERSION_SK, BSAHEADER_VERSION_SSE]) then\n raise Exception.Create(bfFileName + ' has unknown version: ' + IntToStr(bfVersion) );\n bfOffset := bfStream.ReadCardinal;\n if bfOffset <> $24 then\n raise Exception.Create(bfFileName + ' has unexpected Offset: ' + IntToStr(bfOffset) );\n bfFlags := bfStream.ReadCardinal;\n SetLength(bfFolders, bfStream.ReadCardinal);\n {FileCount := } bfStream.ReadCardinal; //skip file count\n {totalFolderNameLength := } bfStream.ReadCardinal; //skip totalFolderNameLength\n totalFileNameLength := bfStream.ReadCardinal; //skip totalFileNameLength\n bfFileFlags := bfStream.ReadCardinal;\n OldPos := bfStream.Position;\n for i := Low(bfFolders) to High(bfFolders) do with bfFolders[i] do begin\n bfStream.Position := OldPos;\n Hash := bfStream.ReadInt64; // skip hash\n SetLength(Files, bfStream.ReadCardinal);\n if bfVersion = BSAHEADER_VERSION_SSE then begin\n bfStream.ReadCardinal; // skip unk32\n NewPos := bfStream.ReadInt64;\n end else\n NewPos := bfStream.ReadCardinal;\n OldPos := bfStream.Position;\n bfStream.Position := NewPos - totalFileNameLength;\n Name := bfStream.ReadStringLen;\n for j := Low(Files) to High(Files) do with Files[j] do begin\n Hash := bfStream.ReadInt64; // skip hash\n Size := bfStream.ReadCardinal;\n Offset := bfStream.ReadCardinal;\n end;\n end;\n bfFolderMap := TwbFastStringList.Create;\n for i := Low(bfFolders) to High(bfFolders) do with bfFolders[i] do begin\n bfFolderMap.AddObject(Name, TObject(i));\n Map := TwbFastStringList.Create;\n for j := Low(Files) to High(Files) do with Files[j] do begin\n Name := bfStream.ReadStringTerm;\n Map.AddObject(Name, TObject(j));\n end;\n Map.Sorted := True;\n end;\n bfFolderMap.Sorted := True;\nend;\n\nprocedure TwbBSAFile.ResolveHash(const aHash: Int64; var Results: TDynStrings);\nvar\n i, j: Integer;\nbegin\n for i := Low(bfFolders) to High(bfFolders) do with bfFolders[i] do begin\n if Hash = aHash then begin\n SetLength(Results, Succ(Length(Results)));\n Results[High(Results)] := Name;\n end;\n for j := Low(Files) to High(Files) do with Files[j] do begin\n if Hash = aHash then begin\n SetLength(Results, Succ(Length(Results)));\n Results[High(Results)] := Name;\n end;\n end;\n end;\nend;\n\n{ TwbBSAResource }\n\nconstructor TwbBSAResource.Create(aFile: TwbBSAFile; aSize, aOffset: Cardinal);\nbegin\n brFile := aFile;\n brOffset := aOffset;\n brSize := aSize;\nend;\n\nfunction TwbBSAResource.GetContainer: IwbResourceContainer;\nbegin\n Result := brFile;\nend;\n\nfunction TwbBSAResource.GetData: TBytes;\nbegin\n Result := brFile.GetData(brOffset, brSize);\nend;\n\n\n{ TwbBA2File }\n\nconstructor TwbBA2File.Create(const aFileName: string);\nbegin\n bfFileName := aFileName;\n bfStream := TwbReadOnlyCachedFileStream.Create(aFileName);\n ReadDirectory;\nend;\n\ndestructor TwbBA2File.Destroy;\nvar\n i: integer;\nbegin\n FreeAndNil(bfStream);\n for i := 0 to Pred(bfFolderMap.Count) do\n TStringList(bfFolderMap.Objects[i]).Free;\n FreeAndNil(bfFolderMap);\n inherited;\nend;\n\nprocedure TwbBA2File.ReadDirectory;\nvar\n i, j : Integer;\n OldPos : Int64;\n FileCount : Cardinal;\n FileTablePosition: Int64;\n NumChunks: Byte;\n folder: string;\nbegin\n if bfStream.ReadSignature <> 'BTDX' then\n raise Exception.Create(bfFileName + ' is not a valid BA2 file');\n bfVersion := bfStream.ReadCardinal;\n if bfVersion <> BA2HEADER_VERSION_FO4 then\n raise Exception.Create(bfFileName + ' has unknown version: ' + IntToStr(bfVersion) );\n bfType := bfStream.ReadSignature;\n if (bfType <> 'GNRL') and (bfType <> 'DX10') then\n raise Exception.Create(bfFileName + ' has unknown type: ' + String(bfType));\n FileCount := bfStream.ReadCardinal;\n FileTablePosition := bfStream.ReadInt64;\n OldPos := bfStream.Position;\n bfStream.Position := FileTablePosition;\n SetLength(bfFiles, FileCount);\n for i := Low(bfFiles) to High(bfFiles) do begin\n bfFiles[i].Name := bfStream.ReadStringLen16;\n end;\n bfStream.Position := OldPos;\n\n if bfType = 'GNRL' then begin\n for i := Low(bfFiles) to High(bfFiles) do begin\n bfFiles[i].NameHash := bfStream.ReadCardinal;\n bfStream.ReadCardinal; // skip ext\n bfFiles[i].DirHash := bfStream.ReadCardinal;\n bfStream.ReadCardinal; // skip unk0C\n bfFiles[i].Offset := bfStream.ReadInt64;\n bfFiles[i].PackedSize := bfStream.ReadCardinal;\n bfFiles[i].Size := bfStream.ReadCardinal;\n bfStream.ReadCardinal; // skip BAADF00D\n end;\n end\n else if bfType = 'DX10' then begin\n for i := Low(bfFiles) to High(bfFiles) do begin\n bfFiles[i].NameHash := bfStream.ReadCardinal;\n bfStream.ReadCardinal; // skip ext\n bfFiles[i].DirHash := bfStream.ReadCardinal;\n bfStream.ReadByte; // skip unk0C\n NumChunks := bfStream.ReadByte;\n bfStream.ReadWord; // skip chunkHeaderSize\n bfFiles[i].Height := bfStream.ReadWord;\n bfFiles[i].Width := bfStream.ReadWord;\n bfFiles[i].NumMips := bfStream.ReadByte;\n bfFiles[i].DXGIFormat := bfStream.ReadByte;\n bfFiles[i].CubeMaps := bfStream.ReadWord;\n SetLength(bfFiles[i].TexChunks, NumChunks);\n for j := Low(bfFiles[i].TexChunks) to High(bfFiles[i].TexChunks) do\n with bfFiles[i].TexChunks[j] do begin\n Offset := bfStream.ReadInt64;\n PackedSize := bfStream.ReadCardinal;\n Size := bfStream.ReadCardinal;\n StartMip := bfStream.ReadWord;\n EndMip := bfStream.ReadWord;\n bfStream.ReadCardinal; // skip BAADF00D\n end;\n end;\n end;\n\n bfFolderMap := TwbFastStringList.Create;\n bfFolderMap.Sorted := True;\n for i := Low(bfFiles) to High(bfFiles) do begin\n folder := LowerCase(ExtractFilePath(bfFiles[i].Name));\n SetLength(folder, Pred(Length(folder)));\n j := bfFolderMap.IndexOf(folder);\n if not bfFolderMap.Find(folder, j) then begin\n bfFolderMap.AddObject(folder, TwbFastStringList.Create);\n if not bfFolderMap.Find(folder, j) then\n raise Exception.Create('Indexing error');\n end;\n TStringList(bfFolderMap.Objects[j]).AddObject(LowerCase(ExtractFileName(bfFiles[i].Name)), TObject(i));\n end;\n for i := 0 to Pred(bfFolderMap.Count) do\n TStringList(bfFolderMap.Objects[i]).Sorted := True;\nend;\n\nfunction TwbBA2File.GetFileName: string;\nbegin\n Result := bfFileName;\nend;\n\nfunction TwbBA2File.GetName: string;\nbegin\n Result := GetFileName;\nend;\n\nprocedure TwbBA2File.ReadData(var Buffer; Offset: Int64; Count: Longint);\nbegin\n bfStream.Position := Offset;\n bfStream.ReadBuffer(Buffer, Count);\nend;\n\nfunction TwbBA2File.OpenResource(const aFileName: string): IwbResource;\nvar\n lPath, lName: string;\n i, j: Integer;\nbegin\n lPath := LowerCase(ExtractFilePath(aFileName));\n SetLength(lPath, Pred(Length(lPath)));\n lName := LowerCase(ExtractFileName(aFileName));\n if bfFolderMap.Find(lPath, i) then with TStringList(bfFolderMap.Objects[i]) do\n if Find(lName, j) then\n Result := TwbBA2Resource.Create(Self, bfFiles[Integer(Objects[j])]);\nend;\n\nprocedure TwbBA2File.ResolveHash(const aHash: Int64; var Results: TDynStrings);\nbegin\n // ...\nend;\n\nfunction TwbBA2File.ResourceExists(const aFileName: string): Boolean;\nvar\n lPath, lName: string;\n i: Integer;\nbegin\n Result := False;\n lPath := LowerCase(ExtractFilePath(aFileName));\n SetLength(lPath, Pred(Length(lPath)));\n lName := LowerCase(ExtractFileName(aFileName));\n if bfFolderMap.Find(lPath, i) then\n Result := TStringList(bfFolderMap.Objects[i]).IndexOf(lName) <> -1;\nend;\n\nprocedure TwbBA2File.ResourceList(const aList: TStrings; const aFolder: string = '');\nvar\n i: Integer;\nbegin\n if not Assigned(aList) then\n Exit;\n for i := Low(bfFiles) to High(bfFiles) do\n aList.Add(LowerCase(bfFiles[i].Name));\nend;\n\n\n{ TwbBA2Resource }\n\nconstructor TwbBA2Resource.Create(aFile: TwbBA2File; var aFileRec: TwbBA2FileRec);\nbegin\n brFile := aFile;\n brFileRec := aFileRec;\nend;\n\nfunction TwbBA2Resource.GetContainer: IwbResourceContainer;\nbegin\n Result := brFile;\nend;\n\nfunction TwbBA2Resource.GetData: TBytes;\nconst\n FOURCC_BC7 = LongWord(Byte('B') or (Byte('C') shl 8) or (Byte('7') shl 16) or\n (Byte(0) shl 24));\nvar\n Buffer : TBytes;\n Hdr: ^TDDSFileHeader;\n TexSize, i: integer;\nbegin\n // GNRL resource\n if (brFileRec.Size <> 0) and (Length(brFileRec.TexChunks) = 0) then begin\n if brFileRec.PackedSize <> 0 then begin\n SetLength(Buffer, brFileRec.PackedSize);\n brFile.ReadData(Buffer[0], brFileRec.Offset, Length(Buffer));\n SetLength(Result, brFileRec.Size);\n DecompressToUserBuf(@Buffer[0], Length(Buffer), @Result[0], Length(Result));\n end\n else begin\n SetLength(Result, brFileRec.Size);\n brFile.ReadData(Result[0], brFileRec.Offset, Length(Result));\n end;\n end\n // DX10 texture\n else if Length(brFileRec.TexChunks) <> 0 then begin\n // calculate texture size including header\n TexSize := SizeOf(TDDSFileHeader);\n for i := Low(brFileRec.TexChunks) to High(brFileRec.TexChunks) do\n Inc(TexSize, brFileRec.TexChunks[i].Size);\n SetLength(Result, TexSize);\n // fill DDS header\n Hdr := @Result[0];\n hdr.Magic := DDSMagic;\n hdr.Desc.Size := SizeOf(hdr.Desc);\n hdr.Desc.Width := brFileRec.Width;\n hdr.Desc.Height := brFileRec.Height;\n hdr.Desc.Flags := DDS_SAVE_FLAGS or DDSD_MIPMAPCOUNT;\n hdr.Desc.Caps.Caps1 := DDSCAPS_TEXTURE or DDSCAPS_MIPMAP;\n hdr.Desc.MipMaps := brFileRec.NumMips;\n if brFileRec.CubeMaps = 2049 then\n hdr.Desc.Caps.Caps2 := DDSCAPS2_POSITIVEX or DDSCAPS2_NEGATIVEX\n or DDSCAPS2_POSITIVEY or DDSCAPS2_NEGATIVEY\n or DDSCAPS2_POSITIVEZ or DDSCAPS2_NEGATIVEZ\n or DDSCAPS2_CUBEMAP;\n hdr.Desc.PixelFormat.Size := SizeOf(hdr.Desc.PixelFormat);\n case TDXGIFormat(brFileRec.DXGIFormat) of\n DXGI_FORMAT_BC1_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_FOURCC;\n hdr.Desc.PixelFormat.FourCC := FOURCC_DXT1;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height div 4;\n end;\n DXGI_FORMAT_BC2_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_FOURCC;\n hdr.Desc.PixelFormat.FourCC := FOURCC_DXT3;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height;\n end;\n DXGI_FORMAT_BC3_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_FOURCC;\n hdr.Desc.PixelFormat.FourCC := FOURCC_DXT5;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height;\n end;\n DXGI_FORMAT_BC5_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_FOURCC;\n hdr.Desc.PixelFormat.FourCC := FOURCC_ATI2;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height;\n end;\n DXGI_FORMAT_BC7_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_FOURCC;\n hdr.Desc.PixelFormat.FourCC := FOURCC_BC7;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height;\n end;\n DXGI_FORMAT_B8G8R8A8_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_RGB;\n hdr.Desc.PixelFormat.BitCount := 32;\n hdr.Desc.PixelFormat.RedMask := $00FF0000;\n hdr.Desc.PixelFormat.GreenMask := $0000FF00;\n hdr.Desc.PixelFormat.BlueMask := $000000FF;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height * 4;\n end;\n DXGI_FORMAT_R8_UNORM: begin\n hdr.Desc.PixelFormat.Flags := DDPF_RGB;\n hdr.Desc.PixelFormat.BitCount := 8;\n hdr.Desc.PixelFormat.RedMask := $FF;\n hdr.Desc.PitchOrLinearSize := brFileRec.Width * brFileRec.Height;\n end;\n end;\n // append chunks\n TexSize := SizeOf(TDDSFileHeader);\n for i := Low(brFileRec.TexChunks) to High(brFileRec.TexChunks) do with brFileRec.TexChunks[i] do begin\n // compressed chunk\n if PackedSize <> 0 then begin\n SetLength(Buffer, PackedSize);\n brFile.ReadData(Buffer[0], Offset, Length(Buffer));\n DecompressToUserBuf(@Buffer[0], Length(Buffer), @Result[TexSize], Size);\n end\n // uncompressed chunk\n else\n brFile.ReadData(Result[TexSize], Offset, Size);\n Inc(TexSize, Size);\n end;\n end;\nend;\n\n\n{ TwbFolder }\n\nconstructor TwbFolder.Create(const aPath: string);\nbegin\n fPath := IncludeTrailingPathDelimiter(aPath);\nend;\n\ndestructor TwbFolder.Destroy;\nbegin\n\n inherited;\nend;\n\nfunction TwbFolder.GetPathName: string;\nbegin\n Result := fPath;\nend;\n\nfunction TwbFolder.GetName: string;\nbegin\n Result := GetPathName;\nend;\n\nfunction TwbFolder.OpenResource(const aFileName: string): IwbResource;\nvar\n s: string;\nbegin\n s := fPath + aFileName;\n if FileExists(s) then\n Result := TwbFolderResource.Create(Self, s);\nend;\n\nfunction TwbFolder.ResourceExists(const aFileName: string): Boolean;\nbegin\n Result := FileExists(fPath + aFileName);\nend;\n\nprocedure TwbFolder.ResourceList(const aList: TStrings; const aFolder: string = '');\nvar\n FileName: string;\nbegin\n if not Assigned(aList) then\n Exit;\n if TDirectory.Exists(fPath + aFolder) then\n for FileName in TDirectory.GetFiles(fPath + aFolder, '*.*', TSearchOption.soAllDirectories) do\n aList.Add(LowerCase(Copy(FileName, Length(fPath) + 1, Length(FileName))));\nend;\n\nprocedure TwbFolder.ResolveHash(const aHash: Int64; var Results: TDynStrings);\nbegin\n //...\nend;\n\n{ TwbFolderResource }\n\nconstructor TwbFolderResource.Create(aFolder: IwbFolderInternal; const aFileName: string);\nbegin\n frFolder := aFolder;\n frFileName := aFileName;\nend;\n\ndestructor TwbFolderResource.Destroy;\nbegin\n\n inherited;\nend;\n\nfunction TwbFolderResource.GetContainer: IwbResourceContainer;\nbegin\n Result := frFolder;\nend;\n\nfunction TwbFolderResource.GetData: TBytes;\nbegin\n with TFileStream.Create(frFileName, fmOpenRead or fmShareDenyWrite) do try\n SetLength(Result, Size);\n if Length(Result) > 0 then\n ReadBuffer(Result[0], Length(Result));\n finally\n Free;\n end;\nend;\n\nend.\n"
},
{
"path": "lib/xedit/wbDefines.inc",
"content": "{*******************************************************************************\n\n The contents of this file are subject to the Mozilla Public License\n Version 1.1 (the \"License\"); you may not use this file except in\n compliance with the License. You may obtain a copy of the License at\n http://www.mozilla.org/MPL/\n\n Software distributed under the License is distributed on an \"AS IS\"\n basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the\n License for the specific language governing rights and limitations\n under the License.\n\n*******************************************************************************}\n\n{.$DEFINE USE_CODESITE}"
},
{
"path": "lib/xedit/wbDefinitionsFNV.pas",
"content": "{*******************************************************************************\n\n The contents of this file are subject to the Mozilla Public License\n Version 1.1 (the \"License\"); you may not use this file except in\n compliance with the License. You may obtain a copy of the License at\n http://www.mozilla.org/MPL/\n\n Software distributed under the License is distributed on an \"AS IS\"\n basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the\n License for the specific language governing rights and limitations\n under the License.\n\n*******************************************************************************}\n\nunit wbDefinitionsFNV;\n\n{$I wbDefines.inc}\n\ninterface\n\nuses\n wbInterface;\n\nvar\n\twbAggroRadiusFlags: IwbFlagsDef;\n\twbPKDTFlags: IwbFlagsDef;\n\twbRecordFlagsFlags: IwbFlagsDef;\n\twbServiceFlags: IwbFlagsDef;\n\twbTemplateFlags: IwbFlagsDef;\n\n\twbAgressionEnum: IwbEnumDef;\n\twbAlignmentEnum: IwbEnumDef;\n\twbArchtypeEnum: IwbEnumDef;\n\twbAssistanceEnum: IwbEnumDef;\n\twbAttackAnimationEnum: IwbEnumDef;\n\twbAxisEnum: IwbEnumDef;\n\twbBlendModeEnum: IwbEnumDef;\n\twbBlendOpEnum: IwbEnumDef;\n\twbBodyLocationEnum: IwbEnumDef;\n\twbBodyPartIndexEnum: IwbEnumDef;\n\twbConfidenceEnum: IwbEnumDef;\n\twbCreatureTypeEnum: IwbEnumDef;\n\twbCrimeTypeEnum: IwbEnumDef;\n\twbCriticalStageEnum: IwbEnumDef;\n\twbEquipTypeEnum: IwbEnumDef;\n\twbFormTypeEnum: IwbEnumDef;\n\twbFunctionsEnum: IwbEnumDef;\n\twbHeadPartIndexEnum: IwbEnumDef;\n\twbImpactMaterialTypeEnum: IwbEnumDef;\n\twbMenuModeEnum: IwbEnumDef;\n\twbMiscStatEnum: IwbEnumDef;\n\twbModEffectEnum: IwbEnumDef;\n\twbMoodEnum: IwbEnumDef;\n\twbMusicEnum: IwbEnumDef;\n\twbObjectTypeEnum: IwbEnumDef;\n\twbPKDTType: IwbEnumDef;\n\twbPlayerActionEnum: IwbEnumDef;\n\twbQuadrantEnum: IwbEnumDef;\n\twbReloadAnimEnum: IwbEnumDef;\n\twbSexEnum: IwbEnumDef;\n\twbSkillEnum: IwbEnumDef;\n\twbSoundLevelEnum: IwbEnumDef;\n\twbSpecializationEnum: IwbEnumDef;\n\twbVatsValueFunctionEnum: IwbEnumDef;\n\twbWeaponAnimTypeEnum: IwbEnumDef;\n\twbZTestFuncEnum: IwbEnumDef;\n\nfunction wbCreaLevelDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\n\nprocedure DefineFNV;\n\nimplementation\n\nuses\n Types,\n Classes,\n SysUtils,\n Math,\n Variants,\n wbHelpers;\n\nconst\n _00_IAD: TwbSignature = #$00'IAD';\n _40_IAD: TwbSignature = #$40'IAD';\n _01_IAD: TwbSignature = #$01'IAD';\n _41_IAD: TwbSignature = #$41'IAD';\n _02_IAD: TwbSignature = #$02'IAD';\n _42_IAD: TwbSignature = #$42'IAD';\n _03_IAD: TwbSignature = #$03'IAD';\n _43_IAD: TwbSignature = #$43'IAD';\n _04_IAD: TwbSignature = #$04'IAD';\n _44_IAD: TwbSignature = #$44'IAD';\n _05_IAD: TwbSignature = #$05'IAD';\n _45_IAD: TwbSignature = #$45'IAD';\n _06_IAD: TwbSignature = #$06'IAD';\n _46_IAD: TwbSignature = #$46'IAD';\n _07_IAD: TwbSignature = #$07'IAD';\n _47_IAD: TwbSignature = #$47'IAD';\n _08_IAD: TwbSignature = #$08'IAD';\n _48_IAD: TwbSignature = #$48'IAD';\n _09_IAD: TwbSignature = #$09'IAD';\n _49_IAD: TwbSignature = #$49'IAD';\n _0A_IAD: TwbSignature = #$0A'IAD';\n _4A_IAD: TwbSignature = #$4A'IAD';\n _0B_IAD: TwbSignature = #$0B'IAD';\n _4B_IAD: TwbSignature = #$4B'IAD';\n _0C_IAD: TwbSignature = #$0C'IAD';\n _4C_IAD: TwbSignature = #$4C'IAD';\n _0D_IAD: TwbSignature = #$0D'IAD';\n _4D_IAD: TwbSignature = #$4D'IAD';\n _0E_IAD: TwbSignature = #$0E'IAD';\n _4E_IAD: TwbSignature = #$4E'IAD';\n _0F_IAD: TwbSignature = #$0F'IAD';\n _4F_IAD: TwbSignature = #$4F'IAD';\n _10_IAD: TwbSignature = #$10'IAD';\n _50_IAD: TwbSignature = #$50'IAD';\n _11_IAD: TwbSignature = #$11'IAD';\n _51_IAD: TwbSignature = #$51'IAD';\n _12_IAD: TwbSignature = #$12'IAD';\n _52_IAD: TwbSignature = #$52'IAD';\n _13_IAD: TwbSignature = #$13'IAD';\n _53_IAD: TwbSignature = #$53'IAD';\n _14_IAD: TwbSignature = #$14'IAD';\n _54_IAD: TwbSignature = #$54'IAD';\n\n _0_IAD : TwbSignature = #0'IAD';\n _1_IAD : TwbSignature = #1'IAD';\n _2_IAD : TwbSignature = #2'IAD';\n _3_IAD : TwbSignature = #3'IAD';\n _4_IAD : TwbSignature = #4'IAD';\n _5_IAD : TwbSignature = #5'IAD';\n ACBS : TwbSignature = 'ACBS';\n ACHR : TwbSignature = 'ACHR';\n ACRE : TwbSignature = 'ACRE';\n ACTI : TwbSignature = 'ACTI';\n ADDN : TwbSignature = 'ADDN';\n AIDT : TwbSignature = 'AIDT';\n ALCH : TwbSignature = 'ALCH';\n AMMO : TwbSignature = 'AMMO';\n ANAM : TwbSignature = 'ANAM';\n ANIO : TwbSignature = 'ANIO';\n ARMA : TwbSignature = 'ARMA';\n ARMO : TwbSignature = 'ARMO';\n ASPC : TwbSignature = 'ASPC';\n ATTR : TwbSignature = 'ATTR';\n ATXT : TwbSignature = 'ATXT';\n AVIF : TwbSignature = 'AVIF';\n BIPL : TwbSignature = 'BIPL';\n BMCT : TwbSignature = 'BMCT';\n BMDT : TwbSignature = 'BMDT';\n BNAM : TwbSignature = 'BNAM';\n BOOK : TwbSignature = 'BOOK';\n BPND : TwbSignature = 'BPND';\n BPNI : TwbSignature = 'BPNI';\n BPNN : TwbSignature = 'BPNN';\n BPNT : TwbSignature = 'BPNT';\n BPTD : TwbSignature = 'BPTD';\n BPTN : TwbSignature = 'BPTN';\n BTXT : TwbSignature = 'BTXT';\n CAMS : TwbSignature = 'CAMS';\n CELL : TwbSignature = 'CELL';\n CLAS : TwbSignature = 'CLAS';\n CLMT : TwbSignature = 'CLMT';\n CNAM : TwbSignature = 'CNAM';\n MMRK : TwbSignature = 'MMRK';\n CNTO : TwbSignature = 'CNTO';\n COBJ : TwbSignature = 'COBJ';\n COED : TwbSignature = 'COED';\n CONT : TwbSignature = 'CONT';\n CPTH : TwbSignature = 'CPTH';\n CRDT : TwbSignature = 'CRDT';\n CREA : TwbSignature = 'CREA';\n CSAD : TwbSignature = 'CSAD';\n CSCR : TwbSignature = 'CSCR';\n CSDC : TwbSignature = 'CSDC';\n CSDI : TwbSignature = 'CSDI';\n CSDT : TwbSignature = 'CSDT';\n CSSD : TwbSignature = 'CSSD';\n CSTD : TwbSignature = 'CSTD';\n CSTY : TwbSignature = 'CSTY';\n CTDA : TwbSignature = 'CTDA';\n DATA : TwbSignature = 'DATA';\n DAT2 : TwbSignature = 'DAT2';\n DEBR : TwbSignature = 'DEBR';\n DELE : TwbSignature = 'DELE';\n DESC : TwbSignature = 'DESC';\n DEST : TwbSignature = 'DEST';\n DIAL : TwbSignature = 'DIAL';\n DMDL : TwbSignature = 'DMDL';\n DMDT : TwbSignature = 'DMDT';\n DNAM : TwbSignature = 'DNAM';\n DOBJ : TwbSignature = 'DOBJ';\n DODT : TwbSignature = 'DODT';\n DOOR : TwbSignature = 'DOOR';\n DSTD : TwbSignature = 'DSTD';\n DSTF : TwbSignature = 'DSTF';\n EAMT : TwbSignature = 'EAMT';\n ECZN : TwbSignature = 'ECZN';\n EDID : TwbSignature = 'EDID';\n EFID : TwbSignature = 'EFID';\n EFIT : TwbSignature = 'EFIT';\n EFSD : TwbSignature = 'EFSD';\n EFSH : TwbSignature = 'EFSH';\n EITM : TwbSignature = 'EITM';\n ENAM : TwbSignature = 'ENAM';\n ENCH : TwbSignature = 'ENCH';\n ENIT : TwbSignature = 'ENIT';\n EPF2 : TwbSignature = 'EPF2';\n EPF3 : TwbSignature = 'EPF3';\n EPFD : TwbSignature = 'EPFD';\n EPFT : TwbSignature = 'EPFT';\n ESCE : TwbSignature = 'ESCE';\n ETYP : TwbSignature = 'ETYP';\n EXPL : TwbSignature = 'EXPL';\n EYES : TwbSignature = 'EYES';\n FACT : TwbSignature = 'FACT';\n FGGA : TwbSignature = 'FGGA';\n FGGS : TwbSignature = 'FGGS';\n FGTS : TwbSignature = 'FGTS';\n FLST : TwbSignature = 'FLST';\n FLTV : TwbSignature = 'FLTV';\n FNAM : TwbSignature = 'FNAM';\n FULL : TwbSignature = 'FULL';\n FURN : TwbSignature = 'FURN';\n GLOB : TwbSignature = 'GLOB';\n RDID : TwbSignature = 'RDID';\n RDSI : TwbSignature = 'RDSI';\n RDSB : TwbSignature = 'RDSB';\n GMST : TwbSignature = 'GMST';\n GNAM : TwbSignature = 'GNAM';\n GRAS : TwbSignature = 'GRAS';\n HAIR : TwbSignature = 'HAIR';\n HCLR : TwbSignature = 'HCLR';\n HDPT : TwbSignature = 'HDPT';\n HEDR : TwbSignature = 'HEDR';\n HNAM : TwbSignature = 'HNAM';\n ICO2 : TwbSignature = 'ICO2';\n ICON : TwbSignature = 'ICON';\n IDLA : TwbSignature = 'IDLA';\n IDLB : TwbSignature = 'IDLB';\n IDLC : TwbSignature = 'IDLC';\n IDLE : TwbSignature = 'IDLE';\n IDLF : TwbSignature = 'IDLF';\n IDLM : TwbSignature = 'IDLM';\n IDLT : TwbSignature = 'IDLT';\n IMAD : TwbSignature = 'IMAD';\n IMGS : TwbSignature = 'IMGS';\n INAM : TwbSignature = 'INAM';\n INDX : TwbSignature = 'INDX';\n INFO : TwbSignature = 'INFO';\n INGR : TwbSignature = 'INGR';\n IPCT : TwbSignature = 'IPCT';\n IPDS : TwbSignature = 'IPDS';\n ITXT : TwbSignature = 'ITXT';\n JNAM : TwbSignature = 'JNAM';\n KEYM : TwbSignature = 'KEYM';\n KFFZ : TwbSignature = 'KFFZ';\n KNAM : TwbSignature = 'KNAM';\n LAND : TwbSignature = 'LAND';\n LGTM : TwbSignature = 'LGTM';\n LIGH : TwbSignature = 'LIGH';\n LNAM : TwbSignature = 'LNAM';\n LSCR : TwbSignature = 'LSCR';\n LTEX : TwbSignature = 'LTEX';\n LTMP : TwbSignature = 'LTMP';\n LVLC : TwbSignature = 'LVLC';\n LVLD : TwbSignature = 'LVLD';\n LVLF : TwbSignature = 'LVLF';\n LVLG : TwbSignature = 'LVLG';\n LVLI : TwbSignature = 'LVLI';\n LVLN : TwbSignature = 'LVLN';\n LVLO : TwbSignature = 'LVLO';\n MAST : TwbSignature = 'MAST';\n MESG : TwbSignature = 'MESG';\n MGEF : TwbSignature = 'MGEF';\n MICN : TwbSignature = 'MICN';\n MICO : TwbSignature = 'MICO';\n MIC2 : TwbSignature = 'MIC2';\n MISC : TwbSignature = 'MISC';\n MNAM : TwbSignature = 'MNAM';\n MO2B : TwbSignature = 'MO2B';\n MO2S : TwbSignature = 'MO2S';\n MO2T : TwbSignature = 'MO2T';\n MO3B : TwbSignature = 'MO3B';\n MO3S : TwbSignature = 'MO3S';\n MO3T : TwbSignature = 'MO3T';\n MO4B : TwbSignature = 'MO4B';\n MO4S : TwbSignature = 'MO4S';\n MO4T : TwbSignature = 'MO4T';\n MOD2 : TwbSignature = 'MOD2';\n VANM : TwbSignature = 'VANM';\n MOD3 : TwbSignature = 'MOD3';\n MOD4 : TwbSignature = 'MOD4';\n MODB : TwbSignature = 'MODB';\n MODD : TwbSignature = 'MODD';\n MODL : TwbSignature = 'MODL';\n MODS : TwbSignature = 'MODS';\n MODT : TwbSignature = 'MODT';\n MOSD : TwbSignature = 'MOSD';\n MSTT : TwbSignature = 'MSTT';\n MUSC : TwbSignature = 'MUSC';\n IMPS : TwbSignature = 'IMPS';\n IMPF : TwbSignature = 'IMPF';\n NAM0 : TwbSignature = 'NAM0';\n NAM1 : TwbSignature = 'NAM1';\n NAM2 : TwbSignature = 'NAM2';\n NAM3 : TwbSignature = 'NAM3';\n NAM4 : TwbSignature = 'NAM4';\n NAM5 : TwbSignature = 'NAM5';\n NAM6 : TwbSignature = 'NAM6';\n NAM7 : TwbSignature = 'NAM7';\n NAM8 : TwbSignature = 'NAM8';\n NAM9 : TwbSignature = 'NAM9';\n NAME : TwbSignature = 'NAME';\n NAVI : TwbSignature = 'NAVI';\n NAVM : TwbSignature = 'NAVM';\n NEXT : TwbSignature = 'NEXT';\n NIFT : TwbSignature = 'NIFT';\n NIFZ : TwbSignature = 'NIFZ';\n NNAM : TwbSignature = 'NNAM';\n XSRF : TwbSignature = 'XSRF';\n XSRD : TwbSignature = 'XSRD';\n MWD1 : TwbSignature = 'MWD1';\n MWD2 : TwbSignature = 'MWD2';\n MWD3 : TwbSignature = 'MWD3';\n MWD4 : TwbSignature = 'MWD4';\n MWD5 : TwbSignature = 'MWD5';\n MWD6 : TwbSignature = 'MWD6';\n MWD7 : TwbSignature = 'MWD7';\n WNM1 : TwbSignature = 'WNM1';\n WNM2 : TwbSignature = 'WNM2';\n WNM3 : TwbSignature = 'WNM3';\n WNM4 : TwbSignature = 'WNM4';\n WNM5 : TwbSignature = 'WNM5';\n WNM6 : TwbSignature = 'WNM6';\n WNM7 : TwbSignature = 'WNM7';\n WMI1 : TwbSignature = 'WMI1';\n WMI2 : TwbSignature = 'WMI2';\n WMI3 : TwbSignature = 'WMI3';\n WMS1 : TwbSignature = 'WMS1';\n WMS2 : TwbSignature = 'WMS2';\n NOTE : TwbSignature = 'NOTE';\n NPC_ : TwbSignature = 'NPC_';\n NULL : TwbSignature = 'NULL';\n NVCA : TwbSignature = 'NVCA';\n NVCI : TwbSignature = 'NVCI';\n NVDP : TwbSignature = 'NVDP';\n NVER : TwbSignature = 'NVER';\n NVEX : TwbSignature = 'NVEX';\n NVGD : TwbSignature = 'NVGD';\n NVMI : TwbSignature = 'NVMI';\n NVTR : TwbSignature = 'NVTR';\n NVVX : TwbSignature = 'NVVX';\n OBND : TwbSignature = 'OBND';\n OFST : TwbSignature = 'OFST';\n ONAM : TwbSignature = 'ONAM';\n PACK : TwbSignature = 'PACK';\n PBEA : TwbSignature = 'PBEA';\n PERK : TwbSignature = 'PERK';\n PFIG : TwbSignature = 'PFIG';\n PFPC : TwbSignature = 'PFPC';\n PGAG : TwbSignature = 'PGAG';\n PGRE : TwbSignature = 'PGRE';\n PMIS : TwbSignature = 'PMIS';\n TRGT : TwbSignature = 'TRGT';\n PGRI : TwbSignature = 'PGRI';\n PGRL : TwbSignature = 'PGRL';\n PGRP : TwbSignature = 'PGRP';\n PGRR : TwbSignature = 'PGRR';\n PKAM : TwbSignature = 'PKAM';\n PKDD : TwbSignature = 'PKDD';\n PKDT : TwbSignature = 'PKDT';\n PKE2 : TwbSignature = 'PKE2';\n PKED : TwbSignature = 'PKED';\n PKFD : TwbSignature = 'PKFD';\n PKID : TwbSignature = 'PKID';\n PKPT : TwbSignature = 'PKPT';\n PKW3 : TwbSignature = 'PKW3';\n PLD2 : TwbSignature = 'PLD2';\n PLDT : TwbSignature = 'PLDT';\n PLYR : TwbSignature = 'PLYR';\n PNAM : TwbSignature = 'PNAM';\n TDUM : TwbSignature = 'TDUM';\n POBA : TwbSignature = 'POBA';\n POCA : TwbSignature = 'POCA';\n POEA : TwbSignature = 'POEA';\n PRKC : TwbSignature = 'PRKC';\n PRKE : TwbSignature = 'PRKE';\n PRKF : TwbSignature = 'PRKF';\n PROJ : TwbSignature = 'PROJ';\n PSDT : TwbSignature = 'PSDT';\n PTD2 : TwbSignature = 'PTD2';\n PTDT : TwbSignature = 'PTDT';\n PUID : TwbSignature = 'PUID';\n PWAT : TwbSignature = 'PWAT';\n QNAM : TwbSignature = 'QNAM';\n RCIL : TwbSignature = 'RCIL';\n RCQY : TwbSignature = 'RCQY';\n RCOD : TwbSignature = 'RCOD';\n QOBJ : TwbSignature = 'QOBJ';\n QSDT : TwbSignature = 'QSDT';\n QSTA : TwbSignature = 'QSTA';\n QSTI : TwbSignature = 'QSTI';\n TPIC : TwbSignature = 'TPIC';\n QSTR : TwbSignature = 'QSTR';\n INFC : TwbSignature = 'INFC';\n INFX : TwbSignature = 'INFX';\n QUST : TwbSignature = 'QUST';\n RACE : TwbSignature = 'RACE';\n RADS : TwbSignature = 'RADS';\n RAFB : TwbSignature = 'RAFB';\n RAFD : TwbSignature = 'RAFD';\n RAGA : TwbSignature = 'RAGA';\n RAPS : TwbSignature = 'RAPS';\n RCLR : TwbSignature = 'RCLR';\n RDAT : TwbSignature = 'RDAT';\n RDMD : TwbSignature = 'RDMD';\n RDMO : TwbSignature = 'RDMO';\n RDMP : TwbSignature = 'RDMP';\n RDGS : TwbSignature = 'RDGS';\n RDOT : TwbSignature = 'RDOT';\n RDSD : TwbSignature = 'RDSD';\n RDWT : TwbSignature = 'RDWT';\n REFR : TwbSignature = 'REFR';\n REGN : TwbSignature = 'REGN';\n REPL : TwbSignature = 'REPL';\n RGDL : TwbSignature = 'RGDL';\n RNAM : TwbSignature = 'RNAM';\n RPLD : TwbSignature = 'RPLD';\n RPLI : TwbSignature = 'RPLI';\n SCDA : TwbSignature = 'SCDA';\n SCHR : TwbSignature = 'SCHR';\n SCOL : TwbSignature = 'SCOL';\n SCPT : TwbSignature = 'SCPT';\n SCRI : TwbSignature = 'SCRI';\n SCRN : TwbSignature = 'SCRN';\n SCRO : TwbSignature = 'SCRO';\n SCRV : TwbSignature = 'SCRV';\n SCTX : TwbSignature = 'SCTX';\n SCVR : TwbSignature = 'SCVR';\n SLCP : TwbSignature = 'SLCP';\n SLSD : TwbSignature = 'SLSD';\n SNAM : TwbSignature = 'SNAM';\n SNDD : TwbSignature = 'SNDD';\n SNDX : TwbSignature = 'SNDX';\n SOUL : TwbSignature = 'SOUL';\n SOUN : TwbSignature = 'SOUN';\n SPEL : TwbSignature = 'SPEL';\n SPIT : TwbSignature = 'SPIT';\n SPLO : TwbSignature = 'SPLO';\n STAT : TwbSignature = 'STAT';\n BRUS : TwbSignature = 'BRUS';\n TACT : TwbSignature = 'TACT';\n TCLF : TwbSignature = 'TCLF';\n TCFU : TwbSignature = 'TCFU';\n TCLT : TwbSignature = 'TCLT';\n TERM : TwbSignature = 'TERM';\n TES4 : TwbSignature = 'TES4';\n TNAM : TwbSignature = 'TNAM';\n TPLT : TwbSignature = 'TPLT';\n TRDT : TwbSignature = 'TRDT';\n TREE : TwbSignature = 'TREE';\n TX00 : TwbSignature = 'TX00';\n TX01 : TwbSignature = 'TX01';\n INTV : TwbSignature = 'INTV';\n TX02 : TwbSignature = 'TX02';\n TX03 : TwbSignature = 'TX03';\n TX04 : TwbSignature = 'TX04';\n TX05 : TwbSignature = 'TX05';\n TXST : TwbSignature = 'TXST';\n UNAM : TwbSignature = 'UNAM';\n VATS : TwbSignature = 'VATS';\n VCLR : TwbSignature = 'VCLR';\n VHGT : TwbSignature = 'VHGT';\n VNAM : TwbSignature = 'VNAM';\n VNML : TwbSignature = 'VNML';\n VTCK : TwbSignature = 'VTCK';\n VTEX : TwbSignature = 'VTEX';\n VTXT : TwbSignature = 'VTXT';\n VTYP : TwbSignature = 'VTYP';\n WATR : TwbSignature = 'WATR';\n WEAP : TwbSignature = 'WEAP';\n WLST : TwbSignature = 'WLST';\n WNAM : TwbSignature = 'WNAM';\n XATO : TwbSignature = 'XATO';\n WRLD : TwbSignature = 'WRLD';\n WTHR : TwbSignature = 'WTHR';\n XACT : TwbSignature = 'XACT';\n XAMC : TwbSignature = 'XAMC';\n XAMT : TwbSignature = 'XAMT';\n XAPD : TwbSignature = 'XAPD';\n XAPR : TwbSignature = 'XAPR';\n XCAS : TwbSignature = 'XCAS';\n XCCM : TwbSignature = 'XCCM';\n XCET : TwbSignature = 'XCET';\n XCHG : TwbSignature = 'XCHG';\n XCIM : TwbSignature = 'XCIM';\n XCLC : TwbSignature = 'XCLC';\n XCLL : TwbSignature = 'XCLL';\n XCLP : TwbSignature = 'XCLP';\n XCLR : TwbSignature = 'XCLR';\n XCLW : TwbSignature = 'XCLW';\n XCMO : TwbSignature = 'XCMO';\n XCMT : TwbSignature = 'XCMT';\n XCNT : TwbSignature = 'XCNT';\n XCWT : TwbSignature = 'XCWT';\n XEMI : TwbSignature = 'XEMI';\n XESP : TwbSignature = 'XESP';\n XEZN : TwbSignature = 'XEZN';\n XGLB : TwbSignature = 'XGLB';\n XHLP : TwbSignature = 'XHLP';\n XDCR : TwbSignature = 'XDCR';\n XHLT : TwbSignature = 'XHLT';\n XIBS : TwbSignature = 'XIBS';\n XLCM : TwbSignature = 'XLCM';\n XLKR : TwbSignature = 'XLKR';\n XLOC : TwbSignature = 'XLOC';\n XLOD : TwbSignature = 'XLOD';\n XLRM : TwbSignature = 'XLRM';\n XLTW : TwbSignature = 'XLTW';\n XMBO : TwbSignature = 'XMBO';\n XMBP : TwbSignature = 'XMBP';\n XMBR : TwbSignature = 'XMBR';\n XMRC : TwbSignature = 'XMRC';\n XMRK : TwbSignature = 'XMRK';\n XNAM : TwbSignature = 'XNAM';\n XNDP : TwbSignature = 'XNDP';\n XOCP : TwbSignature = 'XOCP';\n XORD : TwbSignature = 'XORD';\n XOWN : TwbSignature = 'XOWN';\n XPOD : TwbSignature = 'XPOD';\n XPTL : TwbSignature = 'XPTL';\n XPPA : TwbSignature = 'XPPA';\n XPRD : TwbSignature = 'XPRD';\n XPRM : TwbSignature = 'XPRM';\n XPWR : TwbSignature = 'XPWR';\n XRAD : TwbSignature = 'XRAD';\n XRDO : TwbSignature = 'XRDO';\n XRDS : TwbSignature = 'XRDS';\n XRGB : TwbSignature = 'XRGB';\n XRGD : TwbSignature = 'XRGD';\n XRMR : TwbSignature = 'XRMR';\n XRNK : TwbSignature = 'XRNK';\n XRTM : TwbSignature = 'XRTM';\n XSCL : TwbSignature = 'XSCL';\n XSED : TwbSignature = 'XSED';\n XTEL : TwbSignature = 'XTEL';\n XTRG : TwbSignature = 'XTRG';\n XTRI : TwbSignature = 'XTRI';\n XXXX : TwbSignature = 'XXXX';\n YNAM : TwbSignature = 'YNAM';\n ZNAM : TwbSignature = 'ZNAM';\n IMOD : TwbSignature = 'IMOD';\n REPU : TwbSignature = 'REPU';\n RCPE : TwbSignature = 'RCPE';\n RCCT : TwbSignature = 'RCCT';\n CHIP : TwbSignature = 'CHIP';\n CSNO : TwbSignature = 'CSNO';\n LSCT : TwbSignature = 'LSCT';\n MSET : TwbSignature = 'MSET';\n ALOC : TwbSignature = 'ALOC';\n CHAL : TwbSignature = 'CHAL';\n AMEF : TwbSignature = 'AMEF';\n CCRD : TwbSignature = 'CCRD';\n CARD : TwbSignature = 'CARD';\n CMNY : TwbSignature = 'CMNY';\n CDCK : TwbSignature = 'CDCK';\n DEHY : TwbSignature = 'DEHY';\n HUNG : TwbSignature = 'HUNG';\n SLPD : TwbSignature = 'SLPD';\n\nvar\n wbPKDTSpecificFlagsUnused : Boolean;\n wbEDID: IwbSubRecordDef;\n wbEDIDReq: IwbSubRecordDef;\n wbBMDT: IwbSubRecordDef;\n wbYNAM: IwbSubRecordDef;\n wbZNAM: IwbSubRecordDef;\n wbCOED: IwbSubRecordDef;\n wbXLCM: IwbSubRecordDef;\n wbEITM: IwbSubRecordDef;\n wbREPL: IwbSubRecordDef;\n wbBIPL: IwbSubRecordDef;\n wbOBND: IwbSubRecordDef;\n wbOBNDReq: IwbSubRecordDef;\n wbDEST: IwbSubRecordStructDef;\n wbDESTActor: IwbSubRecordStructDef;\n wbDODT: IwbSubRecordDef;\n wbXOWN: IwbSubRecordDef;\n wbXGLB: IwbSubRecordDef;\n wbXRGD: IwbSubRecordDef;\n wbXRGB: IwbSubRecordDef;\n wbSLSD: IwbSubRecordDef;\n wbSPLO: IwbSubRecordDef;\n wbSPLOs: IwbSubRecordArrayDef;\n wbCNTO: IwbSubRecordStructDef;\n wbCNTOs: IwbSubRecordArrayDef;\n wbAIDT: IwbSubRecordDef;\n wbCSDT: IwbSubRecordStructDef;\n wbCSDTs: IwbSubRecordArrayDef;\n wbFULL: IwbSubRecordDef;\n wbFULLActor: IwbSubRecordDef;\n wbFULLReq: IwbSubRecordDef;\n wbXNAM: IwbSubRecordDef;\n wbXNAMs: IwbSubRecordArrayDef;\n wbDESC: IwbSubRecordDef;\n wbDESCReq: IwbSubRecordDef;\n wbXSCL: IwbSubRecordDef;\n wbDATAPosRot : IwbSubRecordDef;\n wbPosRot : IwbStructDef;\n wbMODD: IwbSubRecordDef;\n wbMOSD: IwbSubRecordDef;\n wbMODL: IwbSubRecordStructDef;\n wbMODS: IwbSubRecordDef;\n wbMO2S: IwbSubRecordDef;\n wbMO3S: IwbSubRecordDef;\n wbMO4S: IwbSubRecordDef;\n wbMODLActor: IwbSubRecordStructDef;\n wbMODLReq: IwbSubRecordStructDef;\n wbCTDA: IwbSubRecordDef;\n wbSCHRReq: IwbSubRecordDef;\n wbCTDAs: IwbSubRecordArrayDef;\n wbCTDAsReq: IwbSubRecordArrayDef;\n wbSCROs: IwbSubRecordArrayDef;\n wbPGRP: IwbSubRecordDef;\n wbEmbeddedScript: IwbSubRecordStructDef;\n wbEmbeddedScriptPerk: IwbSubRecordStructDef;\n wbEmbeddedScriptReq: IwbSubRecordStructDef;\n wbSCRI: IwbSubRecordDef;\n wbSCRIActor: IwbSubRecordDef;\n wbFaceGen: IwbSubRecordStructDef;\n wbFaceGenNPC: IwbSubRecordStructDef;\n wbENAM: IwbSubRecordDef;\n wbFGGS: IwbSubRecordDef;\n wbXLOD: IwbSubRecordDef;\n wbXESP: IwbSubRecordDef;\n wbICON: IwbSubRecordStructDef;\n wbICONReq: IwbSubRecordStructDef;\n wbActorValue: IwbIntegerDef;\n wbETYP: IwbSubRecordDef;\n wbETYPReq: IwbSubRecordDef;\n wbEFID: IwbSubRecordDef;\n wbEFIT: IwbSubRecordDef;\n wbEffects: IwbSubRecordArrayDef;\n wbEffectsReq: IwbSubRecordArrayDef;\n wbBPNDStruct: IwbSubRecordDef;\n wbTimeInterpolator: IwbStructDef;\n wbColorInterpolator: IwbStructDef;\n\nfunction wbNVTREdgeToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Index : Integer;\n Flags : Cardinal;\n IsExternal : Boolean;\n Container : IwbContainerElementRef;\nbegin\n Result := '';\n IsExternal := False;\n if Supports(aElement, IwbContainerElementRef, Container) then begin\n Index := StrToIntDef(Copy(Container.Name, 11, 1), -1);\n if (Index >= 0) and (Index <= 2) then begin\n Flags := Container.ElementNativeValues['..\\..\\Flags'];\n IsExternal := Flags and (Cardinal(1) shl Index) <> 0;\n end;\n end;\n\n if IsExternal then begin\n case aType of\n ctToStr: begin\n Result := IntToStr(aInt);\n if Container.ElementExists['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt)] then\n Result := Result + ' (Triangle #' +\n Container.ElementValues['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Triangle'] + ' in ' +\n Container.ElementValues['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Navigation Mesh'] + ')'\n else\n Result := Result + ' ';\n end;\n ctToSortKey:\n if Container.ElementExists['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt)] then\n Result :=\n Container.ElementSortKeys['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Navigation Mesh', True] + '|' +\n Container.ElementSortKeys['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Triangle', True];\n ctCheck:\n if Container.ElementExists['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt)] then\n Result := ''\n else\n Result := 'NVEX\\Connection #' + IntToStr(aInt) + ' is missing';\n end\n end else\n case aType of\n ctToStr: Result := IntToStr(aInt);\n end;\nend;\n\nfunction wbNVTREdgeToInt(const aString: string; const aElement: IwbElement): Int64;\nbegin\n Result := StrToInt64(aString);\nend;\n\n\nfunction wbEPFDActorValueToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n AsCardinal : Cardinal;\n AsFloat : Single;\nbegin\n AsCardinal := aInt;\n AsFloat := PSingle(@AsCardinal)^;\n aInt := Round(AsFloat);\n case aType of\n ctToStr: Result := wbActorValueEnum.ToString(aInt, aElement);\n ctToSortKey: Result := wbActorValueEnum.ToSortKey(aInt, aElement);\n ctCheck: Result := wbActorValueEnum.Check(aInt, aElement);\n ctToEditValue: Result := wbActorValueEnum.ToEditValue(aInt, aElement);\n ctEditType: Result := 'ComboBox';\n ctEditInfo: Result := wbActorValueEnum.EditInfo[aInt, aElement];\n end;\nend;\n\nfunction wbEPFDActorValueToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n AsCardinal : Cardinal;\n AsFloat : Single;\nbegin\n AsFloat := wbActorValueEnum.FromEditValue(aString, aElement);\n PSingle(@AsCardinal)^ := AsFloat;\n Result := AsCardinal;\nend;\n\nfunction wbCTDAParam2VariableNameToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n //Container2 : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\n ScriptRef : IwbElement;\n Script : IwbMainRecord;\n Variables : TStringList;\n LocalVars : IwbContainerElementRef;\n LocalVar : IwbContainerElementRef;\n i, j : Integer;\n s : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n MainRecord := nil;\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n{ if Param1.NativeValue = 0 then\n if Supports(Container.Container, IwbContainerElementRef, Container) then\n for i := 0 to Pred(Container.ElementCount) do\n if Supports(Container.Elements[i], IwbContainerElementRef, Container2) then\n if SameText(Container2.ElementValues['Function'], 'GetIsID') then begin\n Param1 := Container2.ElementByName['Parameter #1'];\n if Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Break;\n end;}\n\n if not Assigned(MainRecord) then\n Exit;\n\n BaseRecord := MainRecord.BaseRecord;\n if Assigned(BaseRecord) then\n MainRecord := BaseRecord;\n\n ScriptRef := MainRecord.RecordBySignature['SCRI'];\n\n if not Assigned(ScriptRef) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n if not Supports(ScriptRef.LinksTo, IwbMainRecord, Script) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n Script := Script.HighestOverrideOrSelf[aElement._File.LoadOrder];\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n Variables := TStringList.Create;\n else\n Variables := nil;\n end;\n try\n if Supports(Script.ElementByName['Local Variables'], IwbContainerElementRef, LocalVars) then begin\n for i := 0 to Pred(LocalVars.ElementCount) do\n if Supports(LocalVars.Elements[i], IwbContainerElementRef, LocalVar) then begin\n j := LocalVar.ElementNativeValues['SLSD\\Index'];\n s := LocalVar.ElementNativeValues['SCVR'];\n if Assigned(Variables) then\n Variables.AddObject(s, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := s;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n Variables.Sort;\n Result := Variables.CommaText;\n end;\n end;\n finally\n FreeAndNil(Variables);\n end;\nend;\n\nfunction wbCTDAParam2VariableNameToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\n ScriptRef : IwbElement;\n Script : IwbMainRecord;\n LocalVars : IwbContainerElementRef;\n LocalVar : IwbContainerElementRef;\n i, j : Integer;\n s : string;\nbegin\n Result := StrToInt64Def(aString, Low(Cardinal));\n if Result <> Low(Cardinal) then\n Exit;\n\n if not Assigned(aElement) then\n raise Exception.Create('aElement not specified');\n\n Container := GetContainerRefFromUnionOrValue(aElement);\n\n if not Assigned(Container) then\n raise Exception.Create('Container not assigned');\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n raise Exception.Create('Could not find \"Parameter #1\"');\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n raise Exception.Create('\"Parameter #1\" does not reference a valid main record');\n\n BaseRecord := MainRecord.BaseRecord;\n if Assigned(BaseRecord) then\n MainRecord := BaseRecord;\n\n ScriptRef := MainRecord.RecordBySignature['SCRI'];\n\n if not Assigned(ScriptRef) then\n raise Exception.Create('\"'+MainRecord.ShortName+'\" does not contain a SCRI subrecord');\n\n if not Supports(ScriptRef.LinksTo, IwbMainRecord, Script) then\n raise Exception.Create('\"'+MainRecord.ShortName+'\" does not have a valid script');\n\n Script := Script.HighestOverrideOrSelf[aElement._File.LoadOrder];\n\n if Supports(Script.ElementByName['Local Variables'], IwbContainerElementRef, LocalVars) then begin\n for i := 0 to Pred(LocalVars.ElementCount) do\n if Supports(LocalVars.Elements[i], IwbContainerElementRef, LocalVar) then begin\n j := LocalVar.ElementNativeValues['SLSD\\Index'];\n s := LocalVar.ElementNativeValues['SCVR'];\n if SameText(s, Trim(aString)) then begin\n Result := j;\n Exit;\n end;\n end;\n end;\n\n raise Exception.Create('Variable \"'+aString+'\" was not found in \"'+MainRecord.ShortName+'\"');\nend;\n\nfunction wbCTDAParam2QuestStageToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Stages : IwbContainerElementRef;\n Stage : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Stages'], IwbContainerElementRef, Stages) then begin\n for i := 0 to Pred(Stages.ElementCount) do\n if Supports(Stages.Elements[i], IwbContainerElementRef, Stage) then begin\n j := Stage.ElementNativeValues['INDX'];\n s := Trim(Stage.ElementValues['Log Entries\\Log Entry\\CNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbPerkDATAQuestStageToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Stages : IwbContainerElementRef;\n Stage : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Quest'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Stages'], IwbContainerElementRef, Stages) then begin\n for i := 0 to Pred(Stages.ElementCount) do\n if Supports(Stages.Elements[i], IwbContainerElementRef, Stage) then begin\n j := Stage.ElementNativeValues['INDX'];\n s := Trim(Stage.ElementValues['Log Entries\\Log Entry\\CNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbCTDAParam2QuestObjectiveToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Objectives : IwbContainerElementRef;\n Objective : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Objectives'], IwbContainerElementRef, Objectives) then begin\n for i := 0 to Pred(Objectives.ElementCount) do\n if Supports(Objectives.Elements[i], IwbContainerElementRef, Objective) then begin\n j := Objective.ElementNativeValues['QOBJ'];\n s := Trim(Objective.ElementValues['NNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbCTDAParam2QuestStageToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i : Integer;\n s : string;\nbegin\n i := 1;\n s := Trim(aString);\n while (i <= Length(s)) and (s[i] in ['0'..'9']) do\n Inc(i);\n s := Copy(s, 1, Pred(i));\n\n Result := StrToInt(s);\nend;\n\nfunction wbCTDAParam2QuestObjectiveToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i : Integer;\n s : string;\nbegin\n i := 1;\n s := Trim(aString);\n while (i <= Length(s)) and (s[i] in ['0'..'9']) do\n Inc(i);\n s := Copy(s, 1, Pred(i));\n\n Result := StrToInt(s);\nend;\n\n\nfunction wbClmtMoonsPhaseLength(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n PhaseLength : Byte;\n Masser : Boolean;\n Secunda : Boolean;\nbegin\n Result := '';\n if aType = ctToSortKey then begin\n Result := IntToHex64(aInt, 2);\n end else if aType = ctToStr then begin\n PhaseLength := aInt mod 64;\n Masser := (aInt and 64) <> 0;\n Secunda := (aInt and 128) <> 0;\n if Masser then\n if Secunda then\n Result := 'Masser, Secunda / '\n else\n Result := 'Masser / '\n else\n if Secunda then\n Result := 'Secunda / '\n else\n Result := 'No Moon / ';\n Result := Result + IntToStr(PhaseLength);\n end;\nend;\n\nfunction wbClmtTime(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n Result := TimeToStr( EncodeTime(aInt div 6, (aInt mod 6) * 10, 0, 0) )\n else\n Result := '';\nend;\n\nfunction wbAlocTime(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n Result := TimeToStr( aInt / 256 )\n else\n Result := '';\nend;\n\nfunction wbREFRNavmeshTriangleToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Navmesh : IwbElement;\n MainRecord : IwbMainRecord;\n Triangles : IwbContainerElementRef;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt);\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Navmesh := Container.Elements[0];\n\n if not Assigned(Navmesh) then\n Exit;\n\n if not Supports(Navmesh.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> NAVM then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n if not wbSimpleRecords and (aType = ctCheck) and Supports(MainRecord.ElementByPath['NVTR'], IwbContainerElementRef, Triangles) then\n if aInt >= Triangles.ElementCount then\n Result := '';\nend;\n\nfunction wbStringToInt(const aString: string; const aElement: IwbElement): Int64;\nbegin\n Result := StrToIntDef(aString, 0);\nend;\n\n\nvar\n wbCtdaTypeFlags : IwbFlagsDef;\n\nfunction wbCtdaTypeToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n s: string;\nbegin\n Result := '';\n case aType of\n ctEditType:\n Result := 'CheckComboBox';\n ctEditInfo:\n Result := 'Equal,Greater,Lesser,Or,\"Use Global\",\"Run on Target\"';\n ctToEditValue: begin\n Result := '000000';\n case aInt and $F0 of\n $00 : Result[1] := '1';\n $40 : Result[2] := '1';\n $60 : begin\n Result[1] := '1';\n Result[2] := '1';\n end;\n $80 : Result[3] := '1';\n $A0 : begin\n Result[1] := '1';\n Result[3] := '1';\n end;\n end;\n if (aInt and $01) <> 0 then\n Result[4] := '1';\n if (aInt and $02) <> 0 then\n Result[6] := '1';\n if (aInt and $04) <> 0 then\n Result[5] := '1';\n end;\n ctToStr: begin\n case aInt and $F0 of\n $00 : Result := 'Equal to';\n $20 : Result := 'Not equal to';\n $40 : Result := 'Greater than';\n $60 : Result := 'Greater than or equal to';\n $80 : Result := 'Less than';\n $A0 : Result := 'Less than or equal to';\n else\n Result := ''\n end;\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Run on target',\n {0x04} 'Use global'\n ]);\n\n s := wbCtdaTypeFlags.ToString(aInt and $0F, aElement);\n\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: begin\n case aInt and $F0 of\n $00, $20, $40, $60, $80, $A0 : Result := '';\n else\n Result := ''\n end;\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Run on target',\n {0x04} 'Use global'\n ]);\n\n s := wbCtdaTypeFlags.Check(aInt and $0F, aElement);\n\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n end;\nend;\n\nfunction wbCtdaTypeToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\nbegin\n s := aString + '000000';\n// Result := 0;\n if s[1] = '1' then begin\n if s[2] = '1' then begin\n if s[3] = '1' then begin\n Result := $00;\n end else begin\n Result := $60;\n end;\n end else begin\n if s[3] = '1' then begin\n Result := $A0;\n end else begin\n Result := $00;\n end;\n end;\n end else begin\n if s[2] = '1' then begin\n if s[3] = '1' then begin\n Result := $20;\n end else begin\n Result := $40;\n end;\n end else begin\n if s[3] = '1' then begin\n Result := $80;\n end else begin\n Result := $20;\n end;\n end;\n end;\n if s[4] = '1' then\n Result := Result or $01;\n if s[6] = '1' then\n Result := Result or $02;\n if s[5] = '1' then\n Result := Result or $04;\nend;\n\nprocedure wbHeadPartsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainerElementRef;\nbegin\n if wbBeginInternalEdit then try\n if Supports(aElement, IwbContainerElementRef, Container) then\n if (Container.Elements[0].NativeValue = 1) and (Container.ElementCount > 2) then\n Container.RemoveElement(1);\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMESGDNAMAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : Integer;\n Container : IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := Integer(aOldValue) and 1;\n NewValue := Integer(aNewValue) and 1;\n if NewValue = OldValue then\n Exit;\n if NewValue = 1 then\n Container.RemoveElement('TNAM')\n else\n Container.Add('TNAM', True);\n end;\nend;\n\nprocedure wbGMSTEDIDAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : string;\n Container : IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := aOldValue;\n NewValue := aNewValue;\n if (Length(OldValue) < 1) or (Length(OldValue) < 1) or (OldValue[1] <> NewValue[1]) then begin\n Container.RemoveElement('DATA');\n Container.Add('DATA', True);\n end;\n end;\nend;\n\nprocedure wbFLSTEDIDAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : string;\n OldOrdered, NewOrdered : Boolean;\n Container : IwbContainerElementRef;\nconst\n OrderedList = 'OrderedList';\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := aOldValue;\n NewValue := aNewValue;\n\n if Length(OldValue) > Length(OrderedList) then\n Delete(OldValue, 1, Length(OldValue)-Length(OrderedList));\n if Length(NewValue) > Length(OrderedList) then\n Delete(NewValue, 1, Length(NewValue)-Length(OrderedList));\n\n OldOrdered := SameText(OldValue, OrderedList);\n NewOrdered := SameText(NewValue, OrderedList);\n\n if OldOrdered <> NewOrdered then\n Container.RemoveElement('FormIDs');\n end;\nend;\n\nprocedure wbCtdaTypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue: Integer;\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n OldValue := aOldValue and $04;\n NewValue := aNewValue and $04;\n if OldValue <> NewValue then\n Container.ElementNativeValues['..\\Comparison Value'] := 0;\n\n if aNewValue and $02 then begin\n Container.ElementNativeValues['..\\Run On'] := 1;\n if Integer(Container.ElementNativeValues['..\\Run On']) = 1 then\n aElement.NativeValue := Byte(aNewValue) and not $02;\n end;\nend;\n\nfunction wbMODTCallback(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Strings: TDynStrings;\n i: Integer;\nbegin\n Result := '';\n if wbLoaderDone and (aType in [ctToStr, ctToSortKey] ) then begin\n Strings := wbContainerHandler.ResolveHash(aInt);\n for i := Low(Strings) to High(Strings) do\n Result := Result + Strings[i] + ', ';\n SetLength(Result, Length(Result) -2 );\n end;\nend;\n\n\nfunction wbIdleAnam(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and not $C0 of\n 0: Result := 'Idle';\n 1: Result := 'Movement';\n 2: Result := 'Left Arm';\n 3: Result := 'Left Hand';\n 4: Result := 'Weapon';\n 5: Result := 'Weapon Up';\n 6: Result := 'Weapon Down';\n 7: Result := 'Special Idle';\n 20: Result := 'Whole Body';\n 21: Result := 'Upper Body';\n else\n Result := '';\n end;\n\n if (aInt and $80) = 0 then\n Result := Result + ', Must return a file';\n if (aInt and $40) = 1 then\n Result := Result + ', Unknown Flag';\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n end;\n ctCheck: begin\n case aInt and not $C0 of\n 0..7, 20, 21: Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbScaledInt4ToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nconst\n PlusMinus : array[Boolean] of string = ('+', '-');\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n ctToSortKey: begin\n Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n if Length(Result) < 22 then\n Result := StringOfChar('0', 22 - Length(Result)) + Result;\n Result := PlusMinus[aInt < 0] + Result;\n end;\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbScaledInt4ToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n f: Extended;\nbegin\n f := StrToFloat(aString);\n f := f * 10000;\n Result := Round(f);\nend;\n\nfunction wbHideFFFF(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n if aInt = $FFFF then\n Result := 'None'\n else\n Result := IntToStr(aInt);\nend;\n\nfunction wbAtxtPosition(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt div 17, 2) + IntToHex64(aInt mod 17, 2)\n else if aType = ctCheck then begin\n if (aInt < 0) or (aInt > 288) then\n Result := ''\n else\n Result := '';\n end else if aType = ctToStr then\n Result := IntToStr(aInt) + ' -> ' + IntToStr(aInt div 17) + ':' + IntToStr(aInt mod 17);\nend;\n\nfunction wbGLOBFNAM(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt of\n Ord('s'): Result := 'Short';\n Ord('l'): Result := 'Long';\n Ord('f'): Result := 'Float';\n else\n Result := '';\n end;\n end;\n ctToSortKey: Result := Chr(aInt);\n ctCheck: begin\n case aInt of\n Ord('s'), Ord('l'), Ord('f'): Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPlacedAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n s: string;\n Cell: IwbMainRecord;\n Position: TwbVector;\n Grid: TwbGridCell;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['NAME'];\n if Assigned(Rec) then begin\n s := Trim(Rec.Value);\n if s <> '' then\n Result := 'places ' + s;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n\n // grid position of persistent reference in exterior persistent cell (interior cells are not persistent)\n if Supports(aMainRecord.Container, IwbGroupRecord, Container) then\n Cell := IwbGroupRecord(Container).ChildrenOf;\n if Assigned(Cell) and Cell.IsPersistent and (Cell.Signature = 'CELL') then\n if aMainRecord.GetPosition(Position) then begin\n Grid := wbPositionToGridCell(Position);\n Result := Result + ' at ' + IntToStr(Grid.x) + ',' + IntToStr(Grid.y);\n end;\n end;\n end;\nend;\n\nfunction wbINFOAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Container: IwbContainer;\n s: string;\nbegin\n Result := Trim(aMainRecord.ElementValues['Responses\\Response\\NAM1']);\n if Result <> '' then\n Result := '''' + Result + '''';\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n end;\n end;\n\n s := Trim(aMainRecord.ElementValues['QSTI']);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'for ' + s;\n end;\nend;\n\nfunction wbNAVMAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec : IwbRecord;\n Element : IwbElement;\n s : string;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['DATA'];\n if Assigned(Rec) then begin\n Element := Rec.ElementByName['Cell'];\n if Assigned(Element) then\n Element := Element.LinksTo;\n if Assigned(Element) then\n s := Trim(Element.Name);\n if s <> '' then\n Result := 'for ' + s;\n end;\nend;\n\nfunction wbCellAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n GroupRecord : IwbGroupRecord;\n s: string;\nbegin\n Result := '';\n\n if not aMainRecord.IsPersistent then begin\n Rec := aMainRecord.RecordBySignature['XCLC'];\n if Assigned(Rec) then\n Result := 'at ' + Rec.Elements[0].Value + ',' + Rec.Elements[1].Value;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and not\n (Supports(Container, IwbGroupRecord, GroupRecord) and (GroupRecord.GroupType = 1)) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := wbFormID.ToString(GroupRecord.GroupLabel, aMainRecord);\n if s <> '' then begin\n if Result <> '' then\n s := s + ' ';\n Result := 'in ' + s + Result;\n end;\n end;\nend;\n\nfunction wbWthrDataClassification(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and not 192 of\n 0: Result := 'None';\n 1: Result := 'Pleasant';\n 2: Result := 'Cloudy';\n 4: Result := 'Rainy';\n 8: Result := 'Snow';\n else\n Result := '';\n end;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2)\n end;\n ctCheck: begin\n case aInt and not 192 of\n 0, 1, 2, 4, 8: Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbNOTETNAMDecide(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rDATA: IwbRecord;\nbegin\n Result := 0;\n rDATA := aElement.Container.RecordBySignature[DATA];\n if Assigned(rDATA) then\n if rDATA.NativeValue = 3 then //Voice\n Result := 1;\nend;\n\nfunction wbNOTESNAMDecide(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rDATA: IwbRecord;\nbegin\n Result := 0;\n rDATA := aElement.Container.RecordBySignature[DATA];\n if Assigned(rDATA) then\n if rDATA.NativeValue = 3 then //Voice\n Result := 1;\nend;\n\nfunction wbIPDSDATACount(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nbegin\n if Assigned(aBasePtr) and Assigned(aEndPtr) then\n Result := (Cardinal(aBasePtr) - Cardinal(aBasePtr)) div 4\n else\n Result := 12;\nend;\n\nfunction wbNAVINAVMGetCount1(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n DataContainer : IwbDataContainer;\nbegin\n Result := 0;\n\n if Supports(aElement, IwbDataContainer, DataContainer) then begin\n if DataContainer.ElementType = etArray then\n if not Supports(DataContainer.Container, IwbDataContainer, DataContainer) then\n Exit;\n Assert(DataContainer.Name = 'Data');\n Result := PWord(Cardinal(DataContainer.DataBasePtr) + 3*3*4)^;\n end;\nend;\n\nfunction wbNAVINAVMGetCount2(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n DataContainer : IwbDataContainer;\nbegin\n Result := 0;\n\n if Supports(aElement, IwbDataContainer, DataContainer) then begin\n if DataContainer.ElementType = etArray then\n if not Supports(DataContainer.Container, IwbDataContainer, DataContainer) then\n Exit;\n Assert(DataContainer.Name = 'Data');\n Result := PWord(Cardinal(DataContainer.DataBasePtr) + 3*3*4 + 2)^;\n end;\nend;\n\nprocedure wbCTDARunOnAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n if aOldValue <> aNewValue then\n if aNewValue <> 2 then\n aElement.Container.ElementNativeValues['Reference'] := 0;\nend;\n\nprocedure wbPERKPRKETypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainerElementRef;\n// rDATA : IwbRecord;\nbegin\n if aOldValue <> aNewValue then\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n if Supports(Container.Container, IwbContainerElementRef, Container) then begin\n Container.RemoveElement('DATA');\n Container.Add('DATA', True);\n Container.RemoveElement('Perk Conditions');\n Container.RemoveElement('Entry Point Function Parameters');\n if aNewValue = 2 then begin\n Container.Add('EPFT', True);\n Container.ElementNativeValues['DATA\\Entry Point\\Function'] := 2;\n end;\n end;\n end;\nend;\n\nfunction wbMGEFFAssocItemDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n Archtype : Variant;\n DataContainer : IwbDataContainer;\n Element : IwbElement;\nconst\n OffsetArchtype = 56;\n\nbegin\n Result := 1;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n VarClear(ArchType);\n Element := Container.ElementByName['Archtype'];\n if Assigned(Element) then\n ArchType := Element.NativeValue\n else if Supports(Container, IwbDataContainer, DataContainer) and\n DataContainer.IsValidOffset(aBasePtr, aEndPtr, OffsetArchtype) then\n begin // we are part of a proper structure\n aBasePtr := Pointer(Cardinal(aBasePtr) + OffsetArchtype);\n ArchType := PCardinal(aBasePtr)^;\n end;\n\n if not VarIsEmpty(ArchType) then\n case Integer(ArchType) of\n 01: Result := 2;//Script\n 18: Result := 3;//Bound Item\n 19: Result := 4;//Summon Creature\n else\n Result := 0;\n end;\nend;\n\nprocedure wbMGEFFAssocItemAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainer;\n Element : IwbElement;\nbegin\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if (aNewValue <> 0) then begin\n Element := Container.ElementByName['Archtype'];\n if Assigned(Element) and Element.NativeValue = 0 then\n Element.NativeValue := $FF; // Signals ArchType that it should not mess with us on the next change!\n end;\nend;\n\nprocedure wbMGEFArchtypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if (aNewValue < $FF) and (aOldValue < $FF) then begin\n Container.ElementNativeValues['..\\Assoc. Item'] := 0;\n case Integer(aNewValue) of\n 11: Container.ElementNativeValues['..\\Actor Value'] := 48;//Invisibility\n 12: Container.ElementNativeValues['..\\Actor Value'] := 49;//Chameleon\n 24: Container.ElementNativeValues['..\\Actor Value'] := 47;//Paralysis\n 36: Container.ElementNativeValues['..\\Actor Value'] := 51;//Turbo\n else\n Container.ElementNativeValues['..\\Actor Value'] := -1;\n end;\n end;\nend;\n\nprocedure wbCounterEffectsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterByPathAfterSet('DATA - Data\\Counter effect count', aElement);\nend;\n\nprocedure wbMGEFAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerByPathAfterSet('DATA - Data\\Counter effect count', 'Counter Effects', aElement);\nend;\n\nfunction wbCTDAReferenceDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Integer(Container.ElementNativeValues['Run On']) = 2 then\n Result := 1;\nend;\n\nfunction wbNAVINVMIDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n case Integer(Container.ElementNativeValues['Type']) of\n $00: Result :=1;\n $20: Result :=2;\n $30: Result :=3;\n end;\nend;\n\nfunction wbIMGSSkinDimmerDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if Supports(Container, IwbSubRecord, SubRecord) then\n if SubRecord.SubRecordHeaderSize in [132, 148] then\n Result := 1;\nend;\n\nfunction wbCOEDOwnerDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n LinksTo : IwbElement;\n MainRecord : IwbMainRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n LinksTo := Container.ElementByName['Owner'].LinksTo;\n\n if Supports(LinksTo, IwbMainRecord, MainRecord) then\n if MainRecord.Signature = 'NPC_' then\n Result := 1\n else if MainRecord.Signature = 'FACT' then\n Result := 2;\nend;\n\nfunction wbCreaLevelDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\n i: Int64;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n i := Container.ElementByName['Flags'].NativeValue;\n if i and $00000080 <> 0 then\n Result := 1;\nend;\n\n\nfunction wbGMSTUnionDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rEDID: IwbRecord;\n s: string;\nbegin\n Result := 1;\n rEDID := aElement.Container.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > 0 then\n case s[1] of\n 's': Result := 0;\n 'f': Result := 2;\n end;\n end;\nend;\n\nfunction wbFLSTLNAMIsSorted(const aContainer: IwbContainer): Boolean;\nvar\n rEDID : IwbRecord;\n s : string;\n _File : IwbFile;\n MainRecord : IwbMainRecord;\nconst\n OrderedList = 'OrderedList';\nbegin\n Result := wbSortFLST; {>>> Should not be sorted according to Arthmoor and JustinOther, left as sorted for compatibility <<<}\n rEDID := aContainer.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > Length(OrderedList) then\n Delete(s, 1, Length(s)-Length(OrderedList));\n if SameText(s, OrderedList) then\n Result := False;\n end;\n if Result then begin\n MainRecord := aContainer.ContainingMainRecord;\n if not Assigned(MainRecord) then\n Exit;\n MainRecord := MainRecord.MasterOrSelf;\n if not Assigned(MainRecord) then\n Exit;\n _File := MainRecord._File;\n if not Assigned(_File) then\n Exit;\n if not SameText(_File.FileName, 'WeaponModKits.esp') then\n Exit;\n case (MainRecord.FormID and $FFFFFF) of\n $0130EB, $0130ED, $01522D, $01522E, $0158D5, $0158D6, $0158D7, $0158D8, $0158D9, $0158DA, $0158DC, $0158DD, $018E20:\n Result := False;\n end;\n end;\nend;\n\nfunction wbPerkDATADecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rPRKE: IwbRecord;\n eType: IwbElement;\nbegin\n Result := 0;\n rPRKE := aElement.Container.RecordBySignature[PRKE];\n if Assigned(rPRKE) then begin\n eType := rPRKE.ElementByName['Type'];\n if Assigned(eType) then begin\n Result := eType.NativeValue;\n end;\n end;\nend;\n\nfunction wbEPFDDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := 0;\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n Result := Container.ElementNativeValues['EPFT'];\n if Result = 2 then\n if Integer(Container.ElementNativeValues['..\\DATA\\Entry Point\\Function']) = 5 then\n Result := 5;\nend;\n\ntype\n TCTDAFunctionParamType = (\n ptNone,\n ptInteger,\n ptVariableName, //Integer\n ptSex, //Enum: Male, Female\n ptActorValue, //Enum: wbActorValue\n ptCrimeType, //?? Enum\n ptAxis, //?? Char\n ptQuestStage, //?? Integer\n ptMiscStat, //?? Enum\n ptAlignment, //?? Enum\n ptEquipType, //?? Enum\n ptFormType, //?? Enum\n ptCriticalStage, //?? Enum\n\n ptObjectReference, //REFR, ACHR, ACRE, PGRE\n ptInventoryObject, //ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, ARMA\n ptActor, //ACHR, ACRE\n ptVoiceType, //VTYP\n ptIdleForm, //IDLE\n ptFormList, //FLST\n ptNote, //NOTE\n ptQuest, //QUST\n ptFaction, //FACT\n ptWeapon, //WEAP\n ptCell, //CELL\n ptClass, //CLAS\n ptRace, //RACE\n ptActorBase, //NPC_, CREA\n ptGlobal, //GLOB\n ptWeather, //WTHR\n ptPackage, //PACK\n ptEncounterZone, //ECZN\n ptPerk, //PERK\n ptOwner, //FACT, NPC_\n ptFurniture, //FURN\n ptMagicItem, //SPEL\n ptMagicEffect, //MGEF\n ptWorldspace, //WRLD\n ptVATSValueFunction,\n ptVATSValueParam,\n ptCreatureType,\n ptMenuMode,\n ptPlayerAction,\n ptBodyLocation,\n ptReferencableObject, //TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM\n ptQuestObjective, //?? Integer\n ptReputation, //REPU\n ptRegion, //REGN\n ptChallenge, //CHAL\n ptCasino, //CSNO\n ptAnyForm // Any form\n );\n\n PCTDAFunction = ^TCTDAFunction;\n TCTDAFunction = record\n Index: Integer;\n Name: string;\n ParamType1: TCTDAFunctionParamType;\n ParamType2: TCTDAFunctionParamType;\n end;\n\nconst\n wbCTDAFunctions : array[0..288] of TCTDAFunction = (\n (Index: 1; Name: 'GetDistance'; ParamType1: ptObjectReference),\n (Index: 5; Name: 'GetLocked'),\n (Index: 6; Name: 'GetPos'; ParamType1: ptAxis),\n (Index: 8; Name: 'GetAngle'; ParamType1: ptAxis),\n (Index: 10; Name: 'GetStartingPos'; ParamType1: ptAxis),\n (Index: 11; Name: 'GetStartingAngle'; ParamType1: ptAxis),\n (Index: 12; Name: 'GetSecondsPassed'),\n (Index: 14; Name: 'GetActorValue'; ParamType1: ptActorValue),\n (Index: 18; Name: 'GetCurrentTime'),\n (Index: 24; Name: 'GetScale'),\n (Index: 25; Name: 'IsMoving'),\n (Index: 26; Name: 'IsTurning'),\n (Index: 27; Name: 'GetLineOfSight'; ParamType1: ptObjectReference),\n (Index: 32; Name: 'GetInSameCell'; ParamType1: ptObjectReference),\n (Index: 35; Name: 'GetDisabled'),\n (Index: 36; Name: 'MenuMode'; ParamType1: ptMenuMode),\n (Index: 39; Name: 'GetDisease'),\n (Index: 40; Name: 'GetVampire'),\n (Index: 41; Name: 'GetClothingValue'),\n (Index: 42; Name: 'SameFaction'; ParamType1: ptActor),\n (Index: 43; Name: 'SameRace'; ParamType1: ptActor),\n (Index: 44; Name: 'SameSex'; ParamType1: ptActor),\n (Index: 45; Name: 'GetDetected'; ParamType1: ptActor),\n (Index: 46; Name: 'GetDead'),\n (Index: 47; Name: 'GetItemCount'; ParamType1: ptInventoryObject),\n (Index: 48; Name: 'GetGold'),\n (Index: 49; Name: 'GetSleeping'),\n (Index: 50; Name: 'GetTalkedToPC'),\n (Index: 53; Name: 'GetScriptVariable'; ParamType1: ptObjectReference; ParamType2: ptVariableName),\n (Index: 56; Name: 'GetQuestRunning'; ParamType1: ptQuest),\n (Index: 58; Name: 'GetStage'; ParamType1: ptQuest),\n (Index: 59; Name: 'GetStageDone'; ParamType1: ptQuest; ParamType2: ptQuestStage),\n (Index: 60; Name: 'GetFactionRankDifference'; ParamType1: ptFaction; ParamType2: ptActor),\n (Index: 61; Name: 'GetAlarmed'),\n (Index: 62; Name: 'IsRaining'),\n (Index: 63; Name: 'GetAttacked'),\n (Index: 64; Name: 'GetIsCreature'),\n (Index: 65; Name: 'GetLockLevel'),\n (Index: 66; Name: 'GetShouldAttack'; ParamType1: ptActor),\n (Index: 67; Name: 'GetInCell'; ParamType1: ptCell),\n (Index: 68; Name: 'GetIsClass'; ParamType1: ptClass),\n (Index: 69; Name: 'GetIsRace'; ParamType1: ptRace),\n (Index: 70; Name: 'GetIsSex'; ParamType1: ptSex),\n (Index: 71; Name: 'GetInFaction'; ParamType1: ptFaction),\n (Index: 72; Name: 'GetIsID'; ParamType1: ptReferencableObject),\n (Index: 73; Name: 'GetFactionRank'; ParamType1: ptFaction),\n (Index: 74; Name: 'GetGlobalValue'; ParamType1: ptGlobal),\n (Index: 75; Name: 'IsSnowing'),\n (Index: 76; Name: 'GetDisposition'; ParamType1: ptActor),\n (Index: 77; Name: 'GetRandomPercent'),\n (Index: 79; Name: 'GetQuestVariable'; ParamType1: ptQuest; ParamType2: ptVariableName),\n (Index: 80; Name: 'GetLevel'),\n (Index: 81; Name: 'GetArmorRating'),\n (Index: 84; Name: 'GetDeadCount'; ParamType1: ptActorBase),\n (Index: 91; Name: 'GetIsAlerted'),\n (Index: 98; Name: 'GetPlayerControlsDisabled'; ParamType1: ptInteger; ParamType2: ptInteger{; ParamType3: ptInteger; ParamType4: ptInteger; ParamType5: ptInteger; ParamType6: ptInteger; ParamType7: ptInteger}),\n (Index: 99; Name: 'GetHeadingAngle'; ParamType1: ptObjectReference),\n (Index: 101; Name: 'IsWeaponOut'),\n (Index: 102; Name: 'IsTorchOut'),\n (Index: 103; Name: 'IsShieldOut'),\n (Index: 106; Name: 'IsFacingUp'),\n (Index: 107; Name: 'GetKnockedState'),\n (Index: 108; Name: 'GetWeaponAnimType'),\n (Index: 109; Name: 'IsWeaponSkillType'; ParamType1: ptActorValue),\n (Index: 110; Name: 'GetCurrentAIPackage'),\n (Index: 111; Name: 'IsWaiting'),\n (Index: 112; Name: 'IsIdlePlaying'),\n (Index: 116; Name: 'GetMinorCrimeCount'),\n (Index: 117; Name: 'GetMajorCrimeCount'),\n (Index: 118; Name: 'GetActorAggroRadiusViolated'),\n (Index: 122; Name: 'GetCrime'; ParamType1: ptActor; ParamType2: ptCrimeType),\n (Index: 123; Name: 'IsGreetingPlayer'),\n (Index: 125; Name: 'IsGuard'),\n (Index: 127; Name: 'HasBeenEaten'),\n (Index: 128; Name: 'GetFatiguePercentage'),\n (Index: 129; Name: 'GetPCIsClass'; ParamType1: ptClass),\n (Index: 130; Name: 'GetPCIsRace'; ParamType1: ptRace),\n (Index: 131; Name: 'GetPCIsSex'; ParamType1: ptSex),\n (Index: 132; Name: 'GetPCInFaction'; ParamType1: ptFaction),\n (Index: 133; Name: 'SameFactionAsPC'),\n (Index: 134; Name: 'SameRaceAsPC'),\n (Index: 135; Name: 'SameSexAsPC'),\n (Index: 136; Name: 'GetIsReference'; ParamType1: ptObjectReference),\n (Index: 141; Name: 'IsTalking'),\n (Index: 142; Name: 'GetWalkSpeed'),\n (Index: 143; Name: 'GetCurrentAIProcedure'),\n (Index: 144; Name: 'GetTrespassWarningLevel'),\n (Index: 145; Name: 'IsTrespassing'),\n (Index: 146; Name: 'IsInMyOwnedCell'),\n (Index: 147; Name: 'GetWindSpeed'),\n (Index: 148; Name: 'GetCurrentWeatherPercent'),\n (Index: 149; Name: 'GetIsCurrentWeather'; ParamType1: ptWeather),\n (Index: 150; Name: 'IsContinuingPackagePCNear'),\n (Index: 153; Name: 'CanHaveFlames'),\n (Index: 154; Name: 'HasFlames'),\n (Index: 157; Name: 'GetOpenState'),\n (Index: 159; Name: 'GetSitting'),\n (Index: 160; Name: 'GetFurnitureMarkerID'),\n (Index: 161; Name: 'GetIsCurrentPackage'; ParamType1: ptPackage),\n (Index: 162; Name: 'IsCurrentFurnitureRef'; ParamType1: ptObjectReference),\n (Index: 163; Name: 'IsCurrentFurnitureObj'; ParamType1: ptFurniture),\n (Index: 170; Name: 'GetDayOfWeek'),\n (Index: 172; Name: 'GetTalkedToPCParam'; ParamType1: ptActor),\n (Index: 175; Name: 'IsPCSleeping'),\n (Index: 176; Name: 'IsPCAMurderer'),\n (Index: 180; Name: 'GetDetectionLevel'; ParamType1: ptActor),\n (Index: 182; Name: 'GetEquipped'; ParamType1: ptInventoryObject),\n (Index: 185; Name: 'IsSwimming'),\n (Index: 190; Name: 'GetAmountSoldStolen'),\n (Index: 192; Name: 'GetIgnoreCrime'),\n (Index: 193; Name: 'GetPCExpelled'; ParamType1: ptFaction),\n (Index: 195; Name: 'GetPCFactionMurder'; ParamType1: ptFaction),\n (Index: 197; Name: 'GetPCEnemyofFaction'; ParamType1: ptFaction),\n (Index: 199; Name: 'GetPCFactionAttack'; ParamType1: ptFaction),\n (Index: 203; Name: 'GetDestroyed'),\n (Index: 214; Name: 'HasMagicEffect'; ParamType1: ptMagicEffect),\n (Index: 215; Name: 'GetDefaultOpen'),\n (Index: 219; Name: 'GetAnimAction'),\n (Index: 223; Name: 'IsSpellTarget'; ParamType1: ptMagicItem),\n (Index: 224; Name: 'GetVATSMode'),\n (Index: 225; Name: 'GetPersuasionNumber'),\n (Index: 226; Name: 'GetSandman'),\n (Index: 227; Name: 'GetCannibal'),\n (Index: 228; Name: 'GetIsClassDefault'; ParamType1: ptClass),\n (Index: 229; Name: 'GetClassDefaultMatch'),\n (Index: 230; Name: 'GetInCellParam'; ParamType1: ptCell; ParamType2: ptObjectReference),\n (Index: 235; Name: 'GetVatsTargetHeight'),\n (Index: 237; Name: 'GetIsGhost'),\n (Index: 242; Name: 'GetUnconscious'),\n (Index: 244; Name: 'GetRestrained'),\n (Index: 246; Name: 'GetIsUsedItem'; ParamType1: ptReferencableObject),\n (Index: 247; Name: 'GetIsUsedItemType'; ParamType1: ptFormType),\n (Index: 254; Name: 'GetIsPlayableRace'),\n (Index: 255; Name: 'GetOffersServicesNow'),\n (Index: 258; Name: 'GetUsedItemLevel'),\n (Index: 259; Name: 'GetUsedItemActivate'),\n (Index: 264; Name: 'GetBarterGold'),\n (Index: 265; Name: 'IsTimePassing'),\n (Index: 266; Name: 'IsPleasant'),\n (Index: 267; Name: 'IsCloudy'),\n (Index: 274; Name: 'GetArmorRatingUpperBody'),\n (Index: 277; Name: 'GetBaseActorValue'; ParamType1: ptActorValue),\n (Index: 278; Name: 'IsOwner'; ParamType1: ptOwner),\n (Index: 280; Name: 'IsCellOwner'; ParamType1: ptCell; ParamType2: ptOwner),\n (Index: 282; Name: 'IsHorseStolen'),\n (Index: 285; Name: 'IsLeftUp'),\n (Index: 286; Name: 'IsSneaking'),\n (Index: 287; Name: 'IsRunning'),\n (Index: 288; Name: 'GetFriendHit'),\n (Index: 289; Name: 'IsInCombat'),\n (Index: 300; Name: 'IsInInterior'),\n (Index: 304; Name: 'IsWaterObject'),\n (Index: 306; Name: 'IsActorUsingATorch'),\n (Index: 309; Name: 'IsXBox'),\n (Index: 310; Name: 'GetInWorldspace'; ParamType1: ptWorldSpace),\n (Index: 312; Name: 'GetPCMiscStat'; ParamType1: ptMiscStat),\n (Index: 313; Name: 'IsActorEvil'),\n (Index: 314; Name: 'IsActorAVictim'),\n (Index: 315; Name: 'GetTotalPersuasionNumber'),\n (Index: 318; Name: 'GetIdleDoneOnce'),\n (Index: 320; Name: 'GetNoRumors'),\n (Index: 323; Name: 'WhichServiceMenu'),\n (Index: 327; Name: 'IsRidingHorse'),\n (Index: 332; Name: 'IsInDangerousWater'),\n (Index: 338; Name: 'GetIgnoreFriendlyHits'),\n (Index: 339; Name: 'IsPlayersLastRiddenHorse'),\n (Index: 353; Name: 'IsActor'),\n (Index: 354; Name: 'IsEssential'),\n (Index: 358; Name: 'IsPlayerMovingIntoNewSpace'),\n (Index: 361; Name: 'GetTimeDead'),\n (Index: 362; Name: 'GetPlayerHasLastRiddenHorse'),\n (Index: 365; Name: 'IsChild'),\n (Index: 367; Name: 'GetLastPlayerAction'),\n (Index: 368; Name: 'IsPlayerActionActive'; ParamType1: ptPlayerAction),\n (Index: 370; Name: 'IsTalkingActivatorActor'; ParamType1: ptActor),\n (Index: 372; Name: 'IsInList'; ParamType1: ptFormList),\n (Index: 382; Name: 'GetHasNote'; ParamType1: ptNote),\n (Index: 391; Name: 'GetHitLocation'),\n (Index: 392; Name: 'IsPC1stPerson'),\n (Index: 397; Name: 'GetCauseofDeath'),\n (Index: 398; Name: 'IsLimbGone'; ParamType1: ptBodyLocation),\n (Index: 399; Name: 'IsWeaponInList'; ParamType1: ptFormList),\n (Index: 403; Name: 'HasFriendDisposition'),\n (Index: 408; Name: 'GetVATSValue'; ParamType1: ptVATSValueFunction; ParamType2: ptVATSValueParam),\n (Index: 409; Name: 'IsKiller'; ParamType1: ptActor),\n (Index: 410; Name: 'IsKillerObject'; ParamType1: ptFormList),\n (Index: 411; Name: 'GetFactionCombatReaction'; ParamType1: ptFaction; ParamType2: ptFaction),\n (Index: 415; Name: 'Exists'; ParamType1: ptObjectReference),\n (Index: 416; Name: 'GetGroupMemberCount'),\n (Index: 417; Name: 'GetGroupTargetCount'),\n (Index: 420; Name: 'GetObjectiveCompleted'; ParamType1: ptQuest; ParamType2: ptQuestObjective),\n (Index: 421; Name: 'GetObjectiveDisplayed'; ParamType1: ptQuest; ParamType2: ptQuestObjective),\n (Index: 427; Name: 'GetIsVoiceType'; ParamType1: ptVoiceType),\n (Index: 428; Name: 'GetPlantedExplosive'),\n (Index: 430; Name: 'IsActorTalkingThroughActivator'),\n (Index: 431; Name: 'GetHealthPercentage'),\n (Index: 433; Name: 'GetIsObjectType'; ParamType1: ptFormType),\n (Index: 435; Name: 'GetDialogueEmotion'),\n (Index: 436; Name: 'GetDialogueEmotionValue'),\n (Index: 438; Name: 'GetIsCreatureType'; ParamType1: ptCreatureType),\n (Index: 446; Name: 'GetInZone'; ParamType1: ptEncounterZone),\n (Index: 449; Name: 'HasPerk'; ParamType1: ptPerk; ParamType2: ptInteger {boolean Alt}),\t// PlayerCharacter has 2 lists of perks\n (Index: 450; Name: 'GetFactionRelation'; ParamType1: ptActor),\n (Index: 451; Name: 'IsLastIdlePlayed'; ParamType1: ptIdleForm),\n (Index: 454; Name: 'GetPlayerTeammate'),\n (Index: 455; Name: 'GetPlayerTeammateCount'),\n (Index: 459; Name: 'GetActorCrimePlayerEnemy'),\n (Index: 460; Name: 'GetActorFactionPlayerEnemy'),\n (Index: 462; Name: 'IsPlayerTagSkill'; ParamType1: ptActorValue),\n (Index: 464; Name: 'IsPlayerGrabbedRef'; ParamType1: ptObjectReference),\n (Index: 471; Name: 'GetDestructionStage'),\n (Index: 474; Name: 'GetIsAlignment'; ParamType1: ptAlignment),\n (Index: 478; Name: 'GetThreatRatio'; ParamType1: ptActor),\n (Index: 480; Name: 'GetIsUsedItemEquipType'; ParamType1: ptEquipType),\n (Index: 489; Name: 'GetConcussed'),\n (Index: 492; Name: 'GetMapMarkerVisible'),\n (Index: 495; Name: 'GetPermanentActorValue'; ParamType1: ptActorValue),\n (Index: 496; Name: 'GetKillingBlowLimb'),\n (Index: 500; Name: 'GetWeaponHealthPerc'),\n (Index: 503; Name: 'GetRadiationLevel'),\n (Index: 510; Name: 'GetLastHitCritical'),\n (Index: 515; Name: 'IsCombatTarget'; ParamType1: ptActor),\n (Index: 518; Name: 'GetVATSRightAreaFree'; ParamType1: ptObjectReference),\n (Index: 519; Name: 'GetVATSLeftAreaFree'; ParamType1: ptObjectReference),\n (Index: 520; Name: 'GetVATSBackAreaFree'; ParamType1: ptObjectReference),\n (Index: 521; Name: 'GetVATSFrontAreaFree'; ParamType1: ptObjectReference),\n (Index: 522; Name: 'GetIsLockBroken'),\n (Index: 523; Name: 'IsPS3'),\n (Index: 524; Name: 'IsWin32'),\n (Index: 525; Name: 'GetVATSRightTargetVisible'; ParamType1: ptObjectReference),\n (Index: 526; Name: 'GetVATSLeftTargetVisible'; ParamType1: ptObjectReference),\n (Index: 527; Name: 'GetVATSBackTargetVisible'; ParamType1: ptObjectReference),\n (Index: 528; Name: 'GetVATSFrontTargetVisible'; ParamType1: ptObjectReference),\n (Index: 531; Name: 'IsInCriticalStage'; ParamType1: ptCriticalStage),\n (Index: 533; Name: 'GetXPForNextLevel'),\n (Index: 546; Name: 'GetQuestCompleted'; ParamType1: ptQuest),\n (Index: 550; Name: 'IsGoreDisabled'),\n (Index: 555; Name: 'GetSpellUsageNum'; ParamType1: ptMagicItem),\n (Index: 557; Name: 'GetActorsInHigh'),\n (Index: 558; Name: 'HasLoaded3D'),\n (Index: 573; Name: 'GetReputation'; ParamType1: ptReputation; ParamType2: ptInteger),\n (Index: 574; Name: 'GetReputationPct'; ParamType1: ptReputation; ParamType2: ptInteger),\n (Index: 575; Name: 'GetReputationThreshold'; ParamType1: ptReputation; ParamType2: ptInteger),\n (Index: 586; Name: 'IsHardcore'),\n (Index: 601; Name: 'GetForceHitReaction'),\n (Index: 607; Name: 'ChallengeLocked'; ParamType1: ptChallenge),\n (Index: 610; Name: 'GetCasinoWinningStage'; ParamType1: ptCasino),\n (Index: 612; Name: 'PlayerInRegion'; ParamType1: ptRegion),\n (Index: 614; Name: 'GetChallengeCompleted'; ParamType1: ptChallenge),\n (Index: 619; Name: 'IsAlwaysHardcore'),\n\n // Added by NVSE\n (Index: 1024; Name: 'GetNVSEVersion'; ),\n (Index: 1025; Name: 'GetNVSERevision'; ),\n (Index: 1026; Name: 'GetNVSEBeta'; ),\n (Index: 1028; Name: 'GetWeight'; ParamType1: ptInventoryObject; ),\n (Index: 1076; Name: 'GetWeaponHasScope'; ParamType1: ptInventoryObject; ),\n (Index: 1089; Name: 'ListGetFormIndex'; ParamType1: ptFormList; ParamType2: ptFormType;),\n (Index: 1107; Name: 'IsKeyPressed'; ParamType1: ptInteger; ParamType2: ptInteger;),\n (Index: 1131; Name: 'IsControlPressed'; ParamType1: ptInteger; ),\n (Index: 1271; Name: 'HasOwnership'; ParamType1: ptObjectReference; ),\n (Index: 1272; Name: 'IsOwned'; ParamType1: ptActor ),\n (Index: 1274; Name: 'GetDialogueTarget'; ParamType1: ptActor; ),\n (Index: 1275; Name: 'GetDialogueSubject'; ParamType1: ptActor; ),\n (Index: 1276; Name: 'GetDialogueSpeaker'; ParamType1: ptActor; ),\n (Index: 1278; Name: 'GetAgeClass'; ParamType1: ptActorBase; ),\n (Index: 1286; Name: 'GetTokenValue'; ParamType1: ptFormType; ),\n (Index: 1288; Name: 'GetTokenRef'; ParamType1: ptFormType; ),\n (Index: 1291; Name: 'GetPaired'; ParamType1: ptInventoryObject; ParamType2: ptActorBase;),\n (Index: 1292; Name: 'GetRespawn'; ParamType1: ptACtorBase; ),\n (Index: 1294; Name: 'GetPermanent'; ParamType1: ptObjectReference; ),\n (Index: 1297; Name: 'IsRefInList'; ParamType1: ptFormList; ParamType2: ptFormType;),\n (Index: 1301; Name: 'GetPackageCount'; ParamType1: ptObjectReference; ),\n (Index: 1440; Name: 'IsPlayerSwimming'; ),\n (Index: 1441; Name: 'GetTFC'; ),\n (Index: 1475; Name: 'GetPerkRank'; ParamType1: ptPerk; ParamType2: ptActor;),\n (Index: 1476; Name: 'GetAltPerkRank'; ParamType1: ptPerk; ParamType2: ptActor;),\n (Index: 1541; Name: 'GetActorFIKstatus'; ),\n\n // Added by nvse_plugin_ExtendedActorVariable\n (Index: 4352; Name: 'GetExtendedActorVariable'; ParamType1: ptInventoryObject; ),\n (Index: 4353; Name: 'GetBaseExtendedActorVariable'; ParamType1: ptInventoryObject; ),\n (Index: 4355; Name: 'GetModExtendedActorVariable'; ParamType1: ptInventoryObject; ),\n\n // Added by nvse_extender\n (Index: 4420; Name: 'NX_GetEVFl'; ParamType1: ptNone; ), // Actually ptString, but it cannot be used in GECK\n (Index: 4426; Name: 'NX_GetQVEVFl'; ParamType1: ptQuest; ParamType2: ptInteger;),\n\n // Added by lutana_nvse\n (Index: 4708; Name: 'GetArmorClass'; ParamType1: ptAnyForm; ),\n (Index: 4709; Name: 'IsRaceInList'; ParamType1: ptFormList; ),\n (Index: 4822; Name: 'GetReferenceFlag'; ParamType1: ptInteger; ),\n\n // Added by JIP NVSE Plugin\n (Index: 5637; Name: 'GetIsPoisoned'; ),\n (Index: 5708; Name: 'IsEquippedWeaponSilenced'; ),\n (Index: 5709; Name: 'IsEquippedWeaponScoped'; ),\n (Index: 5953; Name: 'GetPCInRegion'; ParamType1: ptRegion; ),\n (Index: 5962; Name: 'GetPCDetectionState'; )\n );\n\nvar\n wbCTDAFunctionEditInfo: string;\n\nfunction wbCTDAParamDescFromIndex(aIndex: Integer): PCTDAFunction;\nvar\n L, H, I, C: Integer;\nbegin\n Result := nil;\n\n L := Low(wbCTDAFunctions);\n H := High(wbCTDAFunctions);\n while L <= H do begin\n I := (L + H) shr 1;\n C := CmpW32(wbCTDAFunctions[I].Index, aIndex);\n if C < 0 then\n L := I + 1\n else begin\n H := I - 1;\n if C = 0 then begin\n L := I;\n Result := @wbCTDAFunctions[L];\n end;\n end;\n end;\nend;\n\nfunction wbCTDACompValueDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if Integer(Container.ElementByName['Type'].NativeValue) and $04 <> 0 then\n Result := 1;\nend;\n\nfunction wbCTDAParam1Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n if Assigned(Desc) then\n Result := Succ(Integer(Desc.ParamType1));\nend;\n\nfunction wbCTDAParam2VATSValueParam(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n Result := Container.ElementByName['Parameter #1'].NativeValue;\nend;\n\nfunction wbCTDAParam2Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n if Assigned(Desc) then\n Result := Succ(Integer(Desc.ParamType2));\nend;\n\nfunction wbCTDAFunctionToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Desc : PCTDAFunction;\n i : Integer;\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := Desc.Name\n else if aType = ctToEditValue then\n Result := IntToStr(aInt)\n else\n Result := '';\n end;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctCheck: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := ''\n else\n Result := '';\n end;\n ctEditType:\n Result := 'ComboBox';\n ctEditInfo: begin\n Result := wbCTDAFunctionEditInfo;\n if Result = '' then begin\n with TStringList.Create do try\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n Add(wbCTDAFunctions[i].Name);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n wbCTDAFunctionEditInfo := Result;\n end;\n end;\n end;\nend;\n\nfunction wbCTDAFunctionToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i: Integer;\nbegin\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n with wbCTDAFunctions[i] do\n if SameText(Name, aString) then begin\n Result := Index;\n Exit;\n end;\n Result := StrToInt64(aString);\nend;\n\ntype\n TPERKEntryPointConditionType = (\n epcDefault,\n epcItem,\n epcWeapon,\n epcWeaponTarget,\n epcTarget,\n epcAttacker,\n epcAttackerAttackee,\n epcAttackerAttackerWeapon\n );\n\n TPERKEntryPointFunctionType = (\n epfFloat,\n epfLeveledItem,\n epfScript,\n epfUnknown\n );\n\n TPERKEntryPointFunctionParamType = (\n epfpNone,\n epfpFloat,\n epfpFloatFloat,\n epfpLeveledItem,\n epfpScript\n );\n\n PPERKEntryPoint = ^TPERKEntryPoint;\n TPERKEntryPoint = record\n Name : string;\n Condition : TPERKEntryPointConditionType;\n FunctionType : TPERKEntryPointFunctionType;\n end;\n\n PPERKCondition = ^TPERKCondition;\n TPERKCondition = record\n Count : Integer;\n Caption1 : string;\n Caption2 : string;\n Caption3 : string;\n end;\n\n PPERKFunction = ^TPERKFunction;\n TPERKFunction = record\n Name : string;\n FunctionType : TPERKEntryPointFunctionType;\n ParamType : TPERKEntryPointFunctionParamType;\n end;\n\nconst\n wbPERKCondition : array[TPERKEntryPointConditionType] of TPERKCondition = (\n (Count: 1; Caption1: 'Perk Owner'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Item'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Weapon'),\n (Count: 3; Caption1: 'Perk Owner'; Caption2: 'Weapon'; Caption3: 'Target'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Target'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Attacker'),\n (Count: 3; Caption1: 'Perk Owner'; Caption2: 'Attacker'; Caption3: 'Attackee'),\n (Count: 3; Caption1: 'Perk Owner'; Caption2: 'Attacker'; Caption3: 'Attacker Weapon')\n );\n\n wbPERKFunctions : array[0..9] of TPERKFunction = (\n (Name: ''; FunctionType: epfUnknown; ParamType: epfpNone),\n (Name: 'Set Value'; FunctionType: epfFloat; ParamType: epfpFloat),\n (Name: 'Add Value'; FunctionType: epfFloat; ParamType: epfpFloat),\n (Name: 'Multiply Value'; FunctionType: epfFloat; ParamType: epfpFloat),\n (Name: 'Add Range To Value'; FunctionType: epfFloat; ParamType: epfpFloatFloat),\n (Name: 'Add Actor Value Mult'; FunctionType: epfFloat; ParamType: epfpFloatFloat),\n (Name: 'Absolute Value'; FunctionType: epfFloat; ParamType: epfpNone),\n (Name: 'Negative Absolute Value'; FunctionType: epfFloat; ParamType: epfpNone),\n (Name: 'Add Leveled List'; FunctionType: epfLeveledItem; ParamType: epfpLeveledItem),\n (Name: 'Add Activate Choice'; FunctionType: epfScript; ParamType: epfpScript)\n );\n\n wbPERKEntryPoints : array[0..73] of TPERKEntryPoint = (\n (Name: 'Calculate Weapon Damage'; Condition: epcWeaponTarget),\n (Name: 'Calculate My Critical Hit Chance'; Condition: epcWeaponTarget),\n (Name: 'Calculate My Critical Hit Damage'; Condition: epcWeaponTarget),\n (Name: 'Calculate Weapon Attack AP Cost'; Condition: epcWeapon),\n (Name: 'Calculate Mine Explode Chance'; Condition: epcItem),\n (Name: 'Adjust Range Penalty'; Condition: epcWeapon),\n (Name: 'Adjust Limb Damage'; Condition: epcAttackerAttackerWeapon),\n (Name: 'Calculate Weapon Range'; Condition: epcWeapon),\n (Name: 'Calculate To Hit Chance'; Condition: epcWeaponTarget),\n (Name: 'Adjust Experience Points'),\n (Name: 'Adjust Gained Skill Points'),\n (Name: 'Adjust Book Skill Points'),\n (Name: 'Modify Recovered Health'),\n (Name: 'Calculate Inventory AP Cost'),\n (Name: 'Get Disposition'; Condition: epcTarget),\n (Name: 'Get Should Attack'; Condition: epcAttacker),\n (Name: 'Get Should Assist'; Condition: epcAttackerAttackee),\n (Name: 'Calculate Buy Price'; Condition: epcItem),\n (Name: 'Get Bad Karma'),\n (Name: 'Get Good Karma'),\n (Name: 'Ignore Locked Terminal'),\n (Name: 'Add Leveled List On Death'; Condition: epcTarget; FunctionType: epfLeveledItem),\n (Name: 'Get Max Carry Weight'),\n (Name: 'Modify Addiction Chance'),\n (Name: 'Modify Addiction Duration'),\n (Name: 'Modify Positive Chem Duration'),\n (Name: 'Adjust Drinking Radiation'),\n (Name: 'Activate'; Condition: epcTarget; FunctionType: epfScript),\n (Name: 'Mysterious Stranger'),\n (Name: 'Has Paralyzing Palm'),\n (Name: 'Hacking Science Bonus'),\n (Name: 'Ignore Running During Detection'),\n (Name: 'Ignore Broken Lock'),\n (Name: 'Has Concentrated Fire'),\n (Name: 'Calculate Gun Spread'; Condition: epcWeapon),\n (Name: 'Player Kill AP Reward'; Condition: epcWeaponTarget),\n{36}(Name: 'Modify Enemy Critical Hit Chance'; Condition: epcWeaponTarget),\n{37}(Name: 'Reload Speed'; Condition: epcWeapon),\n{38}(Name: 'Equip Speed'; Condition: epcWeapon),\n{39}(Name: 'Action Point Regen'; Condition: epcWeapon),\n{40}(Name: 'Action Point Cost'; Condition: epcWeapon),\n{41}(Name: 'Miss Fortune'; Condition: epcDefault),\n{42}(Name: 'Modify Run Speed'; Condition: epcDefault),\n{43}(Name: 'Modify Attack Speed'; Condition: epcWeapon),\n{44}(Name: 'Modify Radiation Consumed'; Condition: epcDefault),\n{45}(Name: 'Has Pip Hacker'; Condition: epcDefault),\n{46}(Name: 'Has Meltdown'; Condition: epcDefault),\n{47}(Name: 'See Enemy Health'; Condition: epcDefault),\n{48}(Name: 'Has Jury Rigging'; Condition: epcDefault),\n{49}(Name: 'Modify Threat Range'; Condition: epcWeapon),\n{50}(Name: 'Modify Thread'; Condition: epcWeapon),\n{51}(Name: 'Has Fast Travel Always'; Condition: epcDefault),\n{52}(Name: 'Knockdown Chance'; Condition: epcWeapon),\n{53}(Name: 'Modify Weapon Strength Req'; Condition: epcWeapon),\n{54}(Name: 'Modify Aiming Move Speed'; Condition: epcWeapon),\n{55}(Name: 'Modify Light Items'; Condition: epcDefault),\n{56}(Name: 'Modify Damage Threshold (defender)'; Condition: epcWeaponTarget),\n{57}(Name: 'Modify Chance for Ammo Item'; Condition: epcWeapon),\n{58}(Name: 'Modify Damage Threshold (attacker)'; Condition: epcWeaponTarget),\n{59}(Name: 'Modify Throwing Velocity'; Condition: epcWeapon),\n{60}(Name: 'Chance for Item on Fire'; Condition: epcWeapon),\n{61}(Name: 'Has Unarmed Forward Power Attack'; Condition: epcDefault),\n{62}(Name: 'Has Unarmed Back Power Attack'; Condition: epcWeaponTarget),\n{63}(Name: 'Has Unarmed Crouched Power Attack'; Condition: epcDefault),\n{64}(Name: 'Has Unarmed Counter Attack'; Condition: epcWeaponTarget),\n{65}(Name: 'Has Unarmed Left Power Attack'; Condition: epcDefault),\n{66}(Name: 'Has Unarmed Right Power Attack'; Condition: epcDefault),\n{67}(Name: 'VATS HelperChance'; Condition: epcDefault),\n{68}(Name: 'Modify Item Damage'; Condition: epcDefault),\n{69}(Name: 'Has Improved Detection'; Condition: epcDefault),\n{70}(Name: 'Has Improved Spotting'; Condition: epcDefault),\n{71}(Name: 'Has Improved Item Detection'; Condition: epcDefault),\n{72}(Name: 'Adjust Explosion Radius'; Condition: epcWeapon),\n{73}(Name: 'Reserved'; Condition: epcWeapon)\n );\n\n wbPERKFunctionParams: array[TPERKEntryPointFunctionParamType] of string = (\n 'None',\n 'Float',\n 'Float, Float',\n 'Leveled Item',\n 'Script'\n );\n\nprocedure wbPERKEntryPointAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldEntryPoint : PPERKEntryPoint;\n NewEntryPoint : PPERKEntryPoint;\n OldCondition : PPERKCondition;\n NewCondition : PPERKCondition;\n OldFunction : PPERKFunction;\n EntryPoint : IwbContainerElementRef;\n Effect : IwbContainerElementRef;\n PerkConditions : IwbContainerElementRef;\n PerkCondition : IwbContainerElementRef;\n Container : IwbContainerElementRef;\n i : Integer;\nbegin\n if aOldValue <> aNewValue then begin\n OldEntryPoint := @wbPERKEntryPoints[Integer(aOldValue)];\n NewEntryPoint := @wbPERKEntryPoints[Integer(aNewValue)];\n OldCondition := @wbPERKCondition[OldEntryPoint.Condition];\n NewCondition := @wbPERKCondition[NewEntryPoint.Condition];\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, EntryPoint) then\n Exit;\n i := EntryPoint.ElementNativeValues['Function'];\n if (i >= Low(wbPERKFunctions)) and (i <= High(wbPERKFunctions)) then\n OldFunction := @wbPERKFunctions[i]\n else\n OldFunction := nil;\n if not Assigned(OldFunction) or (OldFunction.FunctionType <> NewEntryPoint.FunctionType) then\n for i := Low(wbPERKFunctions) to High(wbPERKFunctions) do\n with wbPERKFunctions[i] do\n if FunctionType = NewEntryPoint.FunctionType then begin\n EntryPoint.ElementNativeValues['Function'] := i;\n Break;\n end;\n EntryPoint.ElementNativeValues['Perk Condition Tab Count'] := NewCondition.Count;\n\n if not Supports(EntryPoint.Container, IwbContainerElementRef, Container) then\n Exit;\n if not Supports(Container.Container, IwbContainerElementRef, Effect) then\n Exit;\n\n if not Supports(Effect.ElementByName['Perk Conditions'], IwbContainerElementRef, PerkConditions) then\n Exit;\n\n for i := Pred(PerkConditions.ElementCount) downto 0 do\n if Supports(PerkConditions.Elements[i], IwbContainerElementRef, PerkCondition) then\n if Integer(PerkCondition.ElementNativeValues['PRKC']) >= NewCondition.Count then\n PerkCondition.Remove\n else\n case Integer(PerkCondition.ElementNativeValues['PRKC']) of\n 2: if OldCondition.Caption2 <> NewCondition.Caption2 then\n PerkCondition.Remove;\n 3: if OldCondition.Caption3 <> NewCondition.Caption3 then\n PerkCondition.Remove;\n end;\n end;\nend;\n\nfunction wbPRKCToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n EntryPointVar := Container.ElementNativeValues['..\\..\\..\\DATA\\Entry Point\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n Exit;\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n with wbPERKEntryPoints[EntryPoint] do begin\n with wbPERKCondition[Condition] do begin\n case aType of\n ctEditType: Result := 'ComboBox';\n ctEditInfo: with TStringList.Create do try\n if Caption1 <> '' then\n Add(Caption1);\n if Caption2 <> '' then\n Add(Caption2);\n if Caption3 <> '' then\n Add(Caption3);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n else\n if (aInt < 0) or (aInt >= Count) then\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end\n else\n case aType of\n ctToStr, ctToEditValue: case Integer(aInt) of\n 0: Result := Caption1;\n 1: Result := Caption2;\n 2: Result := Caption3;\n end;\n ctCheck: Result := '';\n end;\n end;\n end;\n end;\nend;\n\nfunction wbPRKCToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\n s : string;\nbegin\n s := Trim(aString);\n\n Result := StrToInt64Def(s, Low(Integer));\n if Result <> Low(Integer) then\n Exit;\n if s = '' then begin\n Result := 0;\n Exit;\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n raise Exception.Create('Could not resolve Entry Point');\n EntryPointVar := Container.ElementNativeValues['..\\..\\..\\DATA\\Entry Point\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n raise Exception.Create('Could not resolve Entry Point');\n\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then\n raise Exception.Create('Unknown Entry Point #'+IntToStr(EntryPoint));\n\n with wbPERKEntryPoints[EntryPoint] do\n with wbPERKCondition[Condition] do\n if SameText(aString, Caption1) then\n Result := 0\n else if SameText(aString, Caption2) then\n Result := 1\n else if SameText(aString, Caption3) then\n Result := 2\n else\n raise Exception.Create('\"'+s+'\" is not valid for this Entry Point');\nend;\n\nfunction wbNeverShow(const aElement: IwbElement): Boolean;\nbegin\n Result := wbHideNeverShow;\nend;\n\nfunction GetREGNType(aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := -1;\n if not Assigned(aElement) then\n Exit;\n while aElement.Name <> 'Region Data Entry' do begin\n aElement := aElement.Container;\n if not Assigned(aElement) then\n Exit;\n end;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n Result := Container.ElementNativeValues['RDAT\\Type'];\nend;\n\nfunction wbREGNObjectsDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 2;\nend;\n\nfunction wbREGNWeatherDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 3;\nend;\n\nfunction wbREGNMapDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 4;\nend;\n\nfunction wbREGNLandDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 5;\nend;\n\nfunction wbREGNGrassDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 6;\nend;\n\nfunction wbREGNSoundDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 7;\nend;\n\nfunction wbREGNImposterDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 8;\nend;\n\nfunction wbMESGTNAMDontShow(const aElement: IwbElement): Boolean;\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n Result := False;\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if Integer(Container.ElementNativeValues['DNAM']) and 1 <> 0 then\n Result := True;\nend;\n\nfunction wbEPFDDontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Entry Point Function Parameters' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if not (Integer(Container.ElementNativeValues['EPFT']) in [1..3]) then\n Result := True;\nend;\n\nfunction wbTES4ONAMDontShow(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n Result := False;\n if not Assigned(aElement) then\n Exit;\n MainRecord := aElement.ContainingMainRecord;\n if not Assigned(MainRecord) then\n Exit;\n if not MainRecord.IsESM then\n Result := True;\nend;\n\n\nfunction wbEPF2DontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Entry Point Function Parameters' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if not (Integer(Container.ElementNativeValues['EPFT']) in [4]) then\n Result := True;\nend;\n\nfunction wbPERKPRKCDontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Effect' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if Integer(Container.ElementNativeValues['PRKE\\Type']) <> 2 then\n Result := True;\nend;\n\nfunction wbPerkDATAFunctionToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\n i : Integer;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n EntryPointVar := Container.ElementNativeValues['..\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n Exit;\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n with wbPERKEntryPoints[EntryPoint] do begin\n case aType of\n ctEditType: Result := 'ComboBox';\n ctEditInfo: with TStringList.Create do try\n for i := Low(wbPERKFunctions) to High(wbPERKFunctions) do\n if wbPERKFunctions[i].FunctionType = FunctionType then\n if (wbPERKFunctions[i].Name <> '') then\n Add(wbPERKFunctions[i].Name);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n else\n if (aInt < Low(wbPERKFunctions)) or (aInt > High(wbPERKFunctions)) then\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end\n else\n case aType of\n ctToStr, ctToEditValue: begin\n Result := wbPERKFunctions[Integer(aInt)].Name;\n if (aType = ctToStr) and (wbPERKFunctions[Integer(aInt)].FunctionType <> FunctionType) then\n Result := Result + ' ';\n end;\n ctCheck:\n if wbPERKFunctions[Integer(aInt)].FunctionType <> FunctionType then\n Result := ''\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPerkDATAFunctionToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\n s : string;\n i : Integer;\nbegin\n s := Trim(aString);\n\n Result := StrToInt64Def(s, Low(Integer));\n if Result <> Low(Integer) then\n Exit;\n if s = '' then\n raise Exception.Create('\"\" is not a valid value for this field');\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n raise Exception.Create('Could not resolve Entry Point');\n EntryPointVar := Container.ElementNativeValues['..\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n raise Exception.Create('Could not resolve Entry Point');\n\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then\n raise Exception.Create('Unknown Entry Point #'+IntToStr(EntryPoint));\n\n with wbPERKEntryPoints[EntryPoint] do\n for i := Low(wbPERKFunctions) to High(wbPERKFunctions) do\n if wbPERKFunctions[i].FunctionType = FunctionType then\n if SameText(s, wbPERKFunctions[i].Name) then begin\n Result := i;\n Exit;\n end;\n\n raise Exception.Create('\"'+s+'\" is not valid for this Entry Point');\nend;\n\nprocedure wbPerkDATAFunctionAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n NewFunction : Integer;\n Container : IwbContainerElementRef;\n OldParamType: Integer;\n NewParamType: Integer;\nbegin\n NewFunction := aNewValue;\n if (NewFunction < Low(wbPERKFunctions)) or (NewFunction > High(wbPERKFunctions)) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n OldParamType := Container.ElementNativeValues['..\\..\\..\\Entry Point Function Parameters\\EPFT'];\n NewParamType := Ord(wbPERKFunctions[NewFunction].ParamType);\n if (OldParamType = NewParamType) and not VarSameValue(aOldValue, aNewValue) and (NewFunction in [4,5]) then\n Container.ElementNativeValues['..\\..\\..\\Entry Point Function Parameters\\EPFT'] := 0;\n Container.ElementNativeValues['..\\..\\..\\Entry Point Function Parameters\\EPFT'] := NewParamType;\nend;\n\nfunction wbPerkEPFTToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n FunctionTypeVar : Variant;\n FunctionType : Integer;\n// i : Integer;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n FunctionTypeVar := Container.ElementNativeValues['..\\..\\DATA\\Entry Point\\Function'];\n if VarIsNull(FunctionTypeVar) or VarIsClear(FunctionTypeVar) then\n Exit;\n FunctionType := FunctionTypeVar;\n if (FunctionType < Low(wbPERKFunctions)) or (FunctionType > High(wbPERKFunctions)) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n with wbPERKFunctions[FunctionType] do begin\n case aType of\n ctEditType: Result := 'ComboBox';\n ctEditInfo: Result := '\"' + wbPERKFunctionParams[ParamType] + '\"';\n else\n if (aInt < Ord(Low(wbPERKFunctionParams))) or (aInt > Ord(High(wbPERKFunctionParams))) then\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end\n else\n case aType of\n ctToStr, ctToEditValue: begin\n Result := wbPERKFunctionParams[TPERKEntryPointFunctionParamType(aInt)];\n if (aType = ctToStr) and (TPERKEntryPointFunctionParamType(aInt) <> ParamType) then\n Result := Result + ' ';\n end;\n ctCheck:\n if TPERKEntryPointFunctionParamType(aInt) <> ParamType then\n Result := Result + ' '\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPerkEPFTToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n FunctionTypeVar : Variant;\n FunctionType : Integer;\n s : string;\n// i : Integer;\n j : TPERKEntryPointFunctionParamType;\nbegin\n s := Trim(aString);\n\n Result := StrToInt64Def(s, Low(Integer));\n if Result <> Low(Integer) then\n Exit;\n if s = '' then\n raise Exception.Create('\"\" is not a valid value for this field');\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n raise Exception.Create('Could not resolve Function');\n FunctionTypeVar := Container.ElementNativeValues['..\\..\\DATA\\Entry Point\\Function'];\n if VarIsNull(FunctionTypeVar) or VarIsClear(FunctionTypeVar) then\n raise Exception.Create('Could not resolve Function');\n\n FunctionType := FunctionTypeVar;\n if (FunctionType < Low(wbPERKFunctions)) or (FunctionType > High(wbPERKFunctions)) then\n raise Exception.Create('Unknown Function #'+IntToStr(FunctionType));\n\n with wbPERKFunctions[FunctionType] do begin\n for j := Low(wbPERKFunctionParams) to High(wbPERKFunctionParams) do\n if SameText(s, wbPERKFunctionParams[j]) then begin\n if j <> ParamType then\n raise Exception.Create('\"'+s+'\" is not a valid Parameter Type for Function \"'+Name+'\"');\n Result := Ord(j);\n Exit;\n end;\n end;\n\n raise Exception.Create('\"'+s+'\" is not a valid Parameter Type');\nend;\n\nprocedure wbPerkEPFTAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n i: Integer;\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n i := aNewValue;\n if (i < Ord(Low(wbPERKFunctionParams))) or (i> Ord(High(wbPERKFunctionParams))) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n Container.RemoveElement('EPFD');\n Container.RemoveElement('EPF2');\n Container.RemoveElement('EPF3');\n Container.RemoveElement('Embedded Script');\n case TPERKEntryPointFunctionParamType(i) of\n epfpFloat, epfpFloatFloat, epfpLeveledItem:\n Container.Add('EPFD', True);\n epfpScript: begin\n Container.Add('EPF2', True);\n Container.Add('EPF3', True);\n Container.Add('SCHR', True);\n end;\n end;\nend;\n\nprocedure wbRemoveOFST(const aElement: IwbElement);\nvar\n Container: IwbContainer;\n rOFST: IwbRecord;\nbegin\n if not wbRemoveOffsetData then\n Exit;\n\n if Supports(aElement, IwbContainer, Container) then begin\n if wbBeginInternalEdit then try\n Container.RemoveElement(OFST);\n finally\n wbEndInternalEdit;\n end else begin\n rOFST := Container.RecordBySignature[OFST];\n if Assigned(rOFST) then\n Container.RemoveElement(rOFST);\n end;\n end;\nend;\n\nfunction wbActorTemplateUseTraits(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000001) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseStats(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000002) <> 0;\n end;\nend;\n\nfunction wbActorAutoCalcDontShow(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Flags'];\n Result := (i and $00000010) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseStatsAutoCalc(const aElement: IwbElement): Boolean;\nbegin\n if not wbActorTemplateHide then\n Result := False\n else\n Result := wbActorTemplateUseStats(aElement) or wbActorAutoCalcDontShow(aElement);\nend;\n\nfunction wbActorTemplateUseFactions(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000004) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseActorEffectList(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000008) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseAIData(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000010) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseAIPackages(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000020) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseModelAnimation(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000040) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseBaseData(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000080) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseInventory(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000100) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseScript(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000200) <> 0;\n end;\nend;\n\nprocedure wbCTDAAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n //Size : Cardinal;\n TypeFlags : Cardinal;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n TypeFlags := Container.ElementNativeValues['Type'];\n if (TypeFlags and $02) <> 0 then begin\n if Container.DataSize = 20 then\n Container.DataSize := 28;\n Container.ElementNativeValues['Type'] := TypeFlags and not $02;\n Container.ElementEditValues['Run On'] := 'Target';\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMGEFAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n OldActorValue : Integer;\n NewActorValue : Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n OldActorValue := Container.ElementNativeValues['DATA - Data\\Actor Value'];\n NewActorValue := OldActorValue;\n case Integer(Container.ElementNativeValues['DATA - Data\\Archtype']) of\n 01, //Script\n 02, //Dispel\n 03, //Cure Disease\n 13, //Light\n 16, //Lock\n 17, //Open\n 18, //Bound Item\n 19, //Summon Creature\n 30, //Cure Paralysis\n 31, //Cure Addiction\n 32, //Cure Poison\n 33, //Concussion\n 35: //Limb Condition\n NewActorValue := -1;\n 11: //Invisibility\n NewActorValue := 48; //Invisibility\n 12: //Chameleon\n NewActorValue := 49; //Chameleon\n 24: //Paralysis\n NewActorValue := 47; //Paralysis\n 36: //Turbo\n NewActorValue := 51; //Turbo\n end;\n if OldActorValue <> NewActorValue then\n Container.ElementNativeValues['DATA - Data\\Actor Value'] := NewActorValue;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbPACKAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// OldContainer : IwbContainerElementRef;\n NewContainer : IwbContainerElementRef;\n// NewContainer2 : IwbContainerElementRef;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n case Integer(Container.ElementNativeValues['PKDT - General\\Type']) of\n 0: begin {Find}\n Container.Add('PTDT');\n end;\n 1: begin {Follow}\n Container.Add('PKFD');\n end;\n 2: begin {Escort}\n end;\n 3: begin {Eat}\n Container.Add('PTDT');\n Container.Add('PKED');\n end;\n 4: begin {Sleep}\n if not Container.ElementExists['Locations'] then\n if Supports(Container.Add('Locations'), IwbContainerElementRef, NewContainer) then\n NewContainer.ElementEditValues['PLDT - Location 1\\Type'] := 'Near editor location';\n end;\n 5: begin {Wander}\n end;\n 6: begin {Travel}\n end;\n 7: begin {Accompany}\n end;\n 8: begin {Use Item At}\n end;\n 9: begin {Ambush}\n end;\n 10: begin {Flee Not Combat}\n end;\n 12: begin {Sandbox}\n end;\n 13: begin {Patrol}\n if not Container.ElementExists['Locations'] then\n if Supports(Container.Add('Locations'), IwbContainerElementRef, NewContainer) then\n NewContainer.ElementEditValues['PLDT - Location 1\\Type'] := 'Near linked reference';\n Container.Add('PKPT');\n end;\n 14: begin {Guard}\n end;\n 15: begin {Dialogue}\n end;\n 16: begin {Use Weapon}\n end;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbNPCAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// BaseRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementNativeValues['NAM5'] > 255 then\n Container.ElementNativeValues['NAM5'] := 255;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbREFRAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n Container.RemoveElement('RCLR');\n\n if Container.ElementExists['Ammo'] then begin\n BaseRecord := MainRecord.BaseRecord;\n if Assigned(BaseRecord) and (BaseRecord.Signature <> 'WEAP') then\n Container.RemoveElement('Ammo');\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbINFOAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if (Integer(Container.ElementNativeValues['DATA\\Flags 1']) and $80) = 0 then\n Container.RemoveElement('DNAM');\n\n Container.RemoveElement('SNDD');\n\n if Container.ElementNativeValues['DATA\\Type'] = 3 {Persuasion} then\n Container.ElementNativeValues['DATA\\Type'] := 0 {Topic};\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbCELLAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n// Container2 : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// i : Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if (not Container.ElementExists['XCLW']) and ((Integer(Container.ElementNativeValues['DATA']) and $02) <> 0) then begin\n Container.Add('XCLW', True);\n Container.ElementEditValues['XCLW'] := 'Default';\n end;\n\n if (not Container.ElementExists['XNAM']) and ((Integer(Container.ElementNativeValues['DATA']) and $02) <> 0) then\n Container.Add('XNAM', True);\n\n// if Supports(Container.ElementBySignature[XCLR], IwbContainerElementRef, Container2) then begin\n// for i:= Pred(Container2.ElementCount) downto 0 do\n// if not Supports(Container2.Elements[i].LinksTo, IwbMainRecord, MainRecord) or (MainRecord.Signature <> 'REGN') then\n// Container2.RemoveElement(i);\n// if Container2.ElementCount < 1 then\n// Container2.Remove;\n// end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbEmbeddedScriptAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if Container.ElementEditValues['SCHR\\Type'] = 'Quest' then\n Container.ElementEditValues['SCHR\\Type'] := 'Object';\n finally\n wbEndInternalEdit;\n end;\nend;\n\n\nprocedure wbSOUNAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n OldCntr: IwbContainerElementRef;\n NewCntr: IwbContainerElementRef;\n NewCntr2: IwbContainerElementRef;\n i: Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementExists['SNDD'] then\n Exit;\n\n if not Supports(Container.RemoveElement('SNDX - Sound Data'), IwbContainerElementRef, OldCntr) then\n Exit;\n if not Supports(Container.Add('SNDD', True), IwbContainerElementRef, NewCntr) then\n Exit;\n for i := 0 to Pred(Min(OldCntr.ElementCount, NewCntr.ElementCount)) do\n NewCntr.Elements[i].Assign(Low(Integer), OldCntr.Elements[i], False);\n\n if not Supports(NewCntr.ElementByName['Attenuation Curve'], IwbContainerElementRef, NewCntr2) then\n Assert(False);\n Assert(NewCntr2.ElementCount = 5);\n\n if Supports(Container.RemoveElement('ANAM'), IwbContainerElementRef, OldCntr) then begin\n Assert(OldCntr.ElementCount = 5);\n for i := 0 to Pred(Min(OldCntr.ElementCount, NewCntr2.ElementCount)) do\n NewCntr2.Elements[i].Assign(Low(Integer), OldCntr.Elements[i], False);\n end else begin\n NewCntr2.Elements[0].NativeValue := 100;\n NewCntr2.Elements[1].NativeValue := 50;\n NewCntr2.Elements[2].NativeValue := 20;\n NewCntr2.Elements[3].NativeValue := 5;\n NewCntr2.Elements[4].NativeValue := 0;\n end;\n\n if not Supports(NewCntr.ElementByName['Reverb Attenuation Control'], IwbContainerElementRef, NewCntr2) then\n Assert(False);\n\n if Supports(Container.RemoveElement('GNAM'), IwbContainerElementRef, OldCntr) then\n NewCntr2.Assign(Low(Integer), OldCntr, False)\n else\n NewCntr2.NativeValue := 80;\n\n if not Supports(NewCntr.ElementByName['Priority'], IwbContainerElementRef, NewCntr2) then\n Assert(False);\n\n if Supports(Container.RemoveElement('HNAM'), IwbContainerElementRef, OldCntr) then\n NewCntr2.Assign(Low(Integer), OldCntr, False)\n else\n NewCntr2.NativeValue := 128;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbWATRAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// AnimationMultiplier : Extended;\n// AnimationAttackMultiplier : Extended;\n OldCntr: IwbContainerElementRef;\n NewCntr: IwbContainerElementRef;\n i: Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementExists['DNAM'] then\n Exit;\n\n if not Supports(Container.RemoveElement('DATA - Visual Data'), IwbContainerElementRef, OldCntr) then\n Exit;\n if not Supports(Container.Add('DNAM', True), IwbContainerElementRef, NewCntr) then\n Exit;\n for i := 0 to Pred(Min(OldCntr.ElementCount, NewCntr.ElementCount)) do\n if OldCntr.Elements[i].Name = 'Damage (Old Format)' then\n Container.ElementNativeValues['DATA - Damage'] := OldCntr.Elements[i].NativeValue\n else\n NewCntr.Elements[i].Assign(Low(Integer), OldCntr.Elements[i], False);\n\n NewCntr.ElementNativeValues['Noise Properties - Noise Layer One - Amplitude Scale'] := 1.0;\n NewCntr.ElementNativeValues['Noise Properties - Noise Layer Two - Amplitude Scale'] := 0.5;\n NewCntr.ElementNativeValues['Noise Properties - Noise Layer Three - Amplitude Scale'] := 0.25;\n finally\n wbEndInternalEdit;\n end;\nend;\n\n\nprocedure wbWEAPAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['DNAM'] then\n Exit;\n\n if Container.ElementNativeValues['DNAM\\Animation Multiplier'] = 0.0 then\n Container.ElementNativeValues['DNAM\\Animation Multiplier'] := 1.0;\n if Container.ElementNativeValues['DNAM\\Animation Attack Multiplier'] = 0.0 then\n Container.ElementNativeValues['DNAM\\Animation Attack Multiplier'] := 1.0;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMESGAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n IsMessageBox : Boolean;\n HasTimeDelay : Boolean;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n IsMessageBox := (Integer(Container.ElementNativeValues['DNAM']) and 1) = 1;\n HasTimeDelay := Container.ElementExists['TNAM'];\n\n if IsMessageBox = HasTimeDelay then\n if IsMessageBox then\n Container.RemoveElement('TNAM')\n else begin\n if not Container.ElementExists['DNAM'] then\n Container.Add('DNAM', True);\n Container.ElementNativeValues['DNAM'] := Integer(Container.ElementNativeValues['DNAM']) or 1;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\n\nprocedure wbEFSHAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n FullParticleBirthRatio : Extended;\n PersistantParticleBirthRatio : Extended;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['DATA'] then\n Exit;\n\n FullParticleBirthRatio := Container.ElementNativeValues['DATA\\Particle Shader - Full Particle Birth Ratio'];\n PersistantParticleBirthRatio := Container.ElementNativeValues['DATA\\Particle Shader - Persistant Particle Birth Ratio'];\n\n if ((FullParticleBirthRatio <> 0) and (FullParticleBirthRatio <= 1)) then begin\n FullParticleBirthRatio := FullParticleBirthRatio * 78.0;\n Container.ElementNativeValues['DATA\\Particle Shader - Full Particle Birth Ratio'] := FullParticleBirthRatio;\n end;\n\n if ((PersistantParticleBirthRatio <> 0) and (PersistantParticleBirthRatio <= 1)) then begin\n PersistantParticleBirthRatio := PersistantParticleBirthRatio * 78.0;\n Container.ElementNativeValues['DATA\\Particle Shader - Persistant Particle Birth Ratio'] := PersistantParticleBirthRatio;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbFACTAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Container.ElementExists['CNAM'] then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n Container.RemoveElement('CNAM');\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbLIGHAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['FNAM'] then begin\n Container.Add('FNAM', True);\n Container.ElementNativeValues['FNAM'] := 1.0;\n end;\n\n if Container.ElementExists['DATA'] then begin\n if SameValue(Container.ElementNativeValues['DATA\\Falloff Exponent'], 0.0) then\n Container.ElementNativeValues['DATA\\Falloff Exponent'] := 1.0;\n if SameValue(Container.ElementNativeValues['DATA\\FOV'], 0.0) then\n Container.ElementNativeValues['DATA\\FOV'] := 90.0;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbEFITAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n Element : IwbElement;\n ActorValue: Variant;\n MainRecord: IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n MainRecord := Container.ContainingMainRecord;\n if not Assigned(MainRecord) or MainRecord.IsDeleted then\n Exit;\n\n Element := Container.ElementByPath['..\\EFID'];\n if not Assigned(Element) then\n Exit;\n if not Supports(Element.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n if MainRecord.Signature <> 'MGEF' then\n Exit;\n ActorValue := MainRecord.ElementNativeValues['DATA - Data\\Actor Value'];\n if VarIsNull(ActorValue) or VarIsClear(ActorValue) then\n Exit;\n if VarCompareValue(ActorValue, Container.ElementNativeValues['Actor Value']) <> vrEqual then\n Container.ElementNativeValues['Actor Value'] := ActorValue;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbRPLDAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainer;\n a, b: Single;\n NeedsFlip: Boolean;\nbegin\n if wbBeginInternalEdit then try\n if Supports(aElement, IwbContainer, Container) then begin\n NeedsFlip := False;\n if Container.ElementCount > 1 then begin\n a := StrToFloat((Container.Elements[0] as IwbContainer).Elements[0].Value);\n b := StrToFloat((Container.Elements[Pred(Container.ElementCount)] as IwbContainer).Elements[0].Value);\n case CompareValue(a, b) of\n EqualsValue: begin\n a := StrToFloat((Container.Elements[0] as IwbContainer).Elements[1].Value);\n b := StrToFloat((Container.Elements[Pred(Container.ElementCount)] as IwbContainer).Elements[1].Value);\n NeedsFlip := CompareValue(a, b) = GreaterThanValue;\n end;\n GreaterThanValue:\n NeedsFlip := True;\n end;\n end;\n if NeedsFlip then\n Container.ReverseElements;\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbPxDTLocationDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n Result := Container.ElementByName['Type'].NativeValue;\nend;\n\nfunction wbPKDTFalloutBehaviorFlagsDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if Supports(Container, IwbSubRecord, SubRecord) then\n if SubRecord.SubRecordHeaderSize = 8 then\n Result := 1;\nend;\n\nfunction wbPKDTSpecificFlagsDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if Supports(Container, IwbSubRecord, SubRecord) then\n if SubRecord.SubRecordHeaderSize = 8 then\n Exit;\n Result := Container.ElementByName['Type'].NativeValue + 1;\nend;\n\nprocedure wbIDLAsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Container : IwbContainer;\n SelfAsContainer : IwbContainer;\nbegin\n if wbBeginInternalEdit then try\n// if not wbCounterAfterSet('IDLC - Animation Count', aElement) then\n if Supports(aElement.Container, IwbContainer, Container) then begin\n Element := Container.ElementByPath['IDLC\\Animation Count'];\n if Assigned(Element) and Supports(aElement, IwbContainer, SelfAsContainer) and\n (Element.GetNativeValue<>SelfAsContainer.GetElementCount) then\n Element.SetNativeValue(SelfAsContainer.GetElementCount);\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbAnimationsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Elems : IwbElement;\n Container : IwbContainer;\nbegin\n if wbBeginInternalEdit then try\n// if not wbCounterContainerAfterSet('IDLC - Animation Count', 'IDLA - Animations', aElement) then\n if Supports(aElement, IwbContainer, Container) then begin\n Element := Container.ElementByPath['IDLC\\Animation Count'];\n Elems := Container.ElementByName['IDLA - Animations'];\n if Assigned(Element) and not Assigned(Elems) then\n if Element.GetNativeValue<>0 then\n Element.SetNativeValue(0);\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbOffsetDataColsCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbDataContainer;\n Element : IwbElement;\n fResult : Extended;\nbegin\n Result := 0;\n\n if Supports(aElement.Container, IwbDataContainer, Container) and (Container.Name = 'OFST - Offset Data') and\n Supports(Container.Container, IwbDataContainer, Container) then begin\n Element := Container.ElementByPath['Object Bounds\\NAM0 - Min\\X'];\n if Assigned(Element) then begin\n fResult := Element.NativeValue;\n if fResult >= MaxInt then\n Result := 0\n else\n Result := Trunc(fResult);\n Element := Container.ElementByPath['Object Bounds\\NAM9 - Max\\X'];\n if Assigned(Element) then begin\n fResult := Element.NativeValue;\n if fResult >= MaxInt then\n Result := 1\n else\n Result := Trunc(fResult) - Result + 1;\n end;\n end;\n end;\nend;\n\nprocedure DefineFNVa;\nbegin\n wbRecordFlags := wbInteger('Record Flags', itU32, wbFlags([\n {0x00000001}'ESM',\n {0x00000002}'',\n {0x00000004}'', // Plugin selected (Editor)\n {0x00000008}'Form initialized (Runtime only)', // Form cannot be saved (Runtime)/Plugin active (Editor)\n {0x00000010}'', // Plugin cannot be active or selected (Editor)\n {0x00000020}'Deleted',\n {0x00000040}'Border Region / Has Tree LOD / Constant / Hidden From Local Map / Plugin Endian',\n {0x00000080}'Turn Off Fire',\n {0x00000100}'Inaccessible',\n {0x00000200}'Casts shadows / On Local Map / Motion Blur',\n {0x00000400}'Quest item / Persistent reference',\n {0x00000800}'Initially disabled',\n {0x00001000}'Ignored',\n {0x00002000}'No Voice Filter',\n {0x00004000}'Cannot Save (Runtime only)',\n {0x00008000}'Visible when distant',\n {0x00010000}'Random Anim Start / High Priority LOD',\n {0x00020000}'Dangerous / Off limits (Interior cell) / Radio Station (Talking Activator)',\n {0x00040000}'Compressed',\n {0x00080000}'Can''t wait / Platform Specific Texture / Dead',\n {0x00100000}'Unknown 21',\n {0x00200000}'Load Started (Runtime Only)', // set when beginning to load the form from save\n {0x00400000}'Unknown 23',\n {0x00800000}'Unknown 24', // Runtime might use it for \"Not dead\" on non actors.\n {0x01000000}'Destructible (Runtime only)',\n {0x02000000}'Obstacle / No AI Acquire',\n {0x03000000}'NavMesh Generation - Filter',\n {0x08000000}'NavMesh Generation - Bounding Box',\n {0x10000000}'Non-Pipboy / Reflected by Auto Water',\n {0x20000000}'Child Can Use / Refracted by Auto Water',\n {0x40000000}'NavMesh Generation - Ground',\n {0x80000000}'Multibound'\n ]));\n\n(* wbInteger('Record Flags 2', itU32, wbFlags([\n {0x00000001}'Unknown 1',\n {0x00000002}'Unknown 2',\n {0x00000004}'Unknown 3',\n {0x00000008}'Unknown 4',\n {0x00000010}'Unknown 5',\n {0x00000020}'Unknown 6',\n {0x00000040}'Unknown 7',\n {0x00000080}'Unknown 8',\n {0x00000100}'Unknown 9',\n {0x00000200}'Unknown 10',\n {0x00000400}'Unknown 11',\n {0x00000800}'Unknown 12',\n {0x00001000}'Unknown 13',\n {0x00002000}'Unknown 14',\n {0x00004000}'Unknown 15',\n {0x00008000}'Unknown 16',\n {0x00010000}'Unknown 17',\n {0x00020000}'Unknown 18',\n {0x00040000}'Unknown 19',\n {0x00080000}'Unknown 20',\n {0x00100000}'Unknown 21',\n {0x00200000}'Unknown 22',\n {0x00400000}'Unknown 23',\n {0x00800000}'Unknown 24',\n {0x01000000}'Unknown 25',\n {0x02000000}'Unknown 26',\n {0x03000000}'Unknown 27',\n {0x08000000}'Unknown 28',\n {0x10000000}'Unknown 29',\n {0x20000000}'Unknown 30',\n {0x40000000}'Unknown 31',\n {0x80000000}'Unknown 32'\n ])); (**)\n\n wbMainRecordHeader := wbStruct('Record Header', [\n wbString('Signature', 4, cpCritical),\n wbInteger('Data Size', itU32, nil, cpIgnore),\n wbRecordFlags,\n wbFormID('FormID', cpFormID),\n wbInteger('Version Control Master FormID', itU32, nil, cpIgnore),\n wbInteger('Form Version', itU16, nil, cpIgnore),\n wbInteger('Version Control Info 2', itU16, nil, cpIgnore) // limited to values from 0 to 0xF\n ]);\n\n wbSizeOfMainRecordStruct := 24;\n\n wbIgnoreRecords.Add(XXXX);\n\n wbXRGD := wbByteArray(XRGD, 'Ragdoll Data');\n wbXRGB := wbByteArray(XRGB, 'Ragdoll Biped Data');\n\n wbMusicEnum := wbEnum(['Default', 'Public', 'Dungeon']);\n wbSoundLevelEnum := wbEnum([\n 'Loud',\n 'Normal',\n 'Silent'\n ]);\n\n wbWeaponAnimTypeEnum := wbEnum([\n {00} 'Hand to Hand',\n {01} 'Melee (1 Hand)',\n {02} 'Melee (2 Hand)',\n {03} 'Pistol - Balistic (1 Hand)',\n {04} 'Pistol - Energy (1 Hand)',\n {05} 'Rifle - Balistic (2 Hand)',\n {06} 'Rifle - Automatic (2 Hand)',\n {07} 'Rifle - Energy (2 Hand)',\n {08} 'Handle (2 Hand)',\n {09} 'Launcher (2 Hand)',\n {10} 'Grenade Throw (1 Hand)',\n {11} 'Land Mine (1 Hand)',\n {12} 'Mine Drop (1 Hand)',\n {13} 'Thrown (1 Hand)'\n ]);\n\n wbReloadAnimEnum := wbEnum([\n 'ReloadA',\n 'ReloadB',\n 'ReloadC',\n 'ReloadD',\n 'ReloadE',\n 'ReloadF',\n 'ReloadG',\n 'ReloadH',\n 'ReloadI',\n 'ReloadJ',\n 'ReloadK',\n 'ReloadL',\n 'ReloadM',\n 'ReloadN',\n 'ReloadO',\n 'ReloadP',\n 'ReloadQ',\n 'ReloadR',\n 'ReloadS',\n// 'ReloadT',\n// 'ReloadU',\n// 'ReloadV',\n 'ReloadW',\n 'ReloadX',\n 'ReloadY',\n 'ReloadZ'\n ],[255, 'None']); // 255 seen in DLC, though Geck converts to 0\n\n wbEDID := wbString(EDID, 'Editor ID', 0, cpNormal); // not cpBenign according to Arthmoor\n wbEDIDReq := wbString(EDID, 'Editor ID', 0, cpNormal, True); // not cpBenign according to Arthmoor\n wbFULL := wbString(FULL, 'Name', 0, cpTranslate);\n wbFULLActor := wbString(FULL, 'Name', 0, cpTranslate, False, wbActorTemplateUseBaseData);\n wbFULLReq := wbString(FULL, 'Name', 0, cpNormal, True);\n wbDESC := wbString(DESC, 'Description', 0, cpTranslate);\n wbDESCReq := wbString(DESC, 'Description', 0, cpTranslate, True);\n wbXSCL := wbFloat(XSCL, 'Scale');\n wbOBND := wbStruct(OBND, 'Object Bounds', [\n wbInteger('X1', itS16),\n wbInteger('Y1', itS16),\n wbInteger('Z1', itS16),\n wbInteger('X2', itS16),\n wbInteger('Y2', itS16),\n wbInteger('Z2', itS16)\n ]);\n wbOBNDReq := wbStruct(OBND, 'Object Bounds', [\n wbInteger('X1', itS16),\n wbInteger('Y1', itS16),\n wbInteger('Z1', itS16),\n wbInteger('X2', itS16),\n wbInteger('Y2', itS16),\n wbInteger('Z2', itS16)\n ], cpNormal, True);\n wbREPL := wbFormIDCkNoReach(REPL, 'Repair List', [FLST]);\n wbEITM := wbFormIDCk(EITM, 'Object Effect', [ENCH, SPEL]);\n wbBIPL := wbFormIDCk(BIPL, 'Biped Model List', [FLST]);\n wbCOED := wbStructExSK(COED, [2], [0, 1], 'Extra Data', [\n {00} wbFormIDCkNoReach('Owner', [NPC_, FACT, NULL]),\n {04} wbUnion('Global Variable / Required Rank', wbCOEDOwnerDecider, [\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCk('Global Variable', [GLOB, NULL]),\n wbInteger('Required Rank', itS32)\n ]),\n {08} wbFloat('Item Condition')\n ]);\n\n wbYNAM := wbFormIDCk(YNAM, 'Sound - Pick Up', [SOUN]);\n wbZNAM := wbFormIDCk(ZNAM, 'Sound - Drop', [SOUN]);\n\n wbPosRot :=\n wbStruct('Position/Rotation', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ]);\n\n wbDATAPosRot :=\n wbStruct(DATA, 'Position/Rotation', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ], cpNormal, True);\n\n wbMODS :=\n wbArrayS(MODS, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n wbMO2S :=\n wbArrayS(MO2S, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n wbMO3S :=\n wbArrayS(MO3S, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n wbMO4S :=\n wbArrayS(MO4S, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n\n wbMODD :=\n wbInteger(MODD, 'FaceGen Model Flags', itU8, wbFlags([\n 'Head',\n 'Torso',\n 'Right Hand',\n 'Left Hand'\n ]));\n wbMOSD :=\n wbInteger(MOSD, 'FaceGen Model Flags', itU8, wbFlags([\n 'Head',\n 'Torso',\n 'Right Hand',\n 'Left Hand'\n ]));\n\n wbMODL :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODB, 'Unknown', 4, cpIgnore),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n// wbArray(MODT, 'Texture Files Hashes',\n// wbByteArray('Unknown', 24, cpBenign),\n// wbArray('Hashes', wbInteger('Hash', itU64, wbMODTCallback), 3),\n// 0, nil, nil, cpBenign),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, nil, True);\n\n wbMODLActor :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODB, 'Unknown', 4, cpIgnore),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n// wbArray(MODT, 'Texture Files Hashes',\n// wbByteArray('Unknown', 24, cpBenign),\n// wbArray('Hashes', wbInteger('Hash', itU64, wbMODTCallback), 3),\n// 0, nil, nil, cpBenign),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, wbActorTemplateUseModelAnimation, True);\n\n wbMODLReq :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODB, 'Unknown', 4, cpIgnore),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n// wbArray(MODT, 'Texture Files',\n// wbByteArray('Unknown', 24, cpBenign),\n// wbArray('Hashes', wbInteger('Hash', itU64, wbMODTCallback), 3),\n// 0, nil, nil, cpBenign),\n wbMODS,\n wbMODD\n ], [], cpNormal, True, nil, True);\n\n\n wbDEST := wbRStruct('Destructable', [\n wbStruct(DEST, 'Header', [\n wbInteger('Health', itS32),\n wbInteger('Count', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'VATS Targetable'\n ], True)),\n wbByteArray('Unused', 2)\n ]),\n wbRArray('Stages',\n wbRStruct('Stage', [\n wbStruct(DSTD, 'Destruction Stage Data', [\n wbInteger('Health %', itU8),\n wbInteger('Index', itU8),\n wbInteger('Damage Stage', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Cap Damage',\n 'Disable',\n 'Destroy'\n ])),\n wbInteger('Self Damage per Second', itS32),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Debris', [DEBR, NULL]),\n wbInteger('Debris Count', itS32)\n ], cpNormal, True),\n wbRStructSK([0], 'Model', [\n wbString(DMDL, 'Model Filename'),\n wbByteArray(DMDT, 'Texture Files Hashes', 0, cpIgnore)\n// wbArray(DMDT, 'Unknown',\n// wbByteArray('Unknown', 24, cpBenign),\n// 0, nil, nil, cpBenign)\n ], []),\n wbEmpty(DSTF, 'End Marker', cpNormal, True)\n ], [])\n )\n ], []);\n\n wbDESTActor := wbRStruct('Destructable', [\n wbStruct(DEST, 'Header', [\n wbInteger('Health', itS32),\n wbInteger('Count', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'VATS Targetable'\n ])),\n wbByteArray('Unused', 2)\n ]),\n wbRArray('Stages',\n wbRStruct('Stage', [\n wbStruct(DSTD, 'Destruction Stage Data', [\n wbInteger('Health %', itU8),\n wbInteger('Index', itU8),\n wbInteger('Damage Stage', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Cap Damage',\n 'Disable',\n 'Destroy'\n ])),\n wbInteger('Self Damage per Second', itS32),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Debris', [DEBR, NULL]),\n wbInteger('Debris Count', itS32)\n ], cpNormal, True),\n wbRStructSK([0], 'Model', [\n wbString(DMDL, 'Model Filename'),\n wbByteArray(DMDT, 'Texture Files Hashes', 0, cpIgnore)\n// wbArray(DMDT, 'Unknown',\n// wbByteArray('Unknown', 24, cpBenign),\n// 0, nil, nil, cpBenign)\n ], []),\n wbEmpty(DSTF, 'End Marker', cpNormal, True)\n ], [])\n )\n ], [], cpNormal, False, wbActorTemplateUseModelAnimation);\n\n wbSCRI := wbFormIDCk(SCRI, 'Script', [SCPT]);\n wbSCRIActor := wbFormIDCk(SCRI, 'Script', [SCPT], False, cpNormal, False, wbActorTemplateUseScript);\n wbENAM := wbFormIDCk(ENAM, 'Object Effect', [ENCH]);\n\n wbXLOD := wbArray(XLOD, 'Distant LOD Data', wbFloat('Unknown'), 3);\n\n wbXESP := wbStruct(XESP, 'Enable Parent', [\n wbFormIDCk('Reference', [PLYR, REFR, ACRE, ACHR, PGRE, PMIS, PBEA]),\n wbInteger('Flags', itU8, wbFlags([\n 'Set Enable State to Opposite of Parent',\n 'Pop In'\n ])),\n wbByteArray('Unused', 3)\n ]);\n\n wbSCHRReq := wbStruct(SCHR, 'Basic Script Data', [\n wbByteArray('Unused', 4),\n wbInteger('RefCount', itU32),\n wbInteger('CompiledSize', itU32),\n wbInteger('VariableCount', itU32),\n wbInteger('Type', itU16, wbEnum([\n 'Object',\n 'Quest'\n ], [\n $100, 'Effect'\n ])),\n wbInteger('Flags', itU16, wbFlags([\n 'Enabled'\n ]), cpNormal, False, nil, nil, 1)\n ], cpNormal, True);\n\n wbSCROs :=\n wbRArray('References',\n wbRUnion('', [\n wbFormID(SCRO, 'Global Reference'),\n// wbFormIDCk(SCRO, 'Global Reference',\n// [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, IMAD,\n// BOOK, KEYM, ALCH, LIGH, QUST, PLYR, PACK, LVLI, ECZN, EXPL, FLST, IDLM, PMIS,\n// FACT, ACHR, REFR, ACRE, GLOB, DIAL, CELL, SOUN, MGEF, WTHR, CLAS, EFSH, RACE,\n// LVLC, CSTY, WRLD, SCPT, IMGS, MESG, MSTT, MUSC, NOTE, PERK, PGRE, PROJ, LVLN,\n// WATR, ENCH, TREE, REPU, REGN, CSNO, CHAL, IMOD, RCCT, CMNY, CDCK, CHIP, CCRD,\n// TERM, HAIR, EYES, ADDN, RCPE, NULL]),\n wbInteger(SCRV, 'Local Variable', itU32)\n ], [])\n );\n\n wbSLSD := wbStructSK(SLSD, [0], 'Local Variable Data', [\n wbInteger('Index', itU32),\n wbByteArray('Unused', 12),\n wbInteger('Flags', itU8, wbFlags(['IsLongOrShort']), cpCritical),\n wbByteArray('Unused', 7)\n ]);\n\n wbEmbeddedScript := wbRStruct('Embedded Script', [\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Embedded Script', 0, cpNormal{, True}),\n wbStringScript(SCTX, 'Embedded Script Source', 0, cpNormal{, True}),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ], [], cpNormal, False, nil, False, wbEmbeddedScriptAfterLoad);\n\n wbEmbeddedScriptPerk := wbRStruct('Embedded Script', [\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Embedded Script', 0, cpNormal, True),\n wbStringScript(SCTX, 'Embedded Script Source', 0, cpNormal, True),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ], [], cpNormal, False, wbEPF2DontShow, False, wbEmbeddedScriptAfterLoad);\n\n wbEmbeddedScriptReq := wbRStruct('Embedded Script', [\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Embedded Script', 0, cpNormal{, True}),\n wbStringScript(SCTX, 'Embedded Script Source', 0, cpNormal{, True}),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ], [], cpNormal, True, nil, False, wbEmbeddedScriptAfterLoad);\n\n\n wbXLCM := wbInteger(XLCM, 'Level Modifier', itS32);\n\n wbRecord(ACHR, 'Placed NPC', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [NPC_], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n {--- Ragdoll ---}\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Merchant Container ----}\n wbFormIDCk(XMRC, 'Merchant Container', [REFR], True),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbString(XATO, 'Activation Prompt'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbXOWN := wbFormIDCkNoReach(XOWN, 'Owner', [FACT, ACHR, CREA, NPC_]); // Ghouls can own too aparently !\n wbXGLB := wbFormIDCk(XGLB, 'Global variable', [GLOB]);\n\n wbRecord(ACRE, 'Placed Creature', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [CREA], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Merchant Container ----}\n wbFormIDCk(XMRC, 'Merchant Container', [REFR], True),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbString(XATO, 'Activation Prompt'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(ACTI, 'Activator', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbSCRI,\n wbDEST,\n wbFormIDCk(SNAM, 'Sound - Looping', [SOUN]),\n wbFormIDCk(VNAM, 'Sound - Activation', [SOUN]),\n wbFormIDCk(INAM, 'Radio Template', [SOUN]),\n wbFormIDCk(RNAM, 'Radio Station', [TACT]),\n wbFormIDCk(WNAM, 'Water Type', [WATR]),\n wbString(XATO, 'Activation Prompt')\n ]);\n\n wbICON := wbRStruct('Icon', [\n wbString(ICON, 'Large Icon filename', 0, cpNormal, True),\n wbString(MICO, 'Small Icon filename')\n ], [], cpNormal, False, nil, True);\n\n wbICONReq := wbRStruct('Icon', [\n wbString(ICON, 'Large Icon filename', 0, cpNormal, True),\n wbString(MICO, 'Small Icon filename')\n ], [], cpNormal, True, nil, True);\n\n wbVatsValueFunctionEnum :=\n wbEnum([\n 'Weapon Is',\n 'Weapon In List',\n 'Target Is',\n 'Target In List',\n 'Target Distance',\n 'Target Part',\n 'VATS Action',\n 'Is Success',\n 'Is Critical',\n 'Critical Effect Is',\n 'Critical Effect In List',\n 'Is Fatal',\n 'Explode Part',\n 'Dismember Part',\n 'Cripple Part',\n 'Weapon Type Is',\n 'Is Stranger',\n 'Is Paralyzing Palm'\n ]);\n\n wbActorValueEnum :=\n wbEnum([\n {00} 'Aggresion',\n {01} 'Confidence',\n {02} 'Energy',\n {03} 'Responsibility',\n {04} 'Mood',\n {05} 'Strength',\n {06} 'Perception',\n {07} 'Endurance',\n {08} 'Charisma',\n {09} 'Intelligence',\n {10} 'Agility',\n {11} 'Luck',\n {12} 'Action Points',\n {13} 'Carry Weight',\n {14} 'Critical Chance',\n {15} 'Heal Rate',\n {16} 'Health',\n {17} 'Melee Damage',\n {18} 'Damage Resistance',\n {19} 'Poison Resistance',\n {20} 'Rad Resistance',\n {21} 'Speed Multiplier',\n {22} 'Fatigue',\n {23} 'Karma',\n {24} 'XP',\n {25} 'Perception Condition',\n {26} 'Endurance Condition',\n {27} 'Left Attack Condition',\n {28} 'Right Attack Condition',\n {29} 'Left Mobility Condition',\n {30} 'Right Mobility Condition',\n {31} 'Brain Condition',\n {32} 'Barter',\n {33} 'Big Guns (obsolete)',\n {34} 'Energy Weapons',\n {35} 'Explosives',\n {36} 'Lockpick',\n {37} 'Medicine',\n {38} 'Melee Weapons',\n {39} 'Repair',\n {40} 'Science',\n {41} 'Guns',\n {42} 'Sneak',\n {43} 'Speech',\n {44} 'Survival',\n {45} 'Unarmed',\n {46} 'Inventory Weight',\n {47} 'Paralysis',\n {48} 'Invisibility',\n {49} 'Chameleon',\n {50} 'Night Eye',\n {51} 'Turbo',\n {52} 'Fire Resistance',\n {53} 'Water Breathing',\n {54} 'Rad Level',\n {55} 'Bloody Mess',\n {56} 'Unarmed Damage',\n {57} 'Assistance',\n {58} 'Electric Resistance',\n {59} 'Frost Resistance',\n {60} 'Energy Resistance',\n {61} 'EMP Resistance',\n {62} 'Variable01',\n {63} 'Variable02',\n {64} 'Variable03',\n {65} 'Variable04',\n {66} 'Variable05',\n {67} 'Variable06',\n {68} 'Variable07',\n {79} 'Variable08',\n {70} 'Variable09',\n {71} 'Variable10',\n {72} 'Ignore Crippled Limbs',\n {73} 'Dehydration',\n {74} 'Hunger',\n {75} 'Sleep Deprivation',\n {76} 'Damage Threshold'\n ], [\n -1, 'None'\n ]);\n\n wbModEffectEnum :=\n wbEnum([\n {00} 'None',\n {01} 'Increase Weapon Damage',\n {02} 'Increase Clip Capacity',\n {03} 'Decrease Spread',\n {04} 'Decrease Weight',\n {05} 'Regenerate Ammo (shots)',\n {06} 'Regenerate Ammo (seconds)',\n {07} 'Decrease Equip Time',\n {08} 'Increase Rate of Fire',\n {09} 'Increase Projectile Speed',\n {10} 'Increase Max. Condition',\n {11} 'Silence',\n {12} 'Split Beam',\n {13} 'VATS Bonus',\n {14} 'Increase Zoom',\n {15} 'Decrease Equip Time',\n {16} 'Suppressor'\n ]);\n\n wbSkillEnum :=\n wbEnum([\n 'Barter',\n 'Big Guns (obsolete)',\n 'Energy Weapons',\n 'Explosives',\n 'Lockpick',\n 'Medicine',\n 'Melee Weapons',\n 'Repair',\n 'Science',\n 'Guns',\n 'Sneak',\n 'Speech',\n 'Survival',\n 'Unarmed'\n ], [\n -1, 'None'\n ]);\n\n wbCrimeTypeEnum :=\n wbEnum([\n 'Steal',\n 'Pickpocket',\n 'Trespass',\n 'Attack',\n 'Murder'\n ], [\n -1, 'None'\n ]);\n\n wbActorValue := wbInteger('Actor Value', itS32, wbActorValueEnum);\n\n wbEquipTypeEnum :=\n wbEnum([\n {00} 'Big Guns',\n {01} 'Energy Weapons',\n {02} 'Small Guns',\n {03} 'Melee Weapons',\n {04} 'Unarmed Weapon',\n {05} 'Thrown Weapons',\n {06} 'Mine',\n {07} 'Body Wear',\n {08} 'Head Wear',\n {09} 'Hand Wear',\n {10} 'Chems',\n {11} 'Stimpack',\n {12} 'Food',\n {13} 'Alcohol'\n ], [\n -1, 'None'\n ]);\n\n wbETYP := wbInteger(ETYP, 'Equiptment Type', itS32, wbEquipTypeEnum);\n wbETYPReq := wbInteger(ETYP, 'Equiptment Type', itS32, wbEquipTypeEnum, cpNormal, True);\n\n wbFormTypeEnum :=\n wbEnum([], [\n $04, 'Texture Set',\n $05, 'Menu Icon',\n $06, 'Global',\n $07, 'Class',\n $08, 'Faction',\n $09, 'Head Part',\n $0A, 'Hair',\n $0B, 'Eyes',\n $0C, 'Race',\n $0D, 'Sound',\n $0E, 'Acoustic Space',\n $0F, 'Skill',\n $10, 'Base Effect',\n $11, 'Script',\n $12, 'Landscape Texture',\n $13, 'Object Effect',\n $14, 'Actor Effect',\n $15, 'Activator',\n $16, 'Talking Activator',\n $17, 'Terminal',\n $18, 'Armor',\n $19, 'Book',\n $1A, 'Clothing',\n $1B, 'Container',\n $1C, 'Door',\n $1D, 'Ingredient',\n $1E, 'Light',\n $1F, 'Misc',\n $20, 'Static',\n $21, 'Static Collection',\n $22, 'Movable Static',\n $23, 'Placeable Water',\n $24, 'Grass',\n $25, 'Tree',\n $26, 'Flora',\n $27, 'Furniture',\n $28, 'Weapon',\n $29, 'Ammo',\n $2A, 'NPC',\n $2B, 'Creature',\n $2C, 'Leveled Creature',\n $2D, 'Leveled NPC',\n $2E, 'Key',\n $2F, 'Ingestible',\n $30, 'Idle Marker',\n $31, 'Note',\n $32, 'Constructible Object',\n $33, 'Projectile',\n $34, 'Leveled Item',\n $35, 'Weather',\n $36, 'Climate',\n $37, 'Region',\n $39, 'Cell',\n $3A, 'Placed Object',\n $3B, 'Placed Character',\n $3C, 'Placed Creature',\n $3E, 'Placed Grenade',\n $41, 'Worldspace',\n $42, 'Landscape',\n $43, 'Navigation Mesh',\n $45, 'Dialog Topic',\n $46, 'Dialog Response',\n $47, 'Quest',\n $48, 'Idle Animation',\n $49, 'Package',\n $4A, 'Combat Style',\n $4B, 'Load Screen',\n $4C, 'Leveled Spell',\n $4D, 'Animated Object',\n $4E, 'Water',\n $4F, 'Effect Shader',\n $51, 'Explosion',\n $52, 'Debris',\n $53, 'Image Space',\n $54, 'Image Space Modifier',\n $55, 'FormID List',\n $56, 'Perk',\n $57, 'Body Part Data',\n $58, 'Addon Node',\n $59, 'Actor Value Info',\n $5A, 'Radiation Stage',\n $5B, 'Camera Shot',\n $5C, 'Camera Path',\n $5D, 'Voice Type',\n $5E, 'Impact Data',\n $5F, 'Impact DataSet',\n $60, 'Armor Addon',\n $61, 'Encounter Zone',\n $62, 'Message',\n $63, 'Ragdoll',\n $64, 'Default Object Manager',\n $65, 'Lighting Template',\n $66, 'Music Type',\n $67, 'Item Mod',\n $68, 'Reputation',\n $69, '?PCBE', //no such records in FalloutNV.esm\n $6A, 'Recipe',\n $6B, 'Recipe Category',\n $6C, 'Casino Chip',\n $6D, 'Casino',\n $6E, 'Load Screen Type',\n $6F, 'Media Set',\n $70, 'Media Location Controller',\n $71, 'Challenge',\n $72, 'Ammo Effect',\n $73, 'Caravan Card',\n $74, 'Caravan Money',\n $75, 'Caravan Deck',\n $76, 'Dehydration Stages',\n $77, 'Hunger Stages',\n $78, 'Sleep Deprivation Stages'\n ]);\n\n wbMenuModeEnum :=\n wbEnum([],[\n 1, 'Type: Character Interface',\n 2, 'Type: Other',\n 3, 'Type: Console',\n 1001, 'Specific: Message',\n 1002, 'Specific: Inventory',\n 1003, 'Specific: Stats',\n 1004, 'Specific: HUDMainMenu',\n 1007, 'Specific: Loading',\n 1008, 'Specific: Container',\n 1009, 'Specific: Dialog',\n 1012, 'Specific: Sleep/Wait',\n 1013, 'Specific: Pause',\n 1014, 'Specific: LockPick',\n 1016, 'Specific: Quantity',\n 1027, 'Specific: Level Up',\n 1035, 'Specific: Pipboy Repair',\n 1036, 'Specific: Race / Sex',\n 1047, 'Specific: Credits',\n 1048, 'Specific: CharGen',\n 1051, 'Specific: TextEdit',\n 1053, 'Specific: Barter',\n 1054, 'Specific: Surgery',\n 1055, 'Specific: Hacking',\n 1056, 'Specific: VATS',\n 1057, 'Specific: Computers',\n 1058, 'Specific: Vendor Repair',\n 1059, 'Specific: Tutorial',\n 1060, 'Specific: You''re SPECIAL book'\n ]);\nend;\n\nprocedure DefineFNVb;\nbegin\n wbMiscStatEnum :=\n wbEnum([\n 'Quests Completed',\n 'Locations Discovered',\n 'People Killed',\n 'Creatures Killed',\n 'Locks Picked',\n 'Computers Hacked',\n 'Stimpaks Taken',\n 'Rad-X Taken',\n 'RadAway Taken',\n 'Chems Taken',\n 'Times Addicted',\n 'Mines Disarmed',\n 'Speech Successes',\n 'Pockets Picked',\n 'Pants Exploded',\n 'Books Read',\n 'Bobbleheads Found',\n 'Weapons Created',\n 'People Mezzed',\n 'Captives Rescued',\n 'Sandman Kills',\n 'Paralyzing Punches',\n 'Robots Disabled',\n 'Contracts Completed',\n 'Corpses Eaten',\n 'Mysterious Stranger Visits',\n 'Doctor Bags Used',\n 'Challenges Completed',\n 'Miss Fortunate Occurrences',\n 'Disintegrations',\n 'Have Limbs Crippled',\n 'Speech Failures',\n 'Items Crafted',\n 'Weapon Modifications',\n 'Items Repaired',\n 'Total Things Killed',\n 'Dismembered Limbs',\n 'Caravan Games Won',\n 'Caravan Games Lost',\n 'Barter Amount Traded',\n 'Roulette Games Played',\n 'Blackjack Games Played',\n 'Slots Games Played'\n ]);\n\n wbAlignmentEnum :=\n wbEnum([\n 'Good',\n 'Neutral',\n 'Evil',\n 'Very Good',\n 'Very Evil'\n ]);\n\n wbAxisEnum :=\n wbEnum([], [\n 88, 'X',\n 89, 'Y',\n 90, 'Z'\n ]);\n\n wbCriticalStageEnum :=\n wbEnum([\n 'None',\n 'Goo Start',\n 'Goo End',\n 'Disintegrate Start',\n 'Disintegrate End'\n ]);\n\n wbSexEnum :=\n wbEnum(['Male','Female']);\n\n wbCreatureTypeEnum :=\n wbEnum([\n 'Animal',\n 'Mutated Animal',\n 'Mutated Insect',\n 'Abomination',\n 'Super Mutant',\n 'Feral Ghoul',\n 'Robot',\n 'Giant'\n ]);\n\n wbPlayerActionEnum :=\n wbEnum([\n '',\n 'Swinging Melee Weapon',\n 'Throwing Grenade',\n 'Fire Weapon',\n 'Lay Mine',\n 'Z Key Object',\n 'Jumping',\n 'Knocking over Objects',\n 'Stand on Table/Chair',\n 'Iron Sites',\n 'Destroying Object'\n ]);\n\n wbBodyLocationEnum :=\n wbEnum([\n 'Torso',\n 'Head 1',\n 'Head 2',\n 'Left Arm 1',\n 'Left Arm 2',\n 'Right Arm 1',\n 'Right Arm 2',\n 'Left Leg 1',\n 'Left Leg 2',\n 'Left Leg 3',\n 'Right Leg 1',\n 'Right Leg 2',\n 'Right Leg 3',\n 'Brain'\n ], [\n -1, 'None'\n ]);\n\n\n wbEFID := wbFormIDCk(EFID, 'Base Effect', [MGEF]);\n\n wbEFIT :=\n wbStructSK(EFIT, [3, 4], '', [\n wbInteger('Magnitude', itU32),\n wbInteger('Area', itU32),\n wbInteger('Duration', itU32),\n wbInteger('Type', itU32, wbEnum(['Self', 'Touch', 'Target'])),\n wbActorValue\n ], cpNormal, True, nil, -1, wbEFITAfterLoad);\n\n wbCTDA :=\n wbStruct(CTDA, 'Condition', [\n wbInteger('Type', itU8, wbCtdaTypeToStr, wbCtdaTypeToInt, cpNormal, False, nil, wbCtdaTypeAfterSet),\n wbByteArray('Unused', 3),\n wbUnion('Comparison Value', wbCTDACompValueDecider, [\n wbFloat('Comparison Value - Float'),\n wbFormIDCk('Comparison Value - Global', [GLOB])\n ]),\n wbInteger('Function', itU32, wbCTDAFunctionToStr, wbCTDAFunctionToInt), // Limited to itu16\n wbUnion('Parameter #1', wbCTDAParam1Decider, [\n {00} wbByteArray('Unknown', 4),\n {01} wbByteArray('None', 4, cpIgnore),\n {02} wbInteger('Integer', itS32),\n {03} wbInteger('Variable Name (INVALID)', itS32),\n {04} wbInteger('Sex', itU32, wbSexEnum),\n {05} wbInteger('Actor Value', itS32, wbActorValueEnum),\n {06} wbInteger('Crime Type', itU32, wbCrimeTypeEnum),\n {07} wbInteger('Axis', itU32, wbAxisEnum),\n {08} wbInteger('Quest Stage (INVALID)', itS32),\n {09} wbInteger('Misc Stat', itU32, wbMiscStatEnum),\n {10} wbInteger('Alignment', itU32, wbAlignmentEnum),\n {11} wbInteger('Equip Type', itU32, wbEquipTypeEnum),\n {12} wbInteger('Form Type', itU32, wbFormTypeEnum),\n {13} wbInteger('Critical Stage', itU32, wbCriticalStageEnum),\n {14} wbFormIDCkNoReach('Object Reference', [PLYR, REFR, ACHR, ACRE, PGRE, PMIS, PBEA, TRGT], True),\n {16} wbFormIDCkNoReach('Inventory Object', [ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, FLST, CHIP, CMNY, IMOD]),\n {17} wbFormIDCkNoReach('Actor', [PLYR, ACHR, ACRE, TRGT], True),\n {18} wbFormIDCkNoReach('Voice Type', [VTYP]),\n {19} wbFormIDCkNoReach('Idle', [IDLE]),\n {20} wbFormIDCkNoReach('Form List', [FLST]),\n {21} wbFormIDCkNoReach('Note', [NOTE]),\n {22} wbFormIDCkNoReach('Quest', [QUST]),\n {23} wbFormIDCkNoReach('Faction', [FACT]),\n {24} wbFormIDCkNoReach('Weapon', [WEAP]),\n {25} wbFormIDCkNoReach('Cell', [CELL]),\n {26} wbFormIDCkNoReach('Class', [CLAS]),\n {27} wbFormIDCkNoReach('Race', [RACE]),\n {28} wbFormIDCkNoReach('Actor Base', [NPC_, CREA, ACTI, TACT, NULL]),\n {29} wbFormIDCkNoReach('Global', [GLOB]),\n {30} wbFormIDCkNoReach('Weather', [WTHR]),\n {31} wbFormIDCkNoReach('Package', [PACK]),\n {32} wbFormIDCkNoReach('Encounter Zone', [ECZN]),\n {33} wbFormIDCkNoReach('Perk', [PERK]),\n {34} wbFormIDCkNoReach('Owner', [FACT, NPC_]),\n {35} wbFormIDCkNoReach('Furniture', [FURN, FLST]),\n {36} wbFormIDCkNoReach('Effect Item', [SPEL, ENCH, ALCH, INGR]),\n {37} wbFormIDCkNoReach('Base Effect', [MGEF]),\n {38} wbFormIDCkNoReach('Worldspace', [WRLD]),\n {39} wbInteger('VATS Value Function', itU32, wbVATSValueFunctionEnum),\n {40} wbInteger('VATS Value Param (INVALID)', itU32),\n {41} wbInteger('Creature Type', itU32, wbCreatureTypeEnum),\n {42} wbInteger('Menu Mode', itU32, wbMenuModeEnum),\n {43} wbInteger('Player Action', itU32, wbPlayerActionEnum),\n {44} wbInteger('Body Location', itS32, wbBodyLocationEnum),\n {45} wbFormIDCkNoReach('Referenceable Object', [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, FLST, CHIP, CMNY, CCRD, IMOD, LVLC, LVLN],\n [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, CHIP, CMNY, CCRD, IMOD, LVLC, LVLN]),\n {46} wbInteger('Quest Objective (INVALID)', itS32),\n {47} wbFormIDCkNoReach('Reputation', [REPU]),\n {48} wbFormIDCkNoReach('Region', [REGN]),\n {49} wbFormIDCkNoReach('Challenge', [CHAL]),\n {50} wbFormIDCkNoReach('Casino', [CSNO]),\n {51} wbFormID('Form')\n ]),\n wbUnion('Parameter #2', wbCTDAParam2Decider, [\n {00} wbByteArray('Unknown', 4),\n {01} wbByteArray('None', 4, cpIgnore),\n {02} wbInteger('Integer', itS32),\n {03} wbInteger('Variable Name', itS32, wbCTDAParam2VariableNameToStr, wbCTDAParam2VariableNameToInt),\n {04} wbInteger('Sex', itU32, wbSexEnum),\n {05} wbInteger('Actor Value', itS32, wbActorValueEnum),\n {06} wbInteger('Crime Type', itU32, wbCrimeTypeEnum),\n {07} wbInteger('Axis', itU32, wbAxisEnum),\n {08} wbInteger('Quest Stage', itS32, wbCTDAParam2QuestStageToStr, wbCTDAParam2QuestStageToInt),\n {09} wbInteger('Misc Stat', itU32, wbMiscStatEnum),\n {10} wbInteger('Alignment', itU32, wbAlignmentEnum),\n {11} wbInteger('Equip Type', itU32, wbEquipTypeEnum),\n {12} wbInteger('Form Type', itU32, wbFormTypeEnum),\n {13} wbInteger('Critical Stage', itU32, wbCriticalStageEnum),\n {14} wbFormIDCkNoReach('Object Reference', [PLYR, REFR, PMIS, PBEA, ACHR, ACRE, PGRE, TRGT], True),\n {16} wbFormIDCkNoReach('Inventory Object', [ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, FLST, CHIP, CMNY, CCRD, IMOD]),\n {17} wbFormIDCkNoReach('Actor', [PLYR, ACHR, ACRE, TRGT], True),\n {18} wbFormIDCkNoReach('Voice Type', [VTYP]),\n {19} wbFormIDCkNoReach('Idle', [IDLE]),\n {20} wbFormIDCkNoReach('Form List', [FLST]),\n {21} wbFormIDCkNoReach('Note', [NOTE]),\n {22} wbFormIDCkNoReach('Quest', [QUST]),\n {23} wbFormIDCkNoReach('Faction', [FACT]),\n {24} wbFormIDCkNoReach('Weapon', [WEAP]),\n {25} wbFormIDCkNoReach('Cell', [CELL]),\n {26} wbFormIDCkNoReach('Class', [CLAS]),\n {27} wbFormIDCkNoReach('Race', [RACE]),\n {28} wbFormIDCkNoReach('Actor Base', [NPC_, CREA, ACTI, TACT]),\n {29} wbFormIDCkNoReach('Global', [GLOB]),\n {30} wbFormIDCkNoReach('Weather', [WTHR]),\n {31} wbFormIDCkNoReach('Package', [PACK]),\n {32} wbFormIDCkNoReach('Encounter Zone', [ECZN]),\n {33} wbFormIDCkNoReach('Perk', [PERK]),\n {34} wbFormIDCkNoReach('Owner', [FACT, NPC_]),\n {35} wbFormIDCkNoReach('Furniture', [FURN, FLST]),\n {36} wbFormIDCkNoReach('Effect Item', [SPEL, ENCH, ALCH, INGR]),\n {37} wbFormIDCkNoReach('Base Effect', [MGEF]),\n {38} wbFormIDCkNoReach('Worldspace', [WRLD]),\n {39} wbInteger('VATS Value Function (INVALID)', itU32),\n {40} wbUnion('VATS Value Param', wbCTDAParam2VATSValueParam, [\n wbFormIDCkNoReach('Weapon', [WEAP]),\n wbFormIDCkNoReach('Weapon List', [FLST], [WEAP]),\n wbFormIDCkNoReach('Target', [NPC_, CREA]),\n wbFormIDCkNoReach('Target List', [FLST], [NPC_, CREA]),\n wbByteArray('Unused', 4, cpIgnore),\n wbInteger('Target Part', itS32, wbActorValueEnum),\n wbInteger('VATS Action', itU32, wbEnum([\n 'Unarmed Attack',\n 'One Hand Melee Attack',\n 'Two Hand Melee Attack',\n 'Fire Pistol',\n 'Fire Rifle',\n 'Fire Handle Weapon',\n 'Fire Launcher',\n 'Throw Grenade',\n 'Place Mine',\n 'Reload',\n 'Crouch',\n 'Stand',\n 'Switch Weapon',\n 'Toggle Weapon Drawn',\n 'Heal',\n 'Player Death',\n 'Special Weapon Attack',\n 'Special Unarmed Attack',\n 'Kill Camera Shot',\n 'Throw Weapon'\n ])),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Critical Effect', [SPEL]),\n wbFormIDCkNoReach('Critical Effect List', [FLST], [SPEL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbInteger('Weapon Type', itU32, wbWeaponAnimTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n {41} wbInteger('Creature Type', itU32, wbCreatureTypeEnum),\n {42} wbInteger('Menu Mode', itU32, wbMenuModeEnum),\n {43} wbInteger('Player Action', itU32, wbPlayerActionEnum),\n {44} wbInteger('Body Location', itS32, wbBodyLocationEnum),\n {45} wbFormIDCkNoReach('Referenceable Object', [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, FLST, CHIP, CMNY, CCRD, IMOD, LVLC, LVLN],\n [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, CHIP, CMNY, CCRD, IMOD, LVLC, LVLN]),\n {46} wbInteger('Quest Objective', itS32, wbCTDAParam2QuestObjectiveToStr, wbCTDAParam2QuestObjectiveToInt),\n {47} wbFormIDCkNoReach('Reputation', [REPU]),\n {48} wbFormIDCkNoReach('Region', [REGN]),\n {49} wbFormIDCkNoReach('Challenge', [CHAL]),\n {50} wbFormIDCkNoReach('Casino', [CSNO]),\n {51} wbFormID('Form')\n ]),\n wbInteger('Run On', itU32, wbEnum([\n 'Subject',\n 'Target',\n 'Reference',\n 'Combat Target',\n 'Linked Reference'\n ]), cpNormal, False, nil, wbCTDARunOnAfterSet),\n wbUnion('Reference', wbCTDAReferenceDecider, [\n wbInteger('Unused', itU32, nil, cpIgnore),\n wbFormIDCkNoReach('Reference', [PLYR, ACHR, ACRE, REFR, PMIS, PBEA, PGRE, NULL], True) // Can end up NULL if the original function requiring a reference is replaced by another who has no Run on prerequisite\n ])\n ], cpNormal, False, nil, 6, wbCTDAAfterLoad);\n wbCTDAs := wbRArray('Conditions', wbCTDA);\n wbCTDAsReq := wbRArray('Conditions', wbCTDA, cpNormal, True);\n\n wbEffects :=\n wbRStructs('Effects','Effect', [\n wbEFID,\n wbEFIT,\n wbCTDAs\n ], []);\n\n wbEffectsReq :=\n wbRStructs('Effects','Effect', [\n wbEFID,\n wbEFIT,\n wbCTDAs\n ], [], cpNormal, True);\n\n\n wbRecord(ALCH, 'Ingestible', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLReq,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbETYPReq,\n wbFloat(DATA, 'Weight', cpNormal, True),\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Value', itS32),\n wbInteger('Flags?', itU8, wbFlags([\n 'No Auto-Calc (Unused)',\n 'Food Item',\n 'Medicine'\n ])),\n wbByteArray('Unused', 3),\n wbFormIDCk('Withdrawal Effect', [SPEL, NULL]),\n wbFloat('Addiction Chance'),\n wbFormIDCk('Sound - Consume', [SOUN, NULL])\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(AMMO, 'Ammunition', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLReq,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbFloat('Speed'),\n wbInteger('Flags', itU8, wbFlags([\n 'Ignores Normal Weapon Resistance',\n 'Non-Playable'\n ])),\n wbByteArray('Unused', 3),\n wbInteger('Value', itS32),\n wbInteger('Clip Rounds', itU8)\n ], cpNormal, True),\n wbStruct(DAT2, 'Data 2', [\n wbInteger('Proj. per Shot', itU32),\n wbFormIDCk('Projectile', [PROJ, NULL]),\n wbFloat('Weight'),\n wbFormIDCk('Consumed Ammo', [AMMO, MISC, NULL]),\n wbFloat('Consumed Percentage')\n ], cpNormal, False, nil, 3),\n wbString(ONAM, 'Short Name'),\n wbString(QNAM, 'Abbrev.'),\n wbRArray('Ammo Effects',\n wbFormIDCk(RCIL, 'Effect', [AMEF])\n )\n ]);\n\n wbRecord(ANIO, 'Animated Object', [\n wbEDIDReq,\n wbMODLReq,\n wbFormIDCk(DATA, 'Animation', [IDLE], False, cpNormal, True)\n ]);\n\n wbBMDT := wbStruct(BMDT, 'Biped Data', [\n wbInteger('Biped Flags', itU32, wbFlags([\n {0x00000001} 'Head',\n {0x00000002} 'Hair',\n {0x00000004} 'Upper Body',\n {0x00000008} 'Left Hand',\n {0x00000010} 'Right Hand',\n {0x00000020} 'Weapon',\n {0x00000040} 'PipBoy',\n {0x00000080} 'Backpack',\n {0x00000100} 'Necklace',\n {0x00000200} 'Headband',\n {0x00000400} 'Hat',\n {0x00000800} 'Eye Glasses',\n {0x00001000} 'Nose Ring',\n {0x00002000} 'Earrings',\n {0x00004000} 'Mask',\n {0x00008000} 'Choker',\n {0x00010000} 'Mouth Object',\n {0x00020000} 'Body AddOn 1',\n {0x00040000} 'Body AddOn 2',\n {0x00080000} 'Body AddOn 3'\n ])),\n wbInteger('General Flags', itU8, wbFlags([\n {0x0001} '1',\n {0x0002} '2',\n {0x0004} 'Has Backpack',\n {0x0008} 'Medium',\n {0x0010} '5',\n {0x0020} 'Power Armor',\n {0x0040} 'Non-Playable',\n {0x0080} 'Heavy'\n ], True)),\n wbByteArray('Unused')\n ], cpNormal, True);\n\n wbRecord(ARMO, 'Armor', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbSCRI,\n wbEITM,\n wbBMDT,\n wbRStruct('Male biped model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Male world model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO2S\n ], []),\n wbString(ICON, 'Male icon filename'),\n wbString(MICO, 'Male mico filename'),\n wbRStruct('Female biped model', [\n wbString(MOD3, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO3S,\n wbMOSD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Female world model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO4S\n ], []),\n wbString(ICO2, 'Female icon filename'),\n wbString(MIC2, 'Female mico filename'),\n wbString(BMCT, 'Ragdoll Constraint Template'),\n wbREPL,\n wbBIPL,\n wbETYPReq,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itS32),\n wbInteger('Health', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n wbInteger('AR', itS16, wbDiv(100)),\n wbInteger('Flags', itU16, wbFlags([\n 'Modulates Voice'\n ])),\n wbFloat('DT'),\n wbByteArray('?', 4)\n ], cpNormal, True, nil, 2),\n wbInteger(BNAM, 'Overrides Animation Sounds', itU32, wbEnum(['No', 'Yes'])),\n wbRArray('Animation Sounds',\n wbStruct(SNAM, 'Animation Sound', [\n wbFormIDCk('Sound', [SOUN]),\n wbInteger('Chance', itU8),\n wbByteArray('Unused', 3),\n wbInteger('Type', itU32, wbEnum([], [\n 19, 'Run',\n 21, 'Run (Armor)',\n 18, 'Sneak',\n 20, 'Sneak (Armor)',\n 17, 'Walk',\n 22, 'Walk (Armor)'\n ]))\n ])\n ),\n wbFormIDCk(TNAM, 'Animation Sounds Template', [ARMO])\n ]);\n\n wbRecord(ARMA, 'Armor Addon', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbBMDT,\n wbRStruct('Male biped model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Male world model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO2S\n ], []),\n wbString(ICON, 'Male icon filename'),\n wbString(MICO, 'Male mico filename'),\n wbRStruct('Female biped model', [\n wbString(MOD3, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO3S,\n wbMOSD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Female world model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO4S\n ], []),\n wbString(ICO2, 'Female icon filename'),\n wbString(MIC2, 'Female mico filename'),\n wbETYPReq,\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itS32),\n wbInteger('Max Condition', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n wbInteger('AR', itS16, wbDiv(100)),\n wbInteger('Flags', itU16, wbFlags([ // Only a byte or 2 distincts byte\n 'Modulates Voice'\n ])),\n wbFloat('DT'),\n wbByteArray('Unused', 4)\n ], cpNormal, True, nil, 2)\n ]);\n\n wbRecord(BOOK, 'Book', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDESCReq,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbInteger('Flags', itU8, wbFlags([\n '',\n 'Can''t be Taken'\n ])),\n wbInteger('Skill', itS8, wbSkillEnum),\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ]);\n\n wbSPLO := wbFormIDCk(SPLO, 'Actor Effect', [SPEL]);\n wbSPLOs := wbRArrayS('Actor Effects', wbSPLO, cpNormal, False, nil, nil, wbActorTemplateUseActorEffectList);\n\n wbRecord(CELL, 'Cell', [\n wbEDID,\n wbFULL,\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n {0x01} 'Is Interior Cell',\n {0x02} 'Has water',\n {0x04} 'Invert Fast Travel behavior',\n {0x08} 'No LOD Water',\n {0x10} '',\n {0x20} 'Public place',\n {0x40} 'Hand changed',\n {0x80} 'Behave like exterior'\n ]), cpNormal, True),\n wbStruct(XCLC, 'Grid', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32),\n wbInteger('Force Hide Land', itU32, wbFlags([\n 'Quad 1',\n 'Quad 2',\n 'Quad 3',\n 'Quad 4'\n ], True))\n ], cpNormal, False, nil, 2),\n wbStruct(XCLL, 'Lighting', [\n wbStruct('Ambient Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Directional Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Fog Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Fog Near'),\n wbFloat('Fog Far'),\n wbInteger('Directional Rotation XY', itS32),\n wbInteger('Directional Rotation Z', itS32),\n wbFloat('Directional Fade'),\n wbFloat('Fog Clip Dist'),\n wbFloat('Fog Power')\n ], cpNormal, False, nil, 7),\n wbArray(IMPF, 'Footstep Materials', wbString('Unknown', 30), [\n 'ConcSolid',\n 'ConcBroken',\n 'MetalSolid',\n 'MetalHollow',\n 'MetalSheet',\n 'Wood',\n 'Sand',\n 'Dirt',\n 'Grass',\n 'Water'\n ]),\n wbRStruct('Light Template', [\n wbFormIDCk(LTMP, 'Template', [LGTM, NULL]),\n wbInteger(LNAM, 'Inherit', itU32, wbFlags([\n {0x00000001}'Ambient Color',\n {0x00000002}'Directional Color',\n {0x00000004}'Fog Color',\n {0x00000008}'Fog Near',\n {0x00000010}'Fog Far',\n {0x00000020}'Directional Rotation',\n {0x00000040}'Directional Fade',\n {0x00000080}'Clip Distance',\n {0x00000100}'Fog Power'\n ]), cpNormal, True)\n ], [], cpNormal, True ),\n wbFloat(XCLW, 'Water Height'),\n wbString(XNAM, 'Water Noise Texture'),\n wbArrayS(XCLR, 'Regions', wbFormIDCk('Region', [REGN])),\n wbFormIDCk(XCIM, 'Image Space', [IMGS]),\n wbByteArray(XCET, 'Unknown', 1, cpIgnore),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbFormIDCk(XCCM, 'Climate', [CLMT]),\n wbFormIDCk(XCWT, 'Water', [WATR]),\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n wbFormIDCk(XCAS, 'Acoustic Space', [ASPC]),\n wbByteArray(XCMT, 'Unused', 1, cpIgnore),\n wbFormIDCk(XCMO, 'Music Type', [MUSC])\n ], True, wbCellAddInfo, cpNormal, False, wbCELLAfterLoad);\n\n wbServiceFlags :=\n wbFlags([\n {0x00000001} 'Weapons',\n {0x00000002} 'Armor',\n {0x00000004} 'Alcohol',\n {0x00000008} 'Books',\n {0x00000010} 'Food',\n {0x00000020} 'Chems',\n {0x00000040} 'Stimpacks',\n {0x00000080} 'Lights?',\n {0x00000100} '',\n {0x00000200} '',\n {0x00000400} 'Miscellaneous',\n {0x00000800} '',\n {0x00001000} '',\n {0x00002000} 'Potions?',\n {0x00004000} 'Training',\n {0x00008000} '',\n {0x00010000} 'Recharge',\n {0x00020000} 'Repair'\n ]);\n\n wbSpecializationEnum := wbEnum(['Combat', 'Magic', 'Stealth']);\n\n wbRecord(CLAS, 'Class', [\n wbEDIDReq,\n wbFULLReq,\n wbDESCReq,\n wbICON,\n wbStruct(DATA, '', [\n wbArray('Tag Skills', wbInteger('Tag Skill', itS32, wbActorValueEnum), 4),\n wbInteger('Flags', itU32, wbFlags(['Playable', 'Guard'], True)),\n wbInteger('Buys/Sells and Services', itU32, wbServiceFlags),\n wbInteger('Teaches', itS8, wbSkillEnum),\n wbInteger('Maximum training level', itU8),\n wbByteArray('Unused', 2)\n ], cpNormal, True),\n wbArray(ATTR, 'Attributes', wbInteger('Attribute', itU8), [\n 'Strength',\n 'Perception',\n 'Endurance',\n 'Charisma',\n 'Intelligence',\n 'Agility',\n 'Luck'\n ], cpNormal, True)\n ]);\nend;\n\nprocedure DefineFNVc;\nbegin\n wbRecord(CLMT, 'Climate', [\n wbEDIDReq,\n wbArrayS(WLST, 'Weather Types', wbStructSK([0], 'Weather Type', [\n wbFormIDCk('Weather', [WTHR, NULL]),\n wbInteger('Chance', itS32),\n wbFormIDCk('Global', [GLOB, NULL])\n ])),\n wbString(FNAM, 'Sun Texture'),\n wbString(GNAM, 'Sun Glare Texture'),\n wbMODL,\n wbStruct(TNAM, 'Timing', [\n wbStruct('Sunrise', [\n wbInteger('Begin', itU8, wbClmtTime),\n wbInteger('End', itU8, wbClmtTime)\n ]),\n wbStruct('Sunset', [\n wbInteger('Begin', itU8, wbClmtTime),\n wbInteger('End', itU8, wbClmtTime)\n ]),\n wbInteger('Volatility', itU8),\n wbInteger('Moons / Phase Length', itU8, wbClmtMoonsPhaseLength)\n ], cpNormal, True)\n ]);\n\n wbCNTO :=\n wbRStructExSK([0], [1], 'Item', [\n wbStructExSK(CNTO, [0], [1], 'Item', [\n wbFormIDCk('Item', [ARMO, AMMO, MISC, WEAP, BOOK, LVLI, KEYM, ALCH, NOTE, IMOD, CMNY, CCRD, LIGH, CHIP{, MSTT{?}{, STAT{?}]),\n wbInteger('Count', itS32)\n ]),\n wbCOED\n ], []);\n\n wbCNTOs := wbRArrayS('Items', wbCNTO);\n\n wbRecord(CONT, 'Container', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbSCRI,\n wbCNTOs,\n wbDEST,\n wbStruct(DATA, '', [\n wbInteger('Flags', itU8, wbFlags(['', 'Respawns'])),\n wbFloat('Weight')\n ], cpNormal, True),\n wbFormIDCk(SNAM, 'Sound - Open', [SOUN]),\n wbFormIDCk(QNAM, 'Sound - Close', [SOUN]),\n wbFormIDCk(RNAM, 'Sound - Random/Looping', [SOUN])\n ], True);\n\n wbCSDT := wbRStructSK([0], 'Sound Type', [\n wbInteger(CSDT, 'Type', itU32,wbEnum([\n {00} 'Left Foot',\n {01} 'Right Foot',\n {02} 'Left Back Foot',\n {03} 'Right Back Foot',\n {04} 'Idle',\n {05} 'Aware',\n {06} 'Attack',\n {07} 'Hit',\n {08} 'Death',\n {09} 'Weapon',\n {10} 'Movement Loop',\n {11} 'Conscious Loop',\n {12} 'Auxiliary 1',\n {13} 'Auxiliary 2',\n {14} 'Auxiliary 3',\n {15} 'Auxiliary 4',\n {16} 'Auxiliary 5',\n {17} 'Auxiliary 6',\n {18} 'Auxiliary 7',\n {19} 'Auxiliary 8',\n {19} 'Auxiliary 8',\n {20} 'Jump',\n {21} 'PlayRandom/Loop'\n ])),\n wbRArrayS('Sounds', wbRStructSK([0], 'Sound', [\n wbFormIDCk(CSDI, 'Sound', [SOUN, NULL], False, cpNormal, True),\n wbInteger(CSDC, 'Sound Chance', itU8, nil, cpNormal, True)\n ], []), cpNormal, True)\n ], []);\n\n wbCSDTs := wbRArrayS('Sound Types', wbCSDT, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation);\n\n wbAgressionEnum := wbEnum([\n 'Unaggressive',\n 'Aggressive',\n 'Very Aggressive',\n 'Frenzied'\n ]);\n\n wbConfidenceEnum := wbEnum([\n 'Cowardly',\n 'Cautious',\n 'Average',\n 'Brave',\n 'Foolhardy'\n ]);\n\n wbMoodEnum := wbEnum([\n 'Neutral',\n 'Afraid',\n 'Annoyed',\n 'Cocky',\n 'Drugged',\n 'Pleasant',\n 'Angry',\n 'Sad'\n ]);\n\n wbAssistanceEnum := wbEnum([\n 'Helps Nobody',\n 'Helps Allies',\n 'Helps Friends and Allies'\n ]);\n\n wbAggroRadiusFlags := wbFlags([\n 'Aggro Radius Behavior'\n ]);\n\n wbAIDT :=\n wbStruct(AIDT, 'AI Data', [\n {00} wbInteger('Aggression', itU8, wbAgressionEnum),\n {01} wbInteger('Confidence', itU8, wbConfidenceEnum),\n {02} wbInteger('Energy Level', itU8),\n {03} wbInteger('Responsibility', itU8),\n {04} wbInteger('Mood', itU8, wbMoodEnum),\n {05} wbByteArray('Unused', 3), // Mood is stored as a DWord as shown by endianSwapping but is truncated to byte during load :)\n {08} wbInteger('Buys/Sells and Services', itU32, wbServiceFlags),\n {0C} wbInteger('Teaches', itS8, wbSkillEnum),\n {0D} wbInteger('Maximum training level', itU8),\n {0E} wbInteger('Assistance', itS8, wbAssistanceEnum),\n {0F} wbInteger('Aggro Radius Behavior', itU8, wbAggroRadiusFlags),\n {10} wbInteger('Aggro Radius', itS32)\n ], cpNormal, True, wbActorTemplateUseAIData);\n\n wbAttackAnimationEnum :=\n wbEnum([\n ], [\n 26, 'AttackLeft',\n 27, 'AttackLeftUp',\n 28, 'AttackLeftDown',\n 29, 'AttackLeftIS',\n 30, 'AttackLeftISUp',\n 31, 'AttackLeftISDown',\n 32, 'AttackRight',\n 33, 'AttackRightUp',\n 34, 'AttackRightDown',\n 35, 'AttackRightIS',\n 36, 'AttackRightISUp',\n 37, 'AttackRightISDown',\n 38, 'Attack3',\n 39, 'Attack3Up',\n 40, 'Attack3Down',\n 41, 'Attack3IS',\n 42, 'Attack3ISUp',\n 43, 'Attack3ISDown',\n 44, 'Attack4',\n 45, 'Attack4Up',\n 46, 'Attack4Down',\n 47, 'Attack4IS',\n 48, 'Attack4ISUp',\n 49, 'Attack4ISDown',\n 50, 'Attack5',\n 51, 'Attack5Up',\n 52, 'Attack5Down',\n 53, 'Attack5IS',\n 54, 'Attack5ISUp',\n 55, 'Attack5ISDown',\n 56, 'Attack6',\n 57, 'Attack6Up',\n 58, 'Attack6Down',\n 59, 'Attack6IS',\n 60, 'Attack6ISUp',\n 61, 'Attack6ISDown',\n 62, 'Attack7',\n 63, 'Attack7Up',\n 64, 'Attack7Down',\n 65, 'Attack7IS',\n 66, 'Attack7ISUp',\n 67, 'Attack7ISDown',\n 68, 'Attack8',\n 69, 'Attack8Up',\n 70, 'Attack8Down',\n 71, 'Attack8IS',\n 72, 'Attack8ISUp',\n 73, 'Attack8ISDown',\n 74, 'AttackLoop',\n 75, 'AttackLoopUp',\n 76, 'AttackLoopDown',\n 77, 'AttackLoopIS',\n 78, 'AttackLoopISUp',\n 79, 'AttackLoopISDown',\n 80, 'AttackSpin',\n 81, 'AttackSpinUp',\n 82, 'AttackSpinDown',\n 83, 'AttackSpinIS',\n 84, 'AttackSpinISUp',\n 85, 'AttackSpinISDown',\n 86, 'AttackSpin2',\n 87, 'AttackSpin2Up',\n 88, 'AttackSpin2Down',\n 89, 'AttackSpin2IS',\n 90, 'AttackSpin2ISUp',\n 91, 'AttackSpin2ISDown',\n 92, 'AttackPower',\n 93, 'AttackForwardPower',\n 94, 'AttackBackPower',\n 95, 'AttackLeftPower',\n 96, 'AttackRightPower',\n 97, 'PlaceMine',\n 98, 'PlaceMineUp',\n 99, 'PlaceMineDown',\n 100, 'PlaceMineIS',\n 101, 'PlaceMineISUp',\n 102, 'PlaceMineISDown',\n 103, 'PlaceMine2',\n 104, 'PlaceMine2Up',\n 105, 'PlaceMine2Down',\n 106, 'PlaceMine2IS',\n 107, 'PlaceMine2ISUp',\n 108, 'PlaceMine2ISDown',\n 109, 'AttackThrow',\n 110, 'AttackThrowUp',\n 111, 'AttackThrowDown',\n 112, 'AttackThrowIS',\n 113, 'AttackThrowISUp',\n 114, 'AttackThrowISDown',\n 115, 'AttackThrow2',\n 116, 'AttackThrow2Up',\n 117, 'AttackThrow2Down',\n 118, 'AttackThrow2IS',\n 119, 'AttackThrow2ISUp',\n 120, 'AttackThrow2ISDown',\n 121, 'AttackThrow3',\n 122, 'AttackThrow3Up',\n 123, 'AttackThrow3Down',\n 124, 'AttackThrow3IS',\n 125, 'AttackThrow3ISUp',\n 126, 'AttackThrow3ISDown',\n 127, 'AttackThrow4',\n 128, 'AttackThrow4Up',\n 129, 'AttackThrow4Down',\n 130, 'AttackThrow4IS',\n 131, 'AttackThrow4ISUp',\n 132, 'AttackThrow4ISDown',\n 133, 'AttackThrow5',\n 134, 'AttackThrow5Up',\n 135, 'AttackThrow5Down',\n 136, 'AttackThrow5IS',\n 137, 'AttackThrow5ISUp',\n 138, 'AttackThrow5ISDown',\n\n 167, 'PipBoy',\n 178, 'PipBoyChild',\n\n 255, ' ANY'\n ]);\n\n wbImpactMaterialTypeEnum :=\n wbEnum([\n 'Stone',\n 'Dirt',\n 'Grass',\n 'Glass',\n 'Metal',\n 'Wood',\n 'Organic',\n 'Cloth',\n 'Water',\n 'Hollow Metal',\n 'Organic Bug',\n 'Organic Glow'\n ]);\n\n wbTemplateFlags := wbFlags([\n 'Use Traits',\n 'Use Stats',\n 'Use Factions',\n 'Use Actor Effect List',\n 'Use AI Data',\n 'Use AI Packages',\n 'Use Model/Animation',\n 'Use Base Data',\n 'Use Inventory',\n 'Use Script'\n ]);\n\n wbRecord(CREA, 'Creature', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLActor,\n wbMODLActor,\n wbSPLOs,\n wbFormIDCk(EITM, 'Unarmed Attack Effect', [ENCH, SPEL], False, cpNormal, False, wbActorTemplateUseActorEffectList),\n wbInteger(EAMT, 'Unarmed Attack Animation', itU16, wbAttackAnimationEnum, cpNormal, True, False, wbActorTemplateUseActorEffectList),\n wbArrayS(NIFZ, 'Model List', wbStringLC('Model'), 0, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbByteArray(NIFT, 'Texture Files Hashes', 0, cpIgnore, False, False, wbActorTemplateUseModelAnimation),\n wbStruct(ACBS, 'Configuration', [\n {00} wbInteger('Flags', itU32, wbFlags([\n {0x000001} 'Biped',\n {0x000002} 'Essential',\n {0x000004} 'Weapon & Shield?',\n {0x000008} 'Respawn',\n {0x000010} 'Swims',\n {0x000020} 'Flies',\n {0x000040} 'Walks',\n {0x000080} 'PC Level Mult',\n {0x000100} 'Unknown 8',\n {0x000200} 'No Low Level Processing',\n {0x000400} '',\n {0x000800} 'No Blood Spray',\n {0x001000} 'No Blood Decal',\n {0x002000} '',\n {0x004000} '',\n {0x008000} 'No Head',\n {0x010000} 'No Right Arm',\n {0x020000} 'No Left Arm',\n {0x040000} 'No Combat in Water',\n {0x080000} 'No Shadow',\n {0x100000} 'No VATS Melee',\n {0x00200000} 'Allow PC Dialogue',\n {0x00400000} 'Can''t Open Doors',\n {0x00800000} 'Immobile',\n {0x01000000} 'Tilt Front/Back',\n {0x02000000} 'Tilt Left/Right',\n {0x03000000} 'No Knockdowns',\n {0x08000000} 'Not Pushable',\n {0x10000000} 'Allow Pickpocket',\n {0x20000000} 'Is Ghost',\n {0x40000000} 'No Rotating To Head-track',\n {0x80000000} 'Invulnerable'\n ], [\n {0x000001 Biped} wbActorTemplateUseModelAnimation,\n {0x000002 Essential} wbActorTemplateUseBaseData,\n {0x000004 Weapon & Shield} nil,\n {0x000008 Respawn} wbActorTemplateUseBaseData,\n {0x000010 Swims} wbActorTemplateUseModelAnimation,\n {0x000020 Flies} wbActorTemplateUseModelAnimation,\n {0x000040 Walks} wbActorTemplateUseModelAnimation,\n {0x000080 PC Level Mult} wbActorTemplateUseStats,\n {0x000100 Unknown 8} nil,\n {0x000200 No Low Level Processing} wbActorTemplateUseBaseData,\n {0x000400 } nil,\n {0x000800 No Blood Spray} wbActorTemplateUseModelAnimation,\n {0x001000 No Blood Decal} wbActorTemplateUseModelAnimation,\n {0x002000 } nil,\n {0x004000 } nil,\n {0x008000 No Head} wbActorTemplateUseModelAnimation,\n {0x010000 No Right Arm} wbActorTemplateUseModelAnimation,\n {0x020000 No Left Arm} wbActorTemplateUseModelAnimation,\n {0x040000 No Combat in Water} wbActorTemplateUseModelAnimation,\n {0x080000 No Shadow} wbActorTemplateUseModelAnimation,\n {0x100000 No VATS Melee} nil,\n {0x00200000 Allow PC Dialogue} wbActorTemplateUseBaseData,\n {0x00400000 Can''t Open Doors} wbActorTemplateUseBaseData,\n {0x00800000 Immobile} wbActorTemplateUseModelAnimation,\n {0x01000000 Tilt Front/Back} wbActorTemplateUseModelAnimation,\n {0x02000000 Tilt Left/Right} wbActorTemplateUseModelAnimation,\n {0x03000000 No Knockdowns} nil,\n {0x08000000 Not Pushable} wbActorTemplateUseModelAnimation,\n {0x10000000 Allow Pickpocket} wbActorTemplateUseBaseData,\n {0x20000000 Is Ghost} nil,\n {0x40000000 No Rotating To Head-track} wbActorTemplateUseModelAnimation,\n {0x80000000 Invulnerable} nil\n ])),\n {04} wbInteger('Fatigue', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {06} wbInteger('Barter gold', itU16, nil, cpNormal, False, wbActorTemplateUseAIData),\n {08} wbUnion('Level', wbCreaLevelDecider, [\n wbInteger('Level', itS16, nil, cpNormal, False, wbActorTemplateUseStats),\n wbInteger('Level Mult', itS16, wbDiv(1000), cpNormal, False, wbActorTemplateUseStats)\n ], cpNormal, False, wbActorTemplateUseStats),\n {10} wbInteger('Calc min', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {12} wbInteger('Calc max', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {14} wbInteger('Speed Multiplier', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {16} wbFloat('Karma (Alignment)', cpNormal, False, 1, -1, wbActorTemplateUseTraits),\n {20} wbInteger('Disposition Base', itS16, nil, cpNormal, False, wbActorTemplateUseTraits),\n {22} wbInteger('Template Flags', itU16, wbTemplateFlags)\n ], cpNormal, True),\n wbRArrayS('Factions',\n wbStructSK(SNAM, [0], 'Faction', [\n wbFormIDCk('Faction', [FACT]),\n wbInteger('Rank', itU8),\n wbByteArray('Unused', 3)\n ]),\n cpNormal, False, nil, nil, wbActorTemplateUseFactions),\n wbFormIDCk(INAM, 'Death item', [LVLI], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(VTCK, 'Voice', [VTYP], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(TPLT, 'Template', [CREA, LVLC]),\n wbDESTActor,\n wbSCRIActor,\n wbRArrayS('Items', wbCNTO, cpNormal, False, nil, nil, wbActorTemplateUseInventory),\n wbAIDT,\n wbRArray('Packages', wbFormIDCk(PKID, 'Package', [PACK]), cpNormal, False, nil, nil, wbActorTemplateUseAIPackages),\n wbArrayS(KFFZ, 'Animations', wbStringLC('Animation'), 0, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbStruct(DATA, '', [\n {00} wbInteger('Type', itU8, wbCreatureTypeEnum, cpNormal, False, wbActorTemplateUseTraits),\n {01} wbInteger('Combat Skill', itU8, nil, cpNormal, False, wbActorTemplateUseStats),\n {02} wbInteger('Magic Skill', itU8, nil, cpNormal, False, wbActorTemplateUseStats),\n {03} wbInteger('Stealth Skill', itU8, nil, cpNormal, False, wbActorTemplateUseStats),\n {04} wbInteger('Health', itS16, nil, cpNormal, False, wbActorTemplateUseStats),\n {06} wbByteArray('Unused', 2),\n {08} wbInteger('Damage', itS16, nil, cpNormal, False, wbActorTemplateUseStats),\n {10} wbArray('Attributes', wbInteger('Attribute', itU8), [\n 'Strength',\n 'Perception',\n 'Endurance',\n 'Charisma',\n 'Intelligence',\n 'Agility',\n 'Luck'\n ], cpNormal, False, wbActorTemplateUseStats)\n ], cpNormal, True),\n wbInteger(RNAM, 'Attack reach', itU8, nil, cpNormal, True, False, wbActorTemplateUseTraits),\n wbFormIDCk(ZNAM, 'Combat Style', [CSTY], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(PNAM, 'Body Part Data', [BPTD], False, cpNormal, True, wbActorTemplateUseModelAnimation),\n wbFloat(TNAM, 'Turning Speed', cpNormal, True, 1, -1, wbActorTemplateUseStats),\n wbFloat(BNAM, 'Base Scale', cpNormal, True, 1, -1, wbActorTemplateUseStats),\n wbFloat(WNAM, 'Foot Weight', cpNormal, True, 1, -1, wbActorTemplateUseStats),\n wbInteger(NAM4, 'Impact Material Type', itU32, wbImpactMaterialTypeEnum, cpNormal, True, False, wbActorTemplateUseModelAnimation),\n wbInteger(NAM5, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True, False, wbActorTemplateUseModelAnimation),\n wbFormIDCk(CSCR, 'Inherits Sounds from', [CREA], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbCSDTs,\n wbFormIDCk(CNAM, 'Impact Dataset', [IPDS], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbFormIDCk(LNAM, 'Melee Weapon List', [FLST], False, cpNormal, False, wbActorTemplateUseTraits)\n ], True);\n\nend;\n\nprocedure DefineFNVd;\nbegin\n wbRecord(CSTY, 'Combat Style', [\n wbEDIDReq,\n wbStruct(CSTD, 'Advanced - Standard', [\n {000}wbInteger('Maneuver Decision - Dodge % Chance', itU8),\n {001}wbInteger('Maneuver Decision - Left/Right % Chance', itU8),\n {002}wbByteArray('Unused', 2),\n {004}wbFloat('Maneuver Decision - Dodge L/R Timer (min)'),\n {008}wbFloat('Maneuver Decision - Dodge L/R Timer (max)'),\n {012}wbFloat('Maneuver Decision - Dodge Forward Timer (min)'),\n {016}wbFloat('Maneuver Decision - Dodge Forward Timer (max)'),\n {020}wbFloat('Maneuver Decision - Dodge Back Timer Min'),\n {024}wbFloat('Maneuver Decision - Dodge Back Timer Max'),\n {028}wbFloat('Maneuver Decision - Idle Timer min'),\n {032}wbFloat('Maneuver Decision - Idle Timer max'),\n {036}wbInteger('Melee Decision - Block % Chance', itU8),\n {037}wbInteger('Melee Decision - Attack % Chance', itU8),\n {038}wbByteArray('Unused', 2),\n {040}wbFloat('Melee Decision - Recoil/Stagger Bonus to Attack'),\n {044}wbFloat('Melee Decision - Unconscious Bonus to Attack'),\n {048}wbFloat('Melee Decision - Hand-To-Hand Bonus to Attack'),\n {052}wbInteger('Melee Decision - Power Attacks - Power Attack % Chance', itU8),\n {053}wbByteArray('Unused', 3),\n {056}wbFloat('Melee Decision - Power Attacks - Recoil/Stagger Bonus to Power'),\n {060}wbFloat('Melee Decision - Power Attacks - Unconscious Bonus to Power Attack'),\n {064}wbInteger('Melee Decision - Power Attacks - Normal', itU8),\n {065}wbInteger('Melee Decision - Power Attacks - Forward', itU8),\n {066}wbInteger('Melee Decision - Power Attacks - Back', itU8),\n {067}wbInteger('Melee Decision - Power Attacks - Left', itU8),\n {068}wbInteger('Melee Decision - Power Attacks - Right', itU8),\n {069}wbByteArray('Unused', 3),\n {072}wbFloat('Melee Decision - Hold Timer (min)'),\n {076}wbFloat('Melee Decision - Hold Timer (max)'),\n {080}wbInteger('Flags', itU16, wbFlags([\n 'Choose Attack using % Chance',\n 'Melee Alert OK',\n 'Flee Based on Personal Survival',\n '',\n 'Ignore Threats',\n 'Ignore Damaging Self',\n 'Ignore Damaging Group',\n 'Ignore Damaging Spectators',\n 'Cannot Use Stealthboy'\n ])),\n {082}wbByteArray('Unused', 2),\n {085}wbInteger('Maneuver Decision - Acrobatic Dodge % Chance', itU8),\n {085}wbInteger('Melee Decision - Power Attacks - Rushing Attack % Chance', itU8),\n {086}wbByteArray('Unused', 2),\n {088}wbFloat('Melee Decision - Power Attacks - Rushing Attack Distance Mult')\n ], cpNormal, True),\n wbStruct(CSAD, 'Advanced - Advanced', [\n wbFloat('Dodge Fatigue Mod Mult'),\n wbFloat('Dodge Fatigue Mod Base'),\n wbFloat('Encumb. Speed Mod Base'),\n wbFloat('Encumb. Speed Mod Mult'),\n wbFloat('Dodge While Under Attack Mult'),\n wbFloat('Dodge Not Under Attack Mult'),\n wbFloat('Dodge Back While Under Attack Mult'),\n wbFloat('Dodge Back Not Under Attack Mult'),\n wbFloat('Dodge Forward While Attacking Mult'),\n wbFloat('Dodge Forward Not Attacking Mult'),\n wbFloat('Block Skill Modifier Mult'),\n wbFloat('Block Skill Modifier Base'),\n wbFloat('Block While Under Attack Mult'),\n wbFloat('Block Not Under Attack Mult'),\n wbFloat('Attack Skill Modifier Mult'),\n wbFloat('Attack Skill Modifier Base'),\n wbFloat('Attack While Under Attack Mult'),\n wbFloat('Attack Not Under Attack Mult'),\n wbFloat('Attack During Block Mult'),\n wbFloat('Power Att. Fatigue Mod Base'),\n wbFloat('Power Att. Fatigue Mod Mult')\n ], cpNormal, True),\n wbStruct(CSSD, 'Simple', [\n {00} wbFloat('Cover Search Radius'),\n {04} wbFloat('Take Cover Chance'),\n {08} wbFloat('Wait Timer (min)'),\n {12} wbFloat('Wait Timer (max)'),\n {16} wbFloat('Wait to Fire Timer (min)'),\n {20} wbFloat('Wait to Fire Timer (max)'),\n {24} wbFloat('Fire Timer (min)'),\n {28} wbFloat('Fire Timer (max)'),\n {32} wbFloat('Ranged Weapon Range Mult (min)'),\n {36} wbByteArray('Unused', 4),\n {40} wbInteger('Weapon Restrictions', itU32, wbEnum([\n 'None',\n 'Melee Only',\n 'Ranged Only'\n ])),\n {44} wbFloat('Ranged Weapon Range Mult (max)'),\n {48} wbFloat('Max Targeting FOV'),\n {52} wbFloat('Combat Radius'),\n {56} wbFloat('Semi-Auto Firing Delay Mult (min)'),\n {60} wbFloat('Semi-Auto Firing Delay Mult (max)')\n ], cpNormal, True)\n ]);\n\n wbRecord(DIAL, 'Dialog Topic', [\n wbEDIDReq,\n wbRArrayS('Added Quests', wbRStructSK([0], 'Added Quest', [\n wbFormIDCkNoReach(QSTI, 'Quest', [QUST], False, cpBenign),\n wbRArray('Shared Infos', wbRStruct('Shared Info', [\n wbFormIDCk(INFC, 'Info Connection', [INFO], False, cpBenign),\n wbInteger(INFX, 'Info Index', itS32, nil, cpBenign)\n ], []))\n ], [])),\n // no QSTR in FNV, but keep it just in case\n wbRArrayS('Removed Quests', wbRStructSK([0], 'Removed Quest', [\n wbFormIDCkNoReach(QSTR, 'Quest', [QUST], False, cpBenign)\n ], [])),\n // some records have INFC INFX (with absent formids) but no QSTI, probably error in GECK\n // i.e. [DIAL:001287C6] and [DIAL:000E9084]\n wbRArray('Unused', wbRStruct('Unused', [\n wbUnknown(INFC, cpIgnore),\n wbUnknown(INFX, cpIgnore)\n ], []), cpIgnore, False, nil, nil, wbNeverShow),\n wbFULL,\n wbFloat(PNAM, 'Priority', cpNormal, True, 1, -1, nil, nil, 50.0),\n wbString(TDUM, 'Dumb Response'),\n wbStruct(DATA, '', [\n wbInteger('Type', itU8, wbEnum([\n {0} 'Topic',\n {1} 'Conversation',\n {2} 'Combat',\n {3} 'Persuasion',\n {4} 'Detection',\n {5} 'Service',\n {6} 'Miscellaneous',\n {7} 'Radio'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Rumors',\n 'Top-level'\n ]))\n ], cpNormal, True, nil, 1)\n ], True);\n\n wbRecord(DOOR, 'Door', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbSCRI,\n wbDEST,\n wbFormIDCk(SNAM, 'Sound - Open', [SOUN]),\n wbFormIDCk(ANAM, 'Sound - Close', [SOUN]),\n wbFormIDCk(BNAM, 'Sound - Looping', [SOUN]),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n '',\n 'Automatic Door',\n 'Hidden',\n 'Minimal Use',\n 'Sliding Door'\n ]), cpNormal, True)\n ]);\n\n wbBlendModeEnum := wbEnum([\n '',\n 'Zero',\n 'One',\n 'Source Color',\n 'Source Inverse Color',\n 'Source Alpha',\n 'Source Inverted Alpha',\n 'Dest Alpha',\n 'Dest Inverted Alpha',\n 'Dest Color',\n 'Dest Inverse Color',\n 'Source Alpha SAT'\n ]);\n\n wbBlendOpEnum := wbEnum([\n '',\n 'Add',\n 'Subtract',\n 'Reverse Subtract',\n 'Minimum',\n 'Maximum'\n ]);\n wbZTestFuncEnum := wbEnum([\n '',\n '',\n '',\n 'Equal To',\n 'Normal',\n 'Greater Than',\n '',\n 'Greater Than or Equal Than',\n 'Always Show'\n ]);\n\n wbRecord(EFSH, 'Effect Shader', [\n wbEDID,\n wbString(ICON, 'Fill Texture'),\n wbString(ICO2, 'Particle Shader Texture'),\n wbString(NAM7, 'Holes Texture'),\n wbStruct(DATA, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0} 'No Membrane Shader',\n {1} '',\n {2} '',\n {3} 'No Particle Shader',\n {4} 'Edge Effect - Inverse',\n {5} 'Membrane Shader - Affect Skin Only'\n ])),\n wbByteArray('Unused', 3),\n wbInteger('Membrane Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Membrane Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Membrane Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbStruct('Fill/Texture Effect - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Fill/Texture Effect - Alpha Fade In Time'),\n wbFloat('Fill/Texture Effect - Full Alpha Time'),\n wbFloat('Fill/Texture Effect - Alpha Fade Out Time'),\n wbFloat('Fill/Texture Effect - Presistent Alpha Ratio'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Amplitude'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Frequency'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (U)'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (V)'),\n wbFloat('Edge Effect - Fall Off'),\n wbStruct('Edge Effect - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Edge Effect - Alpha Fade In Time'),\n wbFloat('Edge Effect - Full Alpha Time'),\n wbFloat('Edge Effect - Alpha Fade Out Time'),\n wbFloat('Edge Effect - Persistent Alpha Ratio'),\n wbFloat('Edge Effect - Alpha Pulse Amplitude'),\n wbFloat('Edge Effect - Alpha Pusle Frequence'),\n wbFloat('Fill/Texture Effect - Full Alpha Ratio'),\n wbFloat('Edge Effect - Full Alpha Ratio'),\n wbInteger('Membrane Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Particle Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Particle Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Particle Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbInteger('Particle Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbFloat('Particle Shader - Particle Birth Ramp Up Time'),\n wbFloat('Particle Shader - Full Particle Birth Time'),\n wbFloat('Particle Shader - Particle Birth Ramp Down Time'),\n wbFloat('Particle Shader - Full Particle Birth Ratio'),\n wbFloat('Particle Shader - Persistant Particle Birth Ratio'),\n wbFloat('Particle Shader - Particle Lifetime'),\n wbFloat('Particle Shader - Particle Lifetime +/-'),\n wbFloat('Particle Shader - Initial Speed Along Normal'),\n wbFloat('Particle Shader - Acceleration Along Normal'),\n wbFloat('Particle Shader - Initial Velocity #1'),\n wbFloat('Particle Shader - Initial Velocity #2'),\n wbFloat('Particle Shader - Initial Velocity #3'),\n wbFloat('Particle Shader - Acceleration #1'),\n wbFloat('Particle Shader - Acceleration #2'),\n wbFloat('Particle Shader - Acceleration #3'),\n wbFloat('Particle Shader - Scale Key 1'),\n wbFloat('Particle Shader - Scale Key 2'),\n wbFloat('Particle Shader - Scale Key 1 Time'),\n wbFloat('Particle Shader - Scale Key 2 Time'),\n wbStruct('Color Key 1 - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Color Key 2 - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Color Key 3 - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Color Key 1 - Color Alpha'),\n wbFloat('Color Key 2 - Color Alpha'),\n wbFloat('Color Key 3 - Color Alpha'),\n wbFloat('Color Key 1 - Color Key Time'),\n wbFloat('Color Key 2 - Color Key Time'),\n wbFloat('Color Key 3 - Color Key Time'),\n wbFloat('Particle Shader - Initial Speed Along Normal +/-'),\n wbFloat('Particle Shader - Initial Rotation (deg)'),\n wbFloat('Particle Shader - Initial Rotation (deg) +/-'),\n wbFloat('Particle Shader - Rotation Speed (deg/sec)'),\n wbFloat('Particle Shader - Rotation Speed (deg/sec) +/-'),\n wbFormIDCk('Addon Models', [DEBR, NULL]),\n wbFloat('Holes - Start Time'),\n wbFloat('Holes - End Time'),\n wbFloat('Holes - Start Val'),\n wbFloat('Holes - End Val'),\n wbFloat('Edge Width (alpha units)'),\n wbStruct('Edge Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Explosion Wind Speed'),\n wbInteger('Texture Count U', itU32),\n wbInteger('Texture Count V', itU32),\n wbFloat('Addon Models - Fade In Time'),\n wbFloat('Addon Models - Fade Out Time'),\n wbFloat('Addon Models - Scale Start'),\n wbFloat('Addon Models - Scale End'),\n wbFloat('Addon Models - Scale In Time'),\n wbFloat('Addon Models - Scale Out Time')\n ], cpNormal, True, nil, 57)\n ], False, nil, cpNormal, False, wbEFSHAfterLoad);\n\n wbRecord(ENCH, 'Object Effect', [\n wbEDIDReq,\n wbFULL,\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Type', itU32, wbEnum([\n {0} '',\n {1} '',\n {2} 'Weapon',\n {3} 'Apparel'\n ])),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbInteger('Flags', itU8, wbFlags([\n 'No Auto-Calc',\n 'Auto Calculate',\n 'Hide Effect'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(EYES, 'Eyes', [\n wbEDIDReq,\n wbFULLReq,\n wbString(ICON, 'Texture', 0{, cpNormal, True??}),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Playable',\n 'Not Male',\n 'Not Female'\n ]), cpNormal, True)\n ]);\n\n wbXNAM :=\n wbStructSK(XNAM, [0], 'Relation', [\n wbFormIDCkNoReach('Faction', [FACT, RACE]),\n wbInteger('Modifier', itS32),\n wbInteger('Group Combat Reaction', itU32, wbEnum([\n 'Neutral',\n 'Enemy',\n 'Ally',\n 'Friend'\n ]))\n ]);\n\n wbXNAMs := wbRArrayS('Relations', wbXNAM);\n\n wbRecord(FACT, 'Faction', [\n wbEDIDReq,\n wbFULL,\n wbXNAMs,\n wbStruct(DATA, '', [\n wbInteger('Flags 1', itU8, wbFlags([\n 'Hidden from PC',\n 'Evil',\n 'Special Combat'\n ])),\n wbInteger('Flags 2', itU8, wbFlags([\n 'Track Crime',\n 'Allow Sell'\n ])),\n wbByteArray('Unused', 2)\n ], cpNormal, True, nil, 1),\n wbFloat(CNAM, 'Unused'),\n wbRStructsSK('Ranks', 'Rank', [0], [\n wbInteger(RNAM, 'Rank#', itS32),\n wbString(MNAM, 'Male', 0, cpTranslate),\n wbString(FNAM, 'Female', 0, cpTranslate),\n wbString(INAM, 'Insignia (Unused)')\n ], []),\n wbFormIDCk(WMI1, 'Reputation', [REPU])\n ], False, nil, cpNormal, False, wbFACTAfterLoad);\n\n wbRecord(FURN, 'Furniture', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbSCRI,\n wbDEST,\n wbByteArray(MNAM, 'Marker Flags', 0, cpNormal, True)\n ]);\n\n wbRecord(GLOB, 'Global', [\n wbEDIDReq,\n wbInteger(FNAM, 'Type', itU8, wbGLOBFNAM, nil, cpNormal, True),\n wbFloat(FLTV, 'Value', cpNormal, True)\n ]);\n\n\n wbRecord(GMST, 'Game Setting', [\n wbString(EDID, 'Editor ID', 0, cpCritical, True, nil, wbGMSTEDIDAfterSet),\n wbUnion(DATA, 'Value', wbGMSTUnionDecider, [\n wbString('', 0, cpTranslate),\n wbInteger('', itS32),\n wbFloat('')\n ], cpNormal, True)\n ]);\n\n wbDODT := wbStruct(DODT, 'Decal Data', [\n wbFloat('Min Width'),\n wbFloat('Max Width'),\n wbFloat('Min Height'),\n wbFloat('Max Height'),\n wbFloat('Depth'),\n wbFloat('Shininess'),\n wbStruct('Parallax', [\n wbFloat('Scale'),\n wbInteger('Passes', itU8)\n ]),\n wbInteger('Flags', itU8, wbFlags([\n 'Parallax',\n 'Alpha - Blending',\n 'Alpha - Testing'\n ], True)),\n wbByteArray('Unused', 2),\n wbStruct('Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]);\n\n wbRecord(TXST, 'Texture Set', [\n wbEDIDReq,\n wbOBNDReq,\n wbRStruct('Textures (RGB/A)', [\n wbString(TX00,'Base Image / Transparency'),\n wbString(TX01,'Normal Map / Specular'),\n wbString(TX02,'Environment Map Mask / ?'),\n wbString(TX03,'Glow Map / Unused'),\n wbString(TX04,'Parallax Map / Unused'),\n wbString(TX05,'Environment Map / Unused')\n ], []),\n wbDODT,\n wbInteger(DNAM, 'Flags', itU16, wbFlags([\n 'No Specular Map'\n ]), cpNormal, True)\n ]);\n\n wbRecord(MICN, 'Menu Icon', [\n wbEDIDReq,\n wbICONReq\n ]);\n\n wbRecord(HDPT, 'Head Part', [\n wbEDIDReq,\n wbFULLReq,\n wbMODL,\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Playable'\n ]), cpNormal, True),\n wbRArrayS('Extra Parts',\n wbFormIDCk(HNAM, 'Part', [HDPT])\n )\n ]);\n\n wbRecord(ASPC, 'Acoustic Space', [\n wbEDIDReq,\n wbOBNDReq,\n\n wbFormIDCk(SNAM, 'Dawn / Default Loop', [NULL, SOUN], False, cpNormal, True),\n wbFormIDCk(SNAM, 'Afternoon', [NULL, SOUN], False, cpNormal, True),\n wbFormIDCk(SNAM, 'Dusk', [NULL, SOUN], False, cpNormal, True),\n wbFormIDCk(SNAM, 'Night', [NULL, SOUN], False, cpNormal, True),\n wbFormIDCk(SNAM, 'Walla', [NULL, SOUN], False, cpNormal, True),\n\n wbInteger(WNAM, 'Walla Trigger Count', itU32, nil, cpNormal, True),\n wbFormIDCk(RDAT, 'Use Sound from Region (Interiors Only)', [REGN]),\n wbInteger(ANAM, 'Environment Type', itU32, wbEnum([\n 'None',\n 'Default',\n 'Generic',\n 'Padded Cell',\n 'Room',\n 'Bathroom',\n 'Livingroom',\n 'Stone Room',\n 'Auditorium',\n 'Concerthall',\n 'Cave',\n 'Arena',\n 'Hangar',\n 'Carpeted Hallway',\n 'Hallway',\n 'Stone Corridor',\n 'Alley',\n 'Forest',\n 'City',\n 'Mountains',\n 'Quarry',\n 'Plain',\n 'Parkinglot',\n 'Sewerpipe',\n 'Underwater',\n 'Small Room',\n 'Medium Room',\n 'Large Room',\n 'Medium Hall',\n 'Large Hall',\n 'Plate'\n ]), cpNormal, True),\n wbInteger(INAM, 'Is Interior', itU32, wbEnum(['No', 'Yes']), cpNormal, True)\n ]);\n\n wbRecord(TACT, 'Talking Activator', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbSCRI,\n wbDEST,\n wbFormIDCk(SNAM, 'Looping Sound', [SOUN]),\n wbFormIDCk(VNAM, 'Voice Type', [VTYP]),\n wbFormIDCk(INAM, 'Radio Template', [SOUN])\n ]);\n\n wbRecord(SCPT, 'Script', [\n wbEDIDReq,\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Script'),\n wbStringScript(SCTX, 'Script Source', 0, cpNormal{, True}),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ]);\n\n wbRecord(TERM, 'Terminal', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbSCRI,\n wbDEST,\n wbDESCReq,\n wbFormIDCk(SNAM, 'Sound - Looping', [SOUN]),\n wbFormIDCk(PNAM, 'Password Note', [NOTE]),\n wbStruct(DNAM, '', [\n wbInteger('Base Hacking Difficulty', itU8, wbEnum([\n 'Very Easy',\n 'Easy',\n 'Average',\n 'Hard',\n 'Very Hard',\n 'Requires Key'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Leveled',\n 'Unlocked',\n 'Alternate Colors',\n 'Hide Welcome Text when displaying Image'\n ])),\n wbInteger('ServerType', itU8, wbEnum([\n '-Server 1-',\n '-Server 2-',\n '-Server 3-',\n '-Server 4-',\n '-Server 5-',\n '-Server 6-',\n '-Server 7-',\n '-Server 8-',\n '-Server 9-',\n '-Server 10-'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbRArray('Menu Items',\n wbRStruct('Menu Item', [\n wbString(ITXT, 'Item Text'),\n wbString(RNAM, 'Result Text', 0, cpNormal, True),\n wbInteger(ANAM, 'Flags', itU8, wbFlags([\n 'Add Note',\n 'Force Redraw'\n ]), cpNormal, True),\n wbFormIDCk(INAM, 'Display Note', [NOTE]),\n wbFormIDCk(TNAM, 'Sub Menu', [TERM]),\n wbEmbeddedScriptReq,\n wbCTDAs\n ], [])\n )\n ]);\n\n wbRecord(SCOL, 'Static Collection', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbRStructsSK('Parts', 'Part', [0], [\n wbFormIDCk(ONAM, 'Static', [STAT]),\n wbArrayS(DATA, 'Placements', wbStruct('Placement', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ]),\n wbFloat('Scale')\n ]), 0, cpNormal, True)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(MSTT, 'Moveable Static', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbDEST,\n wbByteArray(DATA, 'Unknown', 1, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN])\n ]);\n\n wbRecord(PWAT, 'Placeable Water', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbStruct(DNAM, '', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001}'Reflects',\n {0x00000002}'Reflects - Actors',\n {0x00000004}'Reflects - Land',\n {0x00000008}'Reflects - LOD Land',\n {0x00000010}'Reflects - LOD Buildings',\n {0x00000020}'Reflects - Trees',\n {0x00000040}'Reflects - Sky',\n {0x00000080}'Reflects - Dynamic Objects',\n {0x00000100}'Reflects - Dead Bodies',\n {0x00000200}'Refracts',\n {0x00000400}'Refracts - Actors',\n {0x00000800}'Refracts - Land',\n {0x00001000}'',\n {0x00002000}'',\n {0x00004000}'',\n {0x00008000}'',\n {0x00010000}'Refracts - Dynamic Objects',\n {0x00020000}'Refracts - Dead Bodies',\n {0x00040000}'Silhouette Reflections',\n {0x00080000}'',\n {0x00100000}'',\n {0x00200000}'',\n {0x00400000}'',\n {0x00800000}'',\n {0x01000000}'',\n {0x02000000}'',\n {0x03000000}'',\n {0x08000000}'',\n {0x10000000}'Depth',\n {0x20000000}'Object Texture Coordinates',\n {0x40000000}'',\n {0x80000000}'No Underwater Fog'\n ])),\n wbFormIDCk('Water', [WATR])\n ], cpNormal, True)\n ]);\n\n wbRecord(IDLM, 'Idle Marker', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(IDLF, 'Flags', itU8, wbFlags([\n 'Run in Sequence',\n '',\n 'Do Once'\n ]), cpNormal, True),\n wbStruct(IDLC, '', [\n wbInteger('Animation Count', itU8),\n wbByteArray('Unused', 3)\n ], cpNormal, True, nil, 1),\n wbFloat(IDLT, 'Idle Timer Setting', cpNormal, True),\n wbArray(IDLA, 'Animations', wbFormIDCk('Animation', [IDLE, NULL]), 0, nil, wbIDLAsAfterSet, cpNormal, True) // NULL looks valid if IDLS\\Animation Count is 0\n ], False, nil, cpNormal, False, nil, wbAnimationsAfterSet);\n\n wbRecord(NOTE, 'Note', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbYNAM,\n wbZNAM,\n wbInteger(DATA, 'Type', itU8, wbEnum([\n 'Sound',\n 'Text',\n 'Image',\n 'Voice'\n ]), cpNormal, True),\n wbRArrayS('Quests',\n wbFormIDCkNoReach(ONAM, 'Quest', [QUST])\n ),\n wbString(XNAM, 'Texture'),\n wbUnion(TNAM, 'Text / Topic', wbNOTETNAMDecide, [\n wbString('Text'),\n wbFormIDCk('Topic', [DIAL])\n ]),\n wbUnion(SNAM, 'Sound / NPC', wbNOTESNAMDecide, [\n wbFormIDCk('Sound', [SOUN]),\n wbFormIDCk('Actor', [NPC_, CREA])\n ])\n ]);\n\nend;\n\nprocedure DefineFNVe;\nbegin\n wbRecord(PROJ, 'Projectile', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbDEST,\n wbStruct(DATA, 'Data', [\n {00} wbInteger('Flags', itU16, wbFlags([\n 'Hitscan',\n 'Explosion',\n 'Alt. Trigger',\n 'Muzzle Flash',\n '',\n 'Can Be Disabled',\n 'Can Be Picked Up',\n 'Supersonic',\n 'Pins Limbs',\n 'Pass Through Small Transparent',\n 'Detonates',\n 'Rotation'\n ])),\n {02} wbInteger('Type', itU16, wbEnum([\n {00} '',\n {01} 'Missile',\n {02} 'Lobber',\n {03} '',\n {04} 'Beam',\n {05} '',\n {06} '',\n {07} '',\n {08} 'Flame',\n {09} '',\n {10} '',\n {11} '',\n {12} '',\n {13} '',\n {14} '',\n {15} '',\n {16} 'Continuous Beam'\n ])),\n {04} wbFloat('Gravity'),\n {08} wbFloat('Speed'),\n {12} wbFloat('Range'),\n {16} wbFormIDCk('Light', [LIGH, NULL]),\n {20} wbFormIDCk('Muzzle Flash - Light', [LIGH, NULL]),\n {24} wbFloat('Tracer Chance'),\n {28} wbFloat('Explosion - Alt. Trigger - Proximity'),\n {32} wbFloat('Explosion - Alt. Trigger - Timer'),\n {36} wbFormIDCk('Explosion', [EXPL, NULL]),\n {40} wbFormIDCk('Sound', [SOUN, NULL]),\n {44} wbFloat('Muzzle Flash - Duration'),\n {48} wbFloat('Fade Duration'),\n {52} wbFloat('Impact Force'),\n {56} wbFormIDCk('Sound - Countdown', [SOUN, NULL]),\n {60} wbFormIDCk('Sound - Disable', [SOUN, NULL]),\n {64} wbFormIDCk('Default Weapon Source', [WEAP, NULL]),\n {68} wbStruct('Rotation', [\n {68} wbFloat('X'),\n {72} wbFloat('Y'),\n {76} wbFloat('Z')\n ]),\n {80} wbFloat('Bouncy Mult')\n ], cpNormal, True),\n wbRStructSK([0], 'Muzzle Flash Model', [\n wbString(NAM1, 'Model Filename'),\n wbByteArray(NAM2, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, True),\n wbInteger(VNAM, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ]);\n\n wbRecord(NAVI, 'Navigation Mesh Info Map', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbRArray('Navigation Map Infos',\n wbStruct(NVMI, 'Navigation Map Info', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbFormIDCk('Location', [CELL, WRLD]),\n wbStruct('Grid', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbUnknown\n{ wbUnion('Data', wbNAVINVMIDecider, [\n wbStruct('Data', [\n wbUnknown\n ]),\n wbStruct('Data', [\n wbArray('Unknown', wbFloat('Unknown'), 3),\n wbByteArray('Unknown', 4)\n ]),\n wbStruct('Data', [\n wbArray('Unknown', wbArray('Unknown', wbFloat('Unknown'), 3), 3),\n wbInteger('Count 1', itU16),\n wbInteger('Count 2', itU16),\n wbArray('Unknown', wbArray('Unknown', wbFloat('Unknown'), 3), [], wbNAVINAVMGetCount1),\n wbUnknown\n ]),\n wbStruct('Data', [\n wbUnknown\n ])\n ])}\n ])\n ),\n wbRArray('Unknown',\n wbStruct(NVCI, 'Unknown', [\n wbFormIDCk('Unknown', [NAVM]),\n wbArray('Unknown', wbFormIDCk('Unknown', [NAVM]), -1),\n wbArray('Unknown', wbFormIDCk('Unknown', [NAVM]), -1),\n wbArray('Doors', wbFormIDCk('Door', [REFR]), -1)\n ])\n )\n ]);\n\n if wbSimpleRecords then begin\n\n wbRecord(NAVM, 'Navigation Mesh', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbStruct(DATA, '', [\n wbFormIDCk('Cell', [CELL]),\n wbInteger('Vertex Count', itU32),\n wbInteger('Triangle Count', itU32),\n wbInteger('External Connections Count', itU32),\n wbInteger('NVCA Count', itU32),\n wbInteger('Doors Count', itU32)\n ]),\n wbByteArray(NVVX, 'Vertices'),\n wbByteArray(NVTR, 'Triangles'),\n wbByteArray(NVCA, 'Unknown'),\n wbArray(NVDP, 'Doors', wbStruct('Door', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Triangle', itU16),\n wbByteArray('Unused', 2)\n ])),\n wbByteArray(NVGD, 'Unknown'),\n wbArray(NVEX, 'External Connections', wbStruct('Connection', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Navigation Mesh', [NAVM], False, cpNormal),\n wbInteger('Triangle', itU16, nil, cpNormal)\n ]))\n ], False, wbNAVMAddInfo);\n\n end else begin\n\n wbRecord(NAVM, 'Navigation Mesh', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbStruct(DATA, '', [\n wbFormIDCk('Cell', [CELL]),\n wbInteger('Vertex Count', itU32),\n wbInteger('Triangle Count', itU32),\n wbInteger('External Connections Count', itU32),\n wbInteger('NVCA Count', itU32),\n wbInteger('Doors Count', itU32) // as of version = 5 (earliest NavMesh version I saw (Fallout3 1.7) is already 11)\n ]),\n wbArray(NVVX, 'Vertices', wbStruct('Vertex', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ])),\n wbArray(NVTR, 'Triangles', wbStruct('Triangle', [\n wbArray('Vertices', wbInteger('Vertex', itS16), 3),\n wbArray('Edges', wbInteger('Triangle', itS16, wbNVTREdgeToStr, wbNVTREdgeToInt), [\n '0 <-> 1',\n '1 <-> 2',\n '2 <-> 0'\n ]),\n wbInteger('Flags', itU32, wbFlags([\n 'Triangle #0 Is External',\n 'Triangle #1 Is External',\n 'Triangle #2 Is External',\n 'Unknown 4',\n 'Unknown 5',\n 'Unknown 6',\n 'Preferred pathing',\n 'Unknown 8',\n 'Unknown 9',\n 'Water',\n 'Contains door',\n 'Unknown 12',\n 'Unknown 13', // Cleared on LoadForm\n 'Unknown 14', // Cleared on LoadForm\n 'Unknown 15', // Cleared on LoadForm\n 'Unknown 16',\n 'Unknown 17',\n 'Unknown 18',\n 'Unknown 19',\n 'Unknown 20',\n 'Unknown 21',\n 'Unknown 22',\n 'Unknown 23',\n 'Unknown 24',\n 'Unknown 25',\n 'Unknown 26',\n 'Unknown 27',\n 'Unknown 28',\n 'Unknown 29',\n 'Unknown 30',\n 'Unknown 31',\n 'Unknown 32'\n ]))\n ])),\n wbArray(NVCA, 'Unknown', wbInteger('Triangle', itS16)), // Assumed triangle as the value fits the triangle id's\n wbArray(NVDP, 'Doors', wbStruct('Door', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Triangle', itU16),\n wbByteArray('Unused', 2)\n ])),\n wbStruct(NVGD, 'NavMesh Grid', [\n wbInteger('NavMeshGrid Divisor', itU32),\n wbFloat('Max X Distance'), // Floats named after TES5 definition\n wbFloat('Max Y Distance'),\n wbFloat('Min X'),\n wbFloat('Min Y'),\n wbFloat('Min Z'),\n wbFloat('Max X'),\n wbFloat('Max Y'),\n wbFloat('Max Z'),\n wbArray('Cells', wbArray('Cell', wbInteger('Triangle', itS16), -2)) // Divisor is row count , assumed triangle as the values fit the triangle id's\n ]),\n wbArray(NVEX, 'External Connections', wbStruct('Connection', [\n wbByteArray('Unknown', 4), // absent in ver<9, not endian swap in ver>=9, so char or byte array\n wbFormIDCk('Navigation Mesh', [NAVM, NULL], False, cpNormal), // NULL values are ignored silently.\n wbInteger('Triangle', itU16, nil, cpNormal)\n ])) // Different if ver<5: Length = $2E/$30 and contains other data between NavMesh and Triangle\n ], False, wbNAVMAddInfo);\n\n end;\n\n wbRecord(PGRE, 'Placed Grenade', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [PROJ], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbString(XATO, 'Activation Prompt'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(PMIS, 'Placed Missile', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [PROJ], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbString(XATO, 'Activation Prompt'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(PBEA, 'Placed Beam', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [PROJ], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbString(XATO, 'Activation Prompt'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(EXPL, 'Explosion', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbEITM,\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD]),\n wbStruct(DATA, 'Data', [\n {00} wbFloat('Force'),\n {04} wbFloat('Damage'),\n {08} wbFloat('Radius'),\n {12} wbFormIDCk('Light', [LIGH, NULL]),\n {16} wbFormIDCk('Sound 1', [SOUN, NULL]),\n {20} wbInteger('Flags', itU32, wbFlags([\n {0x00000001}'Unknown 1',\n {0x00000002}'Always Uses World Orientation',\n {0x00000004}'Knock Down - Always',\n {0x00000008}'Knock Down - By Formula',\n {0x00000010}'Ignore LOS Check',\n {0x00000020}'Push Explosion Source Ref Only',\n {0x00000040}'Ignore Image Space Swap'\n ])),\n {24} wbFloat('IS Radius'),\n {28} wbFormIDCk('Impact DataSet', [IPDS, NULL]),\n {32} wbFormIDCk('Sound 2', [SOUN, NULL]),\n wbStruct('Radiation', [\n {36} wbFloat('Level'),\n {40} wbFloat('Dissipation Time'),\n {44} wbFloat('Radius')\n ]),\n {48} wbInteger('Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ], cpNormal, True),\n wbFormIDCk(INAM, 'Placed Impact Object', [TREE, SOUN, ACTI, DOOR, STAT, FURN,\n CONT, ARMO, AMMO, LVLN, LVLC, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS,\n ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, TXST, CHIP, CMNY,\n CCRD, IMOD])\n ]);\n\n wbRecord(DEBR, 'Debris', [\n wbEDIDReq,\n wbRStructs('Models', 'Model', [\n wbStruct(DATA, 'Data', [\n wbInteger('Percentage', itU8),\n wbString('Model Filename'),\n wbInteger('Flags', itU8, wbFlags([\n 'Has Collission Data'\n ]))\n ], cpNormal, True),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(IMGS, 'Image Space', [\n wbEDIDReq,\n wbStruct(DNAM, '', [\n wbStruct('HDR', [\n {00} wbFloat('Eye Adapt Speed'),\n {04} wbFloat('Blur Radius'),\n {08} wbFloat('Blur Passes'),\n {12} wbFloat('Emissive Mult'),\n {16} wbFloat('Target LUM'),\n {20} wbFloat('Upper LUM Clamp'),\n {24} wbFloat('Bright Scale'),\n {28} wbFloat('Bright Clamp'),\n {32} wbFloat('LUM Ramp No Tex'),\n {36} wbFloat('LUM Ramp Min'),\n {40} wbFloat('LUM Ramp Max'),\n {44} wbFloat('Sunlight Dimmer'),\n {48} wbFloat('Grass Dimmer'),\n {52} wbFloat('Tree Dimmer'),\n {56} wbUnion('Skin Dimmer', wbIMGSSkinDimmerDecider, [\n wbFloat('Skin Dimmer'),\n wbEmpty('Skin Dimmer', cpIgnore)\n ])\n ], cpNormal, False, nil, 14),\n wbStruct('Bloom', [\n {60} wbFloat('Blur Radius'),\n {64} wbFloat('Alpha Mult Interior'),\n {68} wbFloat('Alpha Mult Exterior')\n ]),\n wbStruct('Get Hit', [\n {72} wbFloat('Blur Radius'),\n {76} wbFloat('Blur Damping Constant'),\n {80} wbFloat('Damping Constant')\n ]),\n wbStruct('Night Eye', [\n wbStruct('Tint Color', [\n {84} wbFloat('Red', cpNormal, False, 255, 0),\n {88} wbFloat('Green', cpNormal, False, 255, 0),\n {92} wbFloat('Blue', cpNormal, False, 255, 0)\n ]),\n {96} wbFloat('Brightness')\n ]),\n wbStruct('Cinematic', [\n {100} wbFloat('Saturation'),\n wbStruct('Contrast', [\n {104} wbFloat('Avg Lum Value'),\n {108} wbFloat('Value')\n ]),\n {112} wbFloat('Cinematic - Brightness - Value'),\n wbStruct('Tint', [\n wbStruct('Color', [\n {116} wbFloat('Red', cpNormal, False, 255, 0),\n {120} wbFloat('Green', cpNormal, False, 255, 0),\n {124} wbFloat('Blue', cpNormal, False, 255, 0)\n ]),\n {128} wbFloat('Value')\n ])\n ]),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbInteger('Flags', itU8, wbFlags([\n 'Saturation',\n 'Contrast',\n 'Tint',\n 'Brightness'\n ], True)),\n wbByteArray('Unused', 3)\n ], cpNormal, True, nil, 5)\n ]);\n\n wbTimeInterpolator := wbStruct('Data', [\n wbFloat('Time'),\n wbFloat('Value')\n ]);\n\n wbColorInterpolator := wbStruct('Data', [\n wbFloat('Time'),\n wbFloat('Red', cpNormal, False, 255, 0),\n wbFloat('Green', cpNormal, False, 255, 0),\n wbFloat('Blue', cpNormal, False, 255, 0),\n wbFloat('Alpha', cpNormal, False, 255, 0)\n ]);\n\n wbRecord(IMAD, 'Image Space Adapter', [\n wbEDID,\n wbStruct(DNAM, 'Data Count', [\n wbInteger('Flags', itU32, wbFlags(['Animatable'])),\n wbFloat('Duration'),\n wbStruct('HDR', [\n wbInteger('Eye Adapt Speed Mult', itU32),\n wbInteger('Eye Adapt Speed Add', itU32),\n wbInteger('Bloom Blur Radius Mult', itU32),\n wbInteger('Bloom Blur Radius Add', itU32),\n wbInteger('Bloom Threshold Mult', itU32),\n wbInteger('Bloom Threshold Add', itU32),\n wbInteger('Bloom Scale Mult', itU32),\n wbInteger('Bloom Scale Add', itU32),\n wbInteger('Target Lum Min Mult', itU32),\n wbInteger('Target Lum Min Add', itU32),\n wbInteger('Target Lum Max Mult', itU32),\n wbInteger('Target Lum Max Add', itU32),\n wbInteger('Sunlight Scale Mult', itU32),\n wbInteger('Sunlight Scale Add', itU32),\n wbInteger('Sky Scale Mult', itU32),\n wbInteger('Sky Scale Add', itU32)\n ]),\n wbInteger('Unknown08 Mult', itU32),\n wbInteger('Unknown48 Add', itU32),\n wbInteger('Unknown09 Mult', itU32),\n wbInteger('Unknown49 Add', itU32),\n wbInteger('Unknown0A Mult', itU32),\n wbInteger('Unknown4A Add', itU32),\n wbInteger('Unknown0B Mult', itU32),\n wbInteger('Unknown4B Add', itU32),\n wbInteger('Unknown0C Mult', itU32),\n wbInteger('Unknown4C Add', itU32),\n wbInteger('Unknown0D Mult', itU32),\n wbInteger('Unknown4D Add', itU32),\n wbInteger('Unknown0E Mult', itU32),\n wbInteger('Unknown4E Add', itU32),\n wbInteger('Unknown0F Mult', itU32),\n wbInteger('Unknown4F Add', itU32),\n wbInteger('Unknown10 Mult', itU32),\n wbInteger('Unknown50 Add', itU32),\n wbStruct('Cinematic', [\n wbInteger('Saturation Mult', itU32),\n wbInteger('Saturation Add', itU32),\n wbInteger('Brightness Mult', itU32),\n wbInteger('Brightness Add', itU32),\n wbInteger('Contrast Mult', itU32),\n wbInteger('Contrast Add', itU32)\n ]),\n wbInteger('Unknown14 Mult', itU32),\n wbInteger('Unknown54 Add', itU32),\n wbInteger('Tint Color', itU32),\n wbInteger('Blur Radius', itU32),\n wbInteger('Double Vision Strength', itU32),\n wbInteger('Radial Blur Strength', itU32),\n wbInteger('Radial Blur Ramp Up', itU32),\n wbInteger('Radial Blur Start', itU32),\n wbInteger('Radial Blur Flags', itU32, wbFlags(['Use Target'])),\n wbFloat('Radial Blur Center X'),\n wbFloat('Radial Blur Center Y'),\n wbInteger('DoF Strength', itU32),\n wbInteger('DoF Distance', itU32),\n wbInteger('DoF Range', itU32),\n wbInteger('DoF Flags', itU32, wbFlags(['Use Target'])),\n wbInteger('Radial Blur Ramp Down', itU32),\n wbInteger('Radial Blur Down Start', itU32),\n wbInteger('Fade Color', itU32),\n wbInteger('Motion Blur Strength', itU32)\n ], cpNormal, True, nil, 26),\n wbArray(BNAM, 'Blur Radius', wbTimeInterpolator),\n wbArray(VNAM, 'Double Vision Strength', wbTimeInterpolator),\n wbArray(TNAM, 'Tint Color', wbColorInterpolator),\n wbArray(NAM3, 'Fade Color', wbColorInterpolator),\n wbArray(RNAM, 'Radial Blur Strength', wbTimeInterpolator),\n wbArray(SNAM, 'Radial Blur Ramp Up', wbTimeInterpolator),\n wbArray(UNAM, 'Radial Blur Start', wbTimeInterpolator),\n wbArray(NAM1, 'Radial Blur Ramp Down', wbTimeInterpolator),\n wbArray(NAM2, 'Radial Blur Down Start', wbTimeInterpolator),\n wbArray(WNAM, 'DoF Strength', wbTimeInterpolator),\n wbArray(XNAM, 'DoF Distance', wbTimeInterpolator),\n wbArray(YNAM, 'DoF Range', wbTimeInterpolator),\n wbArray(NAM4, 'Motion Blur Strength', wbTimeInterpolator),\n wbRStruct('HDR', [\n wbArray(_00_IAD, 'Eye Adapt Speed Mult', wbTimeInterpolator),\n wbArray(_40_IAD, 'Eye Adapt Speed Add', wbTimeInterpolator),\n wbArray(_01_IAD, 'Bloom Blur Radius Mult', wbTimeInterpolator),\n wbArray(_41_IAD, 'Bloom Blur Radius Add', wbTimeInterpolator),\n wbArray(_02_IAD, 'Bloom Threshold Mult', wbTimeInterpolator),\n wbArray(_42_IAD, 'Bloom Threshold Add', wbTimeInterpolator),\n wbArray(_03_IAD, 'Bloom Scale Mult', wbTimeInterpolator),\n wbArray(_43_IAD, 'Bloom Scale Add', wbTimeInterpolator),\n wbArray(_04_IAD, 'Target Lum Min Mult', wbTimeInterpolator),\n wbArray(_44_IAD, 'Target Lum Min Add', wbTimeInterpolator),\n wbArray(_05_IAD, 'Target Lum Max Mult', wbTimeInterpolator),\n wbArray(_45_IAD, 'Target Lum Max Add', wbTimeInterpolator),\n wbArray(_06_IAD, 'Sunlight Scale Mult', wbTimeInterpolator),\n wbArray(_46_IAD, 'Sunlight Scale Add', wbTimeInterpolator),\n wbArray(_07_IAD, 'Sky Scale Mult', wbTimeInterpolator),\n wbArray(_47_IAD, 'Sky Scale Add', wbTimeInterpolator)\n ], []),\n wbUnknown(_08_IAD),\n wbUnknown(_48_IAD),\n wbUnknown(_09_IAD),\n wbUnknown(_49_IAD),\n wbUnknown(_0A_IAD),\n wbUnknown(_4A_IAD),\n wbUnknown(_0B_IAD),\n wbUnknown(_4B_IAD),\n wbUnknown(_0C_IAD),\n wbUnknown(_4C_IAD),\n wbUnknown(_0D_IAD),\n wbUnknown(_4D_IAD),\n wbUnknown(_0E_IAD),\n wbUnknown(_4E_IAD),\n wbUnknown(_0F_IAD),\n wbUnknown(_4F_IAD),\n wbUnknown(_10_IAD),\n wbUnknown(_50_IAD),\n wbRStruct('Cinematic', [\n wbArray(_11_IAD, 'Saturation Mult', wbTimeInterpolator),\n wbArray(_51_IAD, 'Saturation Add', wbTimeInterpolator),\n wbArray(_12_IAD, 'Brightness Mult', wbTimeInterpolator),\n wbArray(_52_IAD, 'Brightness Add', wbTimeInterpolator),\n wbArray(_13_IAD, 'Contrast Mult', wbTimeInterpolator),\n wbArray(_53_IAD, 'Contrast Add', wbTimeInterpolator)\n ], []),\n wbUnknown(_14_IAD),\n wbUnknown(_54_IAD),\n wbFormIDCk(RDSD, 'Sound - Intro', [SOUN]),\n wbFormIDCk(RDSI, 'Sound - Outro', [SOUN])\n ]);\n\n wbRecord(FLST, 'FormID List', [\n wbString(EDID, 'Editor ID', 0, cpBenign, True, nil, wbFLSTEDIDAfterSet),\n wbRArrayS('FormIDs', wbFormID(LNAM, 'FormID'), cpNormal, False, nil, nil, nil, wbFLSTLNAMIsSorted)\n ]);\n\n wbRecord(PERK, 'Perk', [\n wbEDIDReq,\n wbFULL,\n wbDESCReq,\n wbICON,\n wbCTDAs,\n wbStruct(DATA, 'Data', [\n wbInteger('Trait', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Min Level', itU8),\n wbInteger('Ranks', itU8),\n wbInteger('Playable', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Hidden', itU8, wbEnum(['No', 'Yes']))\n ], cpNormal, True, nil, 4),\n wbRStructsSK('Effects', 'Effect', [0, 1], [\n wbStructSK(PRKE, [1, 2, 0], 'Header', [\n wbInteger('Type', itU8, wbEnum([\n 'Quest + Stage',\n 'Ability',\n 'Entry Point'\n ]), cpNormal, False, nil, wbPERKPRKETypeAfterSet),\n wbInteger('Rank', itU8),\n wbInteger('Priority', itU8)\n ]),\n wbUnion(DATA, 'Effect Data', wbPerkDATADecider, [\n wbStructSK([0, 1], 'Quest + Stage', [\n wbFormIDCk('Quest', [QUST]),\n wbInteger('Quest Stage', itU8, wbPerkDATAQuestStageToStr, wbCTDAParam2QuestStageToInt),\n wbByteArray('Unused', 3)\n ]),\n wbFormIDCk('Ability', [SPEL]),\n wbStructSK([0, 1], 'Entry Point', [\n wbInteger('Entry Point', itU8, wbEnum([\n {00} 'Calculate Weapon Damage',\n {01} 'Calculate My Critical Hit Chance',\n {02} 'Calculate My Critical Hit Damage',\n {03} 'Calculate Weapon Attack AP Cost',\n {04} 'Calculate Mine Explode Chance',\n {05} 'Adjust Range Penalty',\n {06} 'Adjust Limb Damage',\n {07} 'Calculate Weapon Range',\n {08} 'Calculate To Hit Chance',\n {09} 'Adjust Experience Points',\n {10} 'Adjust Gained Skill Points',\n {11} 'Adjust Book Skill Points',\n {12} 'Modify Recovered Health',\n {13} 'Calculate Inventory AP Cost',\n {14} 'Get Disposition',\n {15} 'Get Should Attack',\n {16} 'Get Should Assist',\n {17} 'Calculate Buy Price',\n {18} 'Get Bad Karma',\n {19} 'Get Good Karma',\n {20} 'Ignore Locked Terminal',\n {21} 'Add Leveled List On Death',\n {22} 'Get Max Carry Weight',\n {23} 'Modify Addiction Chance',\n {24} 'Modify Addiction Duration',\n {25} 'Modify Positive Chem Duration',\n {26} 'Adjust Drinking Radiation',\n {27} 'Activate',\n {28} 'Mysterious Stranger',\n {29} 'Has Paralyzing Palm',\n {30} 'Hacking Science Bonus',\n {31} 'Ignore Running During Detection',\n {32} 'Ignore Broken Lock',\n {33} 'Has Concentrated Fire',\n {34} 'Calculate Gun Spread',\n {35} 'Player Kill AP Reward',\n {36} 'Modify Enemy Critical Hit Chance',\n {37} 'Reload Speed',\n {38} 'Equip Speed',\n {39} 'Action Point Regen',\n {40} 'Action Point Cost',\n {41} 'Miss Fortune',\n {42} 'Modify Run Speed',\n {43} 'Modify Attack Speed',\n {44} 'Modify Radiation Consumed',\n {45} 'Has Pip Hacker',\n {46} 'Has Meltdown',\n {47} 'See Enemy Health',\n {48} 'Has Jury Rigging',\n {49} 'Modify Threat Range',\n {50} 'Modify Thread',\n {51} 'Has Fast Travel Always',\n {52} 'Knockdown Chance',\n {53} 'Modify Weapon Strength Req',\n {54} 'Modify Aiming Move Speed',\n {55} 'Modify Light Items',\n {56} 'Modify Damage Threshold (defender)',\n {57} 'Modify Chance for Ammo Item',\n {58} 'Modify Damage Threshold (attacker)',\n {59} 'Modify Throwing Velocity',\n {60} 'Chance for Item on Fire',\n {61} 'Has Unarmed Forward Power Attack',\n {62} 'Has Unarmed Back Power Attack',\n {63} 'Has Unarmed Crouched Power Attack',\n {64} 'Has Unarmed Counter Attack',\n {65} 'Has Unarmed Left Power Attack',\n {66} 'Has Unarmed Right Power Attack',\n {67} 'VATS HelperChance',\n {68} 'Modify Item Damage',\n {69} 'Has Improved Detection',\n {70} 'Has Improved Spotting',\n {71} 'Has Improved Item Detection',\n {72} 'Adjust Explosion Radius',\n {73} 'Reserved'\n ]), cpNormal, True, nil, wbPERKEntryPointAfterSet),\n wbInteger('Function', itU8, wbPerkDATAFunctionToStr, wbPerkDATAFunctionToInt, cpNormal, False, nil, wbPerkDATAFunctionAfterSet),\n wbInteger('Perk Condition Tab Count', itU8, nil, cpIgnore)\n ])\n ], cpNormal, True),\n wbRStructsSK('Perk Conditions', 'Perk Condition', [0], [\n wbInteger(PRKC, 'Run On', itS8, wbPRKCToStr, wbPRKCToInt),\n wbCTDAsReq\n ], [], cpNormal, False, nil, nil, wbPERKPRKCDontShow),\n wbRStruct('Entry Point Function Parameters', [\n wbInteger(EPFT, 'Type', itU8, wbPerkEPFTToStr, wbPerkEPFTToInt, cpIgnore, False, nil, wbPerkEPFTAfterSet),\n wbUnion(EPFD, 'Data', wbEPFDDecider, [\n wbByteArray('Unknown'),\n wbFloat('Float'),\n wbStruct('Float, Float', [\n wbFloat('Float 1'),\n wbFloat('Float 2')\n ]),\n wbFormIDCk('Leveled Item', [LVLI]),\n wbEmpty('None (Script)'),\n wbStruct('Actor Value, Float', [\n wbInteger('Actor Value', itU32, wbEPFDActorValueToStr, wbEPFDActorValueToInt),\n wbFloat('Float')\n ])\n ], cpNormal, False, wbEPFDDontShow),\n wbString(EPF2, 'Button Label', 0, cpNormal, False, wbEPF2DontShow),\n wbInteger(EPF3, 'Script Flags', itU16, wbFlags([\n 'Run Immediately'\n ]), cpNormal, False, False, wbEPF2DontShow),\n wbEmbeddedScriptPerk\n ], [], cpNormal, False, wbPERKPRKCDontShow),\n wbEmpty(PRKF, 'End Marker', cpIgnore, True)\n ], [])\n ]);\n\n wbBPNDStruct := wbStruct(BPND, '', [\n {00} wbFloat('Damage Mult'),\n {04} wbInteger('Flags', itU8, wbFlags([\n 'Severable',\n 'IK Data',\n 'IK Data - Biped Data',\n 'Explodable',\n 'IK Data - Is Head',\n 'IK Data - Headtracking',\n 'To Hit Chance - Absolute'\n ])),\n {05} wbInteger('Part Type', itU8, wbEnum([\n 'Torso',\n 'Head 1',\n 'Head 2',\n 'Left Arm 1',\n 'Left Arm 2',\n 'Right Arm 1',\n 'Right Arm 2',\n 'Left Leg 1',\n 'Left Leg 2',\n 'Left Leg 3',\n 'Right Leg 1',\n 'Right Leg 2',\n 'Right Leg 3',\n 'Brain',\n 'Weapon'\n ])),\n {06} wbInteger('Health Percent', itU8),\n {07} wbInteger('Actor Value', itS8, wbActorValueEnum),\n {08} wbInteger('To Hit Chance', itU8),\n {09} wbInteger('Explodable - Explosion Chance %', itU8),\n {10} wbInteger('Explodable - Debris Count', itU16),\n {12} wbFormIDCk('Explodable - Debris', [DEBR, NULL]),\n {16} wbFormIDCk('Explodable - Explosion', [EXPL, NULL]),\n {20} wbFloat('Tracking Max Angle'),\n {24} wbFloat('Explodable - Debris Scale'),\n {28} wbInteger('Severable - Debris Count', itS32),\n {32} wbFormIDCk('Severable - Debris', [DEBR, NULL]),\n {36} wbFormIDCk('Severable - Explosion', [EXPL, NULL]),\n {40} wbFloat('Severable - Debris Scale'),\n wbStruct('Gore Effects Positioning', [\n wbStruct('Translate', [\n {44} wbFloat('X'),\n {48} wbFloat('Y'),\n {52} wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n {56} wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n {60} wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n {64} wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ]),\n {68} wbFormIDCk('Severable - Impact DataSet', [IPDS, NULL]),\n {72} wbFormIDCk('Explodable - Impact DataSet', [IPDS, NULL]),\n {28} wbInteger('Severable - Decal Count', itU8),\n {28} wbInteger('Explodable - Decal Count', itU8),\n {76} wbByteArray('Unused', 2),\n {80} wbFloat('Limb Replacement Scale')\n ], cpNormal, True);\n\n wbRecord(BPTD, 'Body Part Data', [\n wbEDIDReq,\n wbMODLReq,\n wbRStructS('Body Parts', 'Body Part', [ // When the Part Name is provided\n wbString(BPTN, 'Part Name', 0, cpNormal, True),\n wbString(BPNN, 'Part Node', 0, cpNormal, True),\n wbString(BPNT, 'VATS Target', 0, cpNormal, True),\n wbString(BPNI, 'IK Data - Start Node', 0, cpNormal, True),\n wbBPNDStruct,\n wbString(NAM1, 'Limb Replacement Model', 0, cpNormal, True),\n wbString(NAM4, 'Gore Effects - Target Bone', 0, cpNormal, True),\n wbByteArray(NAM5, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, False),\n wbRStructS('Unnamed Body Parts', 'Body Part', [ // When the Part Name is not provided\n wbString(BPNN, 'Part Node', 0, cpNormal, True),\n wbString(BPNT, 'VATS Target', 0, cpNormal, True),\n wbString(BPNI, 'IK Data - Start Node', 0, cpNormal, True),\n wbBPNDStruct,\n wbString(NAM1, 'Limb Replacement Model', 0, cpNormal, True),\n wbString(NAM4, 'Gore Effects - Target Bone', 0, cpNormal, True),\n wbByteArray(NAM5, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, False),\n wbFormIDCk(RAGA, 'Ragdoll', [RGDL])\n ]);\n\n wbRecord(ADDN, 'Addon Node', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbInteger(DATA, 'Node Index', itS32, nil, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN]),\n wbStruct(DNAM, 'Data', [\n wbInteger('Master Particle System Cap', itU16),\n wbByteArray('Unknown', 2)\n ], cpNormal, True)\n ]);\n\n wbRecord(AVIF, 'ActorValue Information', [\n wbEDIDReq,\n wbFULL,\n wbDESCReq,\n wbICON,\n wbString(ANAM, 'Short Name')\n ]);\n\n wbRecord(RADS, 'Radiation Stage', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbInteger('Trigger Threshold', itU32),\n wbFormIDCk('Actor Effect', [SPEL])\n ], cpNormal, True)\n ]);\n\n wbRecord(CAMS, 'Camera Shot', [\n wbEDIDReq,\n wbMODL,\n wbStruct(DATA, 'Data', [\n {00} wbInteger('Action', itU32, wbEnum([\n 'Shoot',\n 'Fly',\n 'Hit',\n 'Zoom'\n ])),\n {04} wbInteger('Location', itU32, wbEnum([\n 'Attacker',\n 'Projectile',\n 'Target'\n ])),\n {08} wbInteger('Target', itU32, wbEnum([\n 'Attacker',\n 'Projectile',\n 'Target'\n ])),\n {12} wbInteger('Flags', itU32, wbFlags([\n 'Position Follows Location',\n 'Rotation Follows Target',\n 'Don''t Follow Bone',\n 'First Person Camera',\n 'No Tracer',\n 'Start At Time Zero'\n ])),\n wbStruct('Time Multipliers', [\n {16} wbFloat('Player'),\n {20} wbFloat('Target'),\n {24} wbFloat('Global')\n ]),\n {28} wbFloat('Max Time'),\n {32} wbFloat('Min Time'),\n {36} wbFloat('Target % Between Actors')\n ], cpNormal, True, nil, 7),\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD])\n ]);\n\n wbRecord(CPTH, 'Camera Path', [\n wbEDIDReq,\n wbCTDAs,\n wbArray(ANAM, 'Related Camera Paths', wbFormIDCk('Related Camera Path', [CPTH, NULL]), ['Parent', 'Previous Sibling'], cpNormal, True),\n wbInteger(DATA, 'Camera Zoom', itU8, wbEnum([\n 'Default',\n 'Disable',\n 'Shot List'\n ]), cpNormal, True),\n wbRArray('Camera Shots', wbFormIDCk(SNAM, 'Camera Shot', [CAMS]))\n ]);\n\n wbRecord(VTYP, 'Voice Type', [\n wbEDIDReq,\n wbInteger(DNAM, 'Flags', itU8, wbFlags([\n 'Allow Default Dialog',\n 'Female'\n ]), cpNormal, False)\n ]);\n\n wbRecord(IPCT, 'Impact', [\n wbEDIDReq,\n wbMODL,\n wbStruct(DATA, '', [\n wbFloat('Effect - Duration'),\n wbInteger('Effect - Orientation', itU32, wbEnum([\n 'Surface Normal',\n 'Projectile Vector',\n 'Projectile Reflection'\n ])),\n wbFloat('Angle Threshold'),\n wbFloat('Placement Radius'),\n wbInteger('Sound Level', itU32, wbSoundLevelEnum),\n wbInteger('Flags', itU32, wbFlags([\n 'No Decal Data'\n ]))\n ], cpNormal, True),\n wbDODT,\n wbFormIDCk(DNAM, 'Texture Set', [TXST]),\n wbFormIDCk(SNAM, 'Sound 1', [SOUN]),\n wbFormIDCk(NAM1, 'Sound 2', [SOUN])\n ]);\n\n wbRecord(IPDS, 'Impact DataSet', [\n wbEDIDReq,\n wbStruct(DATA, 'Impacts', [\n wbFormIDCk('Stone', [IPCT, NULL]),\n wbFormIDCk('Dirt', [IPCT, NULL]),\n wbFormIDCk('Grass', [IPCT, NULL]),\n wbFormIDCk('Glass', [IPCT, NULL]),\n wbFormIDCk('Metal', [IPCT, NULL]),\n wbFormIDCk('Wood', [IPCT, NULL]),\n wbFormIDCk('Organic', [IPCT, NULL]),\n wbFormIDCk('Cloth', [IPCT, NULL]),\n wbFormIDCk('Water', [IPCT, NULL]),\n wbFormIDCk('Hollow Metal', [IPCT, NULL]),\n wbFormIDCk('Organic Bug', [IPCT, NULL]),\n wbFormIDCk('Organic Glow', [IPCT, NULL])\n ], cpNormal, True, nil, 9)\n ]);\n\n wbRecord(ECZN, 'Encounter Zone', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbFormIDCkNoReach('Owner', [NPC_, FACT, NULL]),\n wbInteger('Rank', itS8),\n wbInteger('Minimum Level', itS8),\n wbInteger('Flags', itU8, wbFlags([\n 'Never Resets',\n 'Match PC Below Minimum Level'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True)\n ]);\n\n wbRecord(MESG, 'Message', [\n wbEDIDReq,\n wbDESCReq,\n wbFULL,\n wbFormIDCk(INAM, 'Icon', [MICN, NULL], False, cpNormal, True),\n wbByteArray(NAM0, 'Unused', 0, cpIgnore),\n wbByteArray(NAM1, 'Unused', 0, cpIgnore),\n wbByteArray(NAM2, 'Unused', 0, cpIgnore),\n wbByteArray(NAM3, 'Unused', 0, cpIgnore),\n wbByteArray(NAM4, 'Unused', 0, cpIgnore),\n wbByteArray(NAM5, 'Unused', 0, cpIgnore),\n wbByteArray(NAM6, 'Unused', 0, cpIgnore),\n wbByteArray(NAM7, 'Unused', 0, cpIgnore),\n wbByteArray(NAM8, 'Unused', 0, cpIgnore),\n wbByteArray(NAM9, 'Unused', 0, cpIgnore),\n wbInteger(DNAM, 'Flags', itU32, wbFlags([\n 'Message Box',\n 'Auto Display'\n ]), cpNormal, True, False, nil, wbMESGDNAMAfterSet),\n wbInteger(TNAM, 'Display Time', itU32, nil, cpNormal, False, False, wbMESGTNAMDontShow),\n wbRStructs('Menu Buttons', 'Menu Button', [\n wbString(ITXT, 'Button Text'),\n wbCTDAs\n ], [])\n ], False, nil, cpNormal, False, wbMESGAfterLoad);\n\n wbRecord(RGDL, 'Ragdoll', [\n wbEDIDReq,\n wbInteger(NVER, 'Version', itU32, nil, cpNormal, True),\n wbStruct(DATA, 'General Data', [\n wbInteger('Dynamic Bone Count', itU32),\n wbByteArray('Unused', 4),\n wbStruct('Enabled', [\n wbInteger('Feedback', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Foot IK (broken, don''t use)', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Look IK (broken, don''t use)', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Grab IK (broken, don''t use)', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Pose Matching', itU8, wbEnum(['No', 'Yes']))\n ]),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbFormIDCk(XNAM, 'Actor Base', [CREA, NPC_], False, cpNormal, True),\n wbFormIDCk(TNAM, 'Body Part Data', [BPTD], False, cpNormal, True),\n wbStruct(RAFD, 'Feedback Data', [\n {00} wbFloat('Dynamic/Keyframe Blend Amount'),\n {04} wbFloat('Hierarchy Gain'),\n {08} wbFloat('Position Gain'),\n {12} wbFloat('Velocity Gain'),\n {16} wbFloat('Acceleration Gain'),\n {20} wbFloat('Snap Gain'),\n {24} wbFloat('Velocity Damping'),\n wbStruct('Snap Max Settings', [\n {28} wbFloat('Linear Velocity'),\n {32} wbFloat('Angular Velocity'),\n {36} wbFloat('Linear Distance'),\n {40} wbFloat('Angular Distance')\n ]),\n wbStruct('Position Max Velocity', [\n {44} wbFloat('Linear'),\n {48} wbFloat('Angular')\n ]),\n wbStruct('Position Max Velocity', [\n {52} wbInteger('Projectile', itS32, wbDiv(1000)),\n {56} wbInteger('Melee', itS32, wbDiv(1000))\n ])\n ], cpNormal, False),\n wbArray(RAFB, 'Feedback Dynamic Bones', wbInteger('Bone', itU16), 0, nil, nil, cpNormal, False),\n wbStruct(RAPS, 'Pose Matching Data', [\n {00} wbArray('Match Bones', wbInteger('Bone', itU16, wbHideFFFF), 3),\n {06} wbInteger('Flags', itU8, wbFlags([\n 'Disable On Move'\n ])),\n {07} wbByteArray('Unused', 1),\n {08} wbFloat('Motors Strength'),\n {12} wbFloat('Pose Activation Delay Time'),\n {16} wbFloat('Match Error Allowance'),\n {20} wbFloat('Displacement To Disable')\n ], cpNormal, True),\n wbString(ANAM, 'Death Pose')\n ]);\n\n wbRecord(DOBJ, 'Default Object Manager', [\n wbEDIDReq,\n wbArray(DATA, 'Default Objects', wbFormID('Default Object'), [\n 'Stimpack',\n 'SuperStimpack',\n 'RadX',\n 'RadAway',\n 'Morphine',\n 'Perk Paralysis',\n 'Player Faction',\n 'Mysterious Stranger NPC',\n 'Mysterious Stranger Faction',\n 'Default Music',\n 'Battle Music',\n 'Death Music',\n 'Success Music',\n 'Level Up Music',\n 'Player Voice (Male)',\n 'Player Voice (Male Child)',\n 'Player Voice (Female)',\n 'Player Voice (Female Child)',\n 'Eat Package Default Food',\n 'Every Actor Ability',\n 'Drug Wears Off Image Space',\n 'Doctor''s Bag',\n 'Miss Fortune NPC',\n 'Miss Fortune Faction',\n 'Meltdown Explosion',\n 'Unarmed Forward PA',\n 'Unarmed Backward PA',\n 'Unarmed Left PA',\n 'Unarmed Right PA',\n 'Unarmed Crouch PA',\n 'Unarmed Counter PA',\n 'Spotter Effect',\n 'Item Detected Effect',\n 'Cateye Mobile Effect (NYI)'\n ], cpNormal, True)\n ]);\n\n wbRecord(LGTM, 'Lighting Template', [\n wbEDIDReq,\n wbStruct(DATA, 'Lighting', [\n wbStruct('Ambient Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Directional Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Fog Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Fog Near'),\n wbFloat('Fog Far'),\n wbInteger('Directional Rotation XY', itS32),\n wbInteger('Directional Rotation Z', itS32),\n wbFloat('Directional Fade'),\n wbFloat('Fog Clip Dist'),\n wbFloat('Fog Power')\n ], cpNormal, True)\n ]);\n\n wbRecord(MUSC, 'Music Type', [\n wbEDIDReq,\n wbString(FNAM, 'Filename'),\n wbFloat(ANAM, 'dB (positive = Loop)')\n ]);\n\n wbRecord(GRAS, 'Grass', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbStruct(DATA, '', [\n wbInteger('Density', itU8),\n wbInteger('Min Slope', itU8),\n wbInteger('Max Slope', itU8),\n wbByteArray('Unused', 1),\n wbInteger('Unit from water amount', itU16),\n wbByteArray('Unused', 2),\n wbInteger('Unit from water type', itU32, wbEnum([\n 'Above - At Least',\n 'Above - At Most',\n 'Below - At Least',\n 'Below - At Most',\n 'Either - At Least',\n 'Either - At Most',\n 'Either - At Most Above',\n 'Either - At Most Below'\n ])),\n wbFloat('Position Range'),\n wbFloat('Height Range'),\n wbFloat('Color Range'),\n wbFloat('Wave Period'),\n wbInteger('Flags', itU8, wbFlags([\n 'Vertex Lighting',\n 'Uniform Scaling',\n 'Fit to Slope'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, True)\n ]);\n\n wbRecord(HAIR, 'Hair', [\n wbEDIDReq,\n wbFULLReq,\n wbMODLReq,\n wbString(ICON, 'Texture', 0, cpNormal, True),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Playable',\n 'Not Male',\n 'Not Female',\n 'Fixed'\n ]), cpNormal, True)\n ]);\n\n wbRecord(IDLE, 'Idle Animation', [\n wbEDID,\n wbMODLReq,\n wbCTDAs,\n wbArray(ANAM, 'Related Idle Animations', wbFormIDCk('Related Idle Animation', [IDLE, NULL]), ['Parent', 'Previous Sibling'], cpNormal, True),\n wbStruct(DATA, '', [\n wbInteger('Animation Group Section', itU8, wbIdleAnam),\n wbStruct('Looping', [\n wbInteger('Min', itU8),\n wbInteger('Max', itU8)\n ]),\n wbByteArray('Unused', 1),\n wbInteger('Replay Delay', itS16),\n wbInteger('Flags', itU8, wbFlags([\n 'No attacking'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True, nil, 4)\n ]);\n\n wbRecord(INFO, 'Dialog response', [\n wbStruct(DATA, '', [\n wbInteger('Type', itU8, wbEnum([\n {0} 'Topic',\n {1} 'Conversation',\n {2} 'Combat',\n {3} 'Persuasion',\n {4} 'Detection',\n {5} 'Service',\n {6} 'Miscellaneous',\n {7} 'Radio'\n ])),\n wbInteger('Next Speaker', itU8, wbEnum([\n {0} 'Target',\n {1} 'Self',\n {2} 'Either'\n ])),\n wbInteger('Flags 1', itU8, wbFlags([\n {0x01} 'Goodbye',\n {0x02} 'Random',\n {0x04} 'Say Once',\n {0x08} 'Run Immediately',\n {0x10} 'Info Refusal',\n {0x20} 'Random End',\n {0x40} 'Run for Rumors',\n {0x80} 'Speech Challenge'\n ])),\n wbInteger('Flags 2', itU8, wbFlags([\n {0x01} 'Say Once a Day',\n {0x02} 'Always Darken',\n {0x04} 'Unknown 2',\n {0x08} 'Unknown 3',\n {0x10} 'Low Intelligence',\n {0x20} 'High Intelligence'\n ]))\n ], cpNormal, True, nil, 3),\n wbFormIDCkNoReach(QSTI, 'Quest', [QUST], False, cpNormal, True),\n wbFormIDCk(TPIC, 'Topic', [DIAL]), // The GECK ignores it for ESM\n wbFormIDCkNoReach(PNAM, 'Previous INFO', [INFO, NULL]),\n wbRArray('Add Topics', wbFormIDCk(NAME, 'Topic', [DIAL])),\n wbRArray('Responses',\n wbRStruct('Response', [\n wbStruct(TRDT, 'Response Data', [\n wbInteger('Emotion Type', itU32, wbEnum([\n {0} 'Neutral',\n {1} 'Anger',\n {2} 'Disgust',\n {3} 'Fear',\n {4} 'Sad',\n {5} 'Happy',\n {6} 'Surprise',\n {7} 'Pained'\n ])),\n wbInteger('Emotion Value', itS32),\n wbByteArray('Unused', 4),\n wbInteger('Response number', itU8),\n wbByteArray('Unused', 3),\n wbFormIDCk('Sound', [SOUN, NULL]),\n wbInteger('Flags', itU8, wbFlags([\n 'Use Emotion Animation'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, False, nil, 5),\n wbStringKC(NAM1, 'Response Text', 0, cpTranslate, True),\n wbString(NAM2, 'Script Notes', 0, cpTranslate, True),\n wbString(NAM3, 'Edits'),\n wbFormIDCk(SNAM, 'Speaker Animation', [IDLE]),\n wbFormIDCk(LNAM, 'Listener Animation', [IDLE])\n ], [])\n ),\n wbCTDAs,\n wbRArray('Choices', wbFormIDCk(TCLT, 'Choice', [DIAL])),\n wbRArray('Link From', wbFormIDCk(TCLF, 'Topic', [DIAL])),\n wbRArray('Unknown', wbFormIDCk(TCFU, 'Info', [INFO] )),\n wbRStruct('Script (Begin)', [\n wbEmbeddedScriptReq\n ], [], cpNormal, True),\n wbRStruct('Script (End)', [\n wbEmpty(NEXT, 'Marker'),\n wbEmbeddedScriptReq\n ], [], cpNormal, True),\n wbFormIDCk(SNDD, 'Unused', [SOUN]),\n wbString(RNAM, 'Prompt'),\n wbFormIDCk(ANAM, 'Speaker', [CREA, NPC_]),\n wbFormIDCk(KNAM, 'ActorValue/Perk', [AVIF, PERK]),\n wbInteger(DNAM, 'Speech Challenge', itU32, wbEnum([\n '---',\n 'Very Easy',\n 'Easy',\n 'Average',\n 'Hard',\n 'Very Hard'\n ]))\n ], False, wbINFOAddInfo, cpNormal, False, wbINFOAfterLoad);\n\n wbRecord(INGR, 'Ingredient', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbETYPReq,\n wbFloat(DATA, 'Weight', cpNormal, True),\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Value', itS32),\n wbInteger('Flags', itU8, wbFlags(['No auto-calculation', 'Food item'])),\n wbByteArray('Unused', 3)\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(KEYM, 'Key', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLReq,\n wbMODL,\n wbICONReq,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbFormIDCk(RNAM, 'Sound - Random/Looping', [SOUN])\n ]);\n\n wbQuadrantEnum := wbEnum([\n {0} 'Bottom Left',\n {1} 'Bottom Right',\n {2} 'Top Left',\n {3} 'Top Right'\n ]);\n\n if wbSimpleRecords then begin\n\n wbRecord(LAND, 'Landscape', [\n wbByteArray(DATA, 'Unknown'),\n wbByteArray(VNML, 'Vertex Normals'),\n wbByteArray(VHGT, 'Vertext Height Map'),\n wbByteArray(VCLR, 'Vertex Colours'),\n\n wbRArrayS('Layers', wbRUnion('Layer', [\n wbRStructSK([0],'Base Layer', [\n wbStructSK(BTXT, [1, 3], 'Base Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ])\n ], []),\n wbRStructSK([0],'Alpha Layer', [\n wbStructSK(ATXT, [1, 3], 'Alpha Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ]),\n wbByteArray(VTXT, 'Alpha Layer Data')\n ], [])\n ], [])),\n\n wbArray(VTEX, 'Textures', wbFormIDCk('Texture', [LTEX, NULL]))\n ]);\n\n end else begin\n\n wbRecord(LAND, 'Landscape', [\n wbByteArray(DATA, 'Unknown'),\n wbArray(VNML, 'Vertex Normals', wbStruct('Row', [\n wbArray('Columns', wbStruct('Column', [\n wbInteger('X', itU8),\n wbInteger('Y', itU8),\n wbInteger('Z', itU8)\n ]), 33)\n ]), 33),\n wbStruct(VHGT, 'Vertext Height Map', [\n wbFloat('Offset'),\n wbArray('Rows', wbStruct('Row', [\n wbArray('Columns', wbInteger('Column', itU8), 33)\n ]), 33),\n wbByteArray('Unused', 3)\n ]),\n wbArray(VCLR, 'Vertex Colours', wbStruct('Row', [\n wbArray('Columns', wbStruct('Column', [\n wbInteger('X', itU8),\n wbInteger('Y', itU8),\n wbInteger('Z', itU8)\n ]), 33)\n ]), 33),\n\n wbRArrayS('Layers', wbRUnion('Layer', [\n wbRStructSK([0],'Base Layer', [\n wbStructSK(BTXT, [1, 3], 'Base Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ])\n ], []),\n wbRStructSK([0],'Alpha Layer', [\n wbStructSK(ATXT, [1, 3], 'Alpha Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ]),\n wbArrayS(VTXT, 'Alpha Layer Data', wbStructSK([0], 'Cell', [\n wbInteger('Position', itU16, wbAtxtPosition),\n wbByteArray('Unused', 2),\n wbFloat('Opacity')\n ]))\n ], [])\n ], [])),\n\n wbArray(VTEX, 'Textures', wbFormIDCk('Texture', [LTEX, NULL]))\n ]);\n\n end;\n\n wbRecord(LIGH, 'Light', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODL,\n wbSCRI,\n wbDEST,\n wbFULL,\n wbICON,\n wbStruct(DATA, '', [\n wbInteger('Time', itS32),\n wbInteger('Radius', itU32),\n wbStruct('Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbInteger('Unused', itU8)\n ]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Dynamic',\n {0x00000002} 'Can be Carried',\n {0x00000004} 'Negative',\n {0x00000008} 'Flicker',\n {0x00000010} 'Unused',\n {0x00000020} 'Off By Default',\n {0x00000040} 'Flicker Slow',\n {0x00000080} 'Pulse',\n {0x00000100} 'Pulse Slow',\n {0x00000200} 'Spot Light',\n {0x00000400} 'Spot Shadow'\n ])),\n wbFloat('Falloff Exponent'),\n wbFloat('FOV'),\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbFloat(FNAM, 'Fade value', cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN])\n ], False, nil, cpNormal, False, wbLIGHAfterLoad);\n\n wbRecord(LSCR, 'Load Screen', [\n wbEDIDReq,\n wbICONReq,\n wbDESCReq,\n wbRArrayS('Locations', wbStructSK(LNAM, [0, 1], 'Location', [\n wbFormIDCk('Direct', [CELL, WRLD, NULL]),\n wbStructSK([0, 1], 'Indirect', [\n wbFormIDCk('World', [NULL, WRLD]),\n wbStructSK([0,1], 'Grid', [\n wbInteger('Y', itS16),\n wbInteger('X', itS16)\n ])\n ])\n ])),\n wbFormIDCk(WMI1, 'Load Screen Type', [LSCT])\n ]);\n\n wbRecord(LTEX, 'Landscape Texture', [\n wbEDIDReq,\n wbICON,\n wbFormIDCk(TNAM, 'Texture', [TXST], False, cpNormal, True),\n wbStruct(HNAM, 'Havok Data', [\n wbInteger('Material Type', itU8, wbEnum([\n {00} 'STONE',\n {01} 'CLOTH',\n {02} 'DIRT',\n {03} 'GLASS',\n {04} 'GRASS',\n {05} 'METAL',\n {06} 'ORGANIC',\n {07} 'SKIN',\n {08} 'WATER',\n {09} 'WOOD',\n {10} 'HEAVY STONE',\n {11} 'HEAVY METAL',\n {12} 'HEAVY WOOD',\n {13} 'CHAIN',\n {14} 'SNOW',\n {15} 'ELEVATOR',\n {16} 'HOLLOW METAL',\n {17} 'SHEET METAL',\n {18} 'SAND',\n {19} 'BRIKEN CONCRETE',\n {20} 'VEHILCE BODY',\n {21} 'VEHILCE PART SOLID',\n {22} 'VEHILCE PART HOLLOW',\n {23} 'BARREL',\n {24} 'BOTTLE',\n {25} 'SODA CAN',\n {26} 'PISTOL',\n {27} 'RIFLE',\n {28} 'SHOPPING CART',\n {29} 'LUNCHBOX',\n {30} 'BABY RATTLE',\n {31} 'RUBER BALL'\n ])),\n wbInteger('Friction', itU8),\n wbInteger('Restitution', itU8)\n ], cpNormal, True),\n wbInteger(SNAM, 'Texture Specular Exponent', itU8, nil, cpNormal, True),\n wbRArrayS('Grasses', wbFormIDCk(GNAM, 'Grass', [GRAS]))\n ]);\n\n wbRecord(LVLC, 'Leveled Creature', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(LVLD, 'Chance none', itU8, nil, cpNormal, True),\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count'\n ]), cpNormal, True),\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itS16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Reference', [CREA, LVLC]),\n wbInteger('Count', itS16),\n wbByteArray('Unused', 2)\n ]),\n wbCOED\n ], []),\n cpNormal, True),\n wbMODL\n ]);\n\n wbRecord(LVLN, 'Leveled NPC', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(LVLD, 'Chance none', itU8, nil, cpNormal, True),\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count'\n ]), cpNormal, True),\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itS16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Reference', [NPC_, LVLN]),\n wbInteger('Count', itS16),\n wbByteArray('Unused', 2)\n ]),\n wbCOED\n ], []),\n cpNormal, True),\n wbMODL\n ]);\n\n wbRecord(LVLI, 'Leveled Item', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(LVLD, 'Chance none', itU8, nil, cpNormal, True),\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count',\n {0x04} 'Use All'\n ]), cpNormal, True),\n wbFormIDCk(LVLG, 'Global', [GLOB]),\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itS16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Reference', [ARMO, AMMO, MISC, WEAP, BOOK, LVLI, KEYM, ALCH, NOTE, IMOD, CMNY, CCRD, CHIP]),\n wbInteger('Count', itS16),\n wbByteArray('Unused', 2)\n ]),\n wbCOED\n ], [])\n )\n ]);\n\n wbArchtypeEnum := wbEnum([\n {00} 'Value Modifier',\n {01} 'Script',\n {02} 'Dispel',\n {03} 'Cure Disease',\n {04} '',\n {05} '',\n {06} '',\n {07} '',\n {08} '',\n {09} '',\n {10} '',\n {11} 'Invisibility',\n {12} 'Chameleon',\n {13} 'Light',\n {14} '',\n {15} '',\n {16} 'Lock',\n {17} 'Open',\n {18} 'Bound Item',\n {19} 'Summon Creature',\n {20} '',\n {21} '',\n {22} '',\n {23} '',\n {24} 'Paralysis',\n {25} '',\n {26} '',\n {27} '',\n {28} '',\n {29} '',\n {30} 'Cure Paralysis',\n {31} 'Cure Addiction',\n {32} 'Cure Poison',\n {33} 'Concussion',\n {34} 'Value And Parts',\n {35} 'Limb Condition',\n {36} 'Turbo'\n ]);\n\n wbRecord(MGEF, 'Base Effect', [\n wbEDIDReq,\n wbFULL,\n wbDESCReq,\n wbICON,\n wbMODL,\n wbStruct(DATA, 'Data', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Hostile',\n {0x00000002} 'Recover',\n {0x00000004} 'Detrimental',\n {0x00000008} '',\n {0x00000010} 'Self',\n {0x00000020} 'Touch',\n {0x00000040} 'Target',\n {0x00000080} 'No Duration',\n {0x00000100} 'No Magnitude',\n {0x00000200} 'No Area',\n {0x00000400} 'FX Persist',\n {0x00000800} '',\n {0x00001000} 'Gory Visuals',\n {0x00002000} 'Display Name Only',\n {0x00004000} '',\n {0x00008000} 'Radio Broadcast ??',\n {0x00010000} '',\n {0x00020000} '',\n {0x00040000} '',\n {0x00080000} 'Use skill',\n {0x00100000} 'Use attribute',\n {0x00200000} '',\n {0x00400000} '',\n {0x00800000} '',\n {0x01000000} 'Painless',\n {0x02000000} 'Spray projectile type (or Fog if Bolt is specified as well)',\n {0x04000000} 'Bolt projectile type (or Fog if Spray is specified as well)',\n {0x08000000} 'No Hit Effect',\n {0x10000000} 'No Death Dispel',\n {0x20000000} '????'\n ])),\n {04} wbFloat('Base cost (Unused)'),\n {08} wbUnion('Assoc. Item', wbMGEFFAssocItemDecider, [\n wbFormID('Unused', cpIgnore),\n wbFormID('Assoc. Item'),\n wbFormIDCk('Assoc. Script', [SCPT, NULL]), //Script\n wbFormIDCk('Assoc. Item', [WEAP, ARMO, NULL]), //Bound Item\n wbFormIDCk('Assoc. Creature', [CREA]) //Summon Creature\n ], cpNormal, false, nil, wbMGEFFAssocItemAfterSet),\n {12} wbInteger('Magic School (Unused)', itS32, wbEnum([\n ], [\n -1, 'None'\n ])),\n {16} wbInteger('Resistance Type', itS32, wbActorValueEnum),\n {20} wbInteger('Counter effect count', itU16),\n {22} wbByteArray('Unused', 2),\n {24} wbFormIDCk('Light', [LIGH, NULL]),\n {28} wbFloat('Projectile speed'),\n {32} wbFormIDCk('Effect Shader', [EFSH, NULL]),\n {36} wbFormIDCk('Object Display Shader', [EFSH, NULL]),\n {40} wbFormIDCk('Effect sound', [NULL, SOUN]),\n {44} wbFormIDCk('Bolt sound', [NULL, SOUN]),\n {48} wbFormIDCk('Hit sound', [NULL, SOUN]),\n {52} wbFormIDCk('Area sound', [NULL, SOUN]),\n {56} wbFloat('Constant Effect enchantment factor (Unused)'),\n {60} wbFloat('Constant Effect barter factor (Unused)'),\n {64} wbInteger('Archtype', itU32, wbArchtypeEnum, cpNormal, False, nil, wbMGEFArchtypeAfterSet),\n {68} wbActorValue\n ], cpNormal, True),\n wbRArrayS('Counter Effects', wbFormIDCk(ESCE, 'Effect', [MGEF]), cpNormal, False, nil, wbCounterEffectsAfterSet)\n ], False, nil, cpNormal, False, wbMGEFAfterLoad, wbMGEFAfterSet);\n\n wbRecord(MISC, 'Misc. Item', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbFormIDCk(RNAM, 'Sound - Random/Looping', [SOUN])\n ]);\n\n wbRecord(COBJ, 'Constructible Object', [\n wbEDID,\n wbOBND,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ]);\n\n // floats are reported to change faces after copying\n if True {wbSimpleRecords} then begin\n wbFaceGen := wbRStruct('FaceGen Data', [\n wbByteArray(FGGS, 'FaceGen Geometry-Symmetric', 0, cpNormal, True),\n wbByteArray(FGGA, 'FaceGen Geometry-Asymmetric', 0, cpNormal, True),\n wbByteArray(FGTS, 'FaceGen Texture-Symmetric', 0, cpNormal, True)\n ], [], cpNormal, True);\n\n wbFaceGenNPC := wbRStruct('FaceGen Data', [ // Arrays of 4bytes elements\n wbByteArray(FGGS, 'FaceGen Geometry-Symmetric', 0, cpNormal, True),\n wbByteArray(FGGA, 'FaceGen Geometry-Asymmetric', 0, cpNormal, True),\n wbByteArray(FGTS, 'FaceGen Texture-Symmetric', 0, cpNormal, True)\n ], [], cpNormal, True, wbActorTemplateUseModelAnimation);\n end else begin\n wbFaceGen := wbRStruct('FaceGen Data', [\n wbArray(FGGS, 'FaceGen Geometry-Symmetric', wbFloat('Value'), [], cpNormal, True),\n wbArray(FGGA, 'FaceGen Geometry-Asymmetric', wbFloat('Value'), [], cpNormal, True),\n wbArray(FGTS, 'FaceGen Texture-Symmetric', wbFloat('Value'), [], cpNormal, True)\n ], [], cpNormal, True);\n\n wbFaceGenNPC := wbRStruct('FaceGen Data', [\n wbArray(FGGS, 'FaceGen Geometry-Symmetric', wbFloat('Value'), [], cpNormal, True),\n wbArray(FGGA, 'FaceGen Geometry-Asymmetric', wbFloat('Value'), [], cpNormal, True),\n wbArray(FGTS, 'FaceGen Texture-Symmetric', wbFloat('Value'), [], cpNormal, True)\n ], [], cpNormal, True, wbActorTemplateUseModelAnimation);\n end;\n\n wbRecord(NPC_, 'Non-Player Character', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLActor,\n wbMODLActor,\n wbStruct(ACBS, 'Configuration', [\n {00} wbInteger('Flags', itU32, wbFlags([\n {0x000001} 'Female',\n {0x000002} 'Essential',\n {0x000004} 'Is CharGen Face Preset',\n {0x000008} 'Respawn',\n {0x000010} 'Auto-calc stats',\n {0x000020} '',\n {0x000040} '',\n {0x000080} 'PC Level Mult',\n {0x000100} 'Use Template',\n {0x000200} 'No Low Level Processing',\n {0x000400} '',\n {0x000800} 'No Blood Spray',\n {0x001000} 'No Blood Decal',\n {0x002000} '',\n {0x004000} '',\n {0x008000} '',\n {0x010000} '',\n {0x020000} '',\n {0x040000} '',\n {0x080000} '',\n {0x100000} 'No VATS Melee',\n {0x00200000} '',\n {0x00400000} 'Can be all races',\n {0x00800000} 'Autocalc Service',\n {0x01000000} '',\n {0x02000000} '',\n {0x04000000} 'No Knockdowns',\n {0x08000000} 'Not Pushable',\n {0x10000000} 'Unknown 28',\n {0x20000000} '',\n {0x40000000} 'No Rotating To Head-track',\n {0x80000000} ''\n ], [\n {0x000001 Female} wbActorTemplateUseTraits,\n {0x000002 Essential} wbActorTemplateUseBaseData,\n {0x000004 Is CharGen Face Preset} nil,\n {0x000008 Respawn} wbActorTemplateUseBaseData,\n {0x000010 Auto-calc stats} wbActorTemplateUseStats,\n {0x000020 } nil,\n {0x000040 } nil,\n {0x000080 PC Level Mult} wbActorTemplateUseStats,\n {0x000100 Use Template} nil,\n {0x000200 No Low Level Processing} wbActorTemplateUseBaseData,\n {0x000400 } nil,\n {0x000800 No Blood Spray} wbActorTemplateUseModelAnimation,\n {0x001000 No Blood Decal} wbActorTemplateUseModelAnimation,\n {0x002000 } nil,\n {0x004000 } nil,\n {0x008000 } nil,\n {0x010000 } nil,\n {0x020000 } nil,\n {0x040000 } nil,\n {0x080000 } nil,\n {0x100000 No VATS Melee} nil,\n {0x00200000 } nil,\n {0x00400000 Can be all races} nil,\n {0x00800000 } nil,\n {0x01000000 } nil,\n {0x02000000 } nil,\n {0x04000000 No Knockdowns} nil,\n {0x08000000 Not Pushable} wbActorTemplateUseModelAnimation,\n {0x10000000 } nil,\n {0x20000000 } nil,\n {0x40000000 No Rotating To Head-track} wbActorTemplateUseModelAnimation,\n {0x80000000 } nil\n ])),\n {04} wbInteger('Fatigue', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {06} wbInteger('Barter gold', itU16, nil, cpNormal, False, wbActorTemplateUseAIData),\n {08} wbUnion('Level', wbCreaLevelDecider, [\n wbInteger('Level', itS16, nil, cpNormal, True, wbActorTemplateUseStats),\n wbInteger('Level Mult', itS16, wbDiv(1000), cpNormal, True, wbActorTemplateUseStats)\n ], cpNormal, True, wbActorTemplateUseStats),\n {10} wbInteger('Calc min', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {12} wbInteger('Calc max', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {14} wbInteger('Speed Multiplier', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {16} wbFloat('Karma (Alignment)', cpNormal, False, 1, -1, wbActorTemplateUseTraits),\n {20} wbInteger('Disposition Base', itS16, nil, cpNormal, False, wbActorTemplateUseTraits),\n {22} wbInteger('Template Flags', itU16, wbTemplateFlags)\n ], cpNormal, True),\n wbRArrayS('Factions',\n wbStructSK(SNAM, [0], 'Faction', [\n wbFormIDCk('Faction', [FACT]),\n wbInteger('Rank', itU8),\n wbByteArray('Unused', 3)\n ]),\n cpNormal, False, nil, nil, wbActorTemplateUseFactions),\n wbFormIDCk(INAM, 'Death item', [LVLI], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(VTCK, 'Voice', [VTYP], False, cpNormal, True, wbActorTemplateUseTraits),\n wbFormIDCk(TPLT, 'Template', [LVLN, NPC_]),\n wbFormIDCk(RNAM, 'Race', [RACE], False, cpNormal, True, wbActorTemplateUseTraits),\n wbSPLOs,\n wbFormIDCk(EITM, 'Unarmed Attack Effect', [ENCH, SPEL], False, cpNormal, False, wbActorTemplateUseActorEffectList),\n wbInteger(EAMT, 'Unarmed Attack Animation', itU16, wbAttackAnimationEnum, cpNormal, True, False, wbActorTemplateUseActorEffectList),\n wbDESTActor,\n wbSCRIActor,\n wbRArrayS('Items', wbCNTO, cpNormal, False, nil, nil, wbActorTemplateUseInventory),\n wbAIDT,\n wbRArray('Packages', wbFormIDCk(PKID, 'Package', [PACK]), cpNormal, False, nil, nil, wbActorTemplateUseAIPackages),\n wbArrayS(KFFZ, 'Animations', wbStringLC('Animation'), 0, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbFormIDCk(CNAM, 'Class', [CLAS], False, cpNormal, True, wbActorTemplateUseTraits),\n wbStruct(DATA, '', [\n {00} wbInteger('Base Health', itS32),\n {04} wbArray('Attributes', wbInteger('Attribute', itU8), [\n 'Strength',\n 'Perception',\n 'Endurance',\n 'Charisma',\n 'Intelligence',\n 'Agility',\n 'Luck'\n ], cpNormal, False, wbActorAutoCalcDontShow),\n wbByteArray('Unused'{, 14 - only present in old record versions})\n ], cpNormal, True, wbActorTemplateUseStats),\n wbStruct(DNAM, '', [\n {00} wbArray('Skill Values', wbInteger('Skill', itU8), [\n 'Barter',\n 'Big Guns (obsolete)',\n 'Energy Weapons',\n 'Explosives',\n 'Lockpick',\n 'Medicine',\n 'Melee Weapons',\n 'Repair',\n 'Science',\n 'Guns',\n 'Sneak',\n 'Speech',\n 'Survival',\n 'Unarmed'\n ]),\n {14} wbArray('Skill Offsets', wbInteger('Skill', itU8), [\n 'Barter',\n 'Big Guns (obsolete)',\n 'Energy Weapons',\n 'Explosives',\n 'Lockpick',\n 'Medicine',\n 'Melee Weapons',\n 'Repair',\n 'Science',\n 'Guns',\n 'Sneak',\n 'Speech',\n 'Survival',\n 'Unarmed'\n ])\n ], cpNormal, False, wbActorTemplateUseStatsAutoCalc),\n wbRArrayS('Head Parts',\n wbFormIDCk(PNAM, 'Head Part', [HDPT]),\n cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbFormIDCk(HNAM, 'Hair', [HAIR], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbFloat(LNAM, 'Hair length', cpNormal, False, 1, -1, wbActorTemplateUseModelAnimation),\n wbFormIDCk(ENAM, 'Eyes', [EYES], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbStruct(HCLR, 'Hair color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ], cpNormal, True, wbActorTemplateUseModelAnimation),\n wbFormIDCk(ZNAM, 'Combat Style', [CSTY], False, cpNormal, False, wbActorTemplateUseTraits),\n wbInteger(NAM4, 'Impact Material Type', itU32, wbImpactMaterialTypeEnum, cpNormal, True, False, wbActorTemplateUseModelAnimation),\n wbFaceGenNPC,\n wbInteger(NAM5, 'Unknown', itU16, nil, cpNormal, True, False, nil, nil, 255),\n wbFloat(NAM6, 'Height', cpNormal, True, 1, -1, wbActorTemplateUseTraits),\n wbFloat(NAM7, 'Weight', cpNormal, True, 1, -1, wbActorTemplateUseTraits)\n ], True, nil, cpNormal, False, wbNPCAfterLoad);\n\n wbPKDTFlags := wbFlags([\n {0x00000001} 'Offers Services',\n {0x00000002} 'Must reach location',\n {0x00000004} 'Must complete',\n {0x00000008} 'Lock doors at package start',\n {0x00000010} 'Lock doors at package end',\n {0x00000020} 'Lock doors at location',\n {0x00000040} 'Unlock doors at package start',\n {0x00000080} 'Unlock doors at package end',\n {0x00000100} 'Unlock doors at location',\n {0x00000200} 'Continue if PC near',\n {0x00000400} 'Once per day',\n {0x00000800} '',\n {0x00001000} 'Skip fallout behavior',\n {0x00002000} 'Always run',\n {0x00004000} '',\n {0x00008000} '',\n {0x00010000} '',\n {0x00020000} 'Always sneak',\n {0x00040000} 'Allow swimming',\n {0x00080000} 'Allow falls',\n {0x00100000} 'Head-Tracking off',\n {0x00200000} 'Weapons unequipped',\n {0x00400000} 'Defensive combat',\n {0x00800000} 'Weapon Drawn',\n {0x01000000} 'No idle anims',\n {0x02000000} 'Pretend In Combat',\n {0x04000000} 'Continue During Combat',\n {0x08000000} 'No Combat Alert',\n {0x10000000} 'No Warn/Attack Behaviour',\n {0x20000000} '',\n {0x40000000} '',\n {0x80000000} ''\n ]);\n\n wbPKDTType := wbEnum([\n {0} 'Find',\n {1} 'Follow',\n {2} 'Escort',\n {3} 'Eat',\n {4} 'Sleep',\n {5} 'Wander',\n {6} 'Travel',\n {7} 'Accompany',\n {8} 'Use Item At',\n {9} 'Ambush',\n {10} 'Flee Not Combat',\n {11} 'Package Type 11',\n {12} 'Sandbox',\n {13} 'Patrol',\n {14} 'Guard',\n {15} 'Dialogue',\n {16} 'Use Weapon',\n {17} 'Package Type 17',\n {18} 'Combat Controller',\n {19} 'Package Type 19',\n {20} 'Package Type 20',\n {21} 'Alarm',\n {22} 'Flee',\n {23} 'TressPass',\n {24} 'Spectator',\n {25} 'Package Type 25',\n {26} 'Package Type 26',\n {27} 'Package Type 27',\n {28} 'Dialogue 2',\n {29} 'Package Type 29',\n {30} 'Package Type 30',\n {31} 'Package Type 31',\n {32} 'Package Type 32',\n {33} 'Package Type 33',\n {34} 'Package Type 34',\n {35} 'Package Type 35',\n {36} 'Package Type 36',\n {37} 'Package Type 37',\n {38} 'Package Type 38',\n {39} 'Package Type 39',\n {40} 'Package Type 40'\n ]);\n\n wbObjectTypeEnum := wbEnum([\n ' NONE',\n 'Activators',\n 'Armor',\n 'Books',\n 'Clothing',\n 'Containers',\n 'Doors',\n 'Ingredients',\n 'Lights',\n 'Misc',\n 'Flora',\n 'Furniture',\n 'Weapons: Any',\n 'Ammo',\n 'NPCs',\n 'Creatures',\n 'Keys',\n 'Alchemy',\n 'Food',\n ' All: Combat Wearable',\n ' All: Wearable',\n 'Weapons: Ranged',\n 'Weapons: Melee',\n 'Weapons: NONE',\n 'Actor Effects: Any',\n 'Actor Effects: Range Target',\n 'Actor Effects: Range Touch',\n 'Actor Effects: Range Self',\n// '',\n 'Actors: Any'\n ]);\n\n\n wbPKDTSpecificFlagsUnused := True;\n\n wbRecord(PACK, 'Package', [\n wbEDIDReq,\n wbStruct(PKDT, 'General', [\n wbInteger('General Flags', itU32, wbPKDTFlags),\n wbInteger('Type', itU8, wbPKDTType),\n wbByteArray('Unused', 1),\n wbInteger('Fallout Behavior Flags', itU16, wbFlags([\n {0x00000001}'Hellos To Player',\n {0x00000002}'Random Conversations',\n {0x00000004}'Observe Combat Behavior',\n {0x00000008}'Unknown 4',\n {0x00000010}'Reaction To Player Actions',\n {0x00000020}'Friendly Fire Comments',\n {0x00000040}'Aggro Radius Behavior',\n {0x00000080}'Allow Idle Chatter',\n {0x00000100}'Avoid Radiation'\n ], True)),\n wbUnion('Type Specific Flags', wbPKDTSpecificFlagsDecider, [\n wbEmpty('Type Specific Flags (missing)', cpIgnore, False, nil, True),\n wbInteger('Type Specific Flags - Find', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Find - Allow Buying',\n {0x00000200}'Find - Allow Killing',\n {0x00000400}'Find - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Follow', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Escort', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Escort - Allow Buying',\n {0x00000200}'Escort - Allow Killing',\n {0x00000400}'Escort - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Eat', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Eat - Allow Buying',\n {0x00000200}'Eat - Allow Killing',\n {0x00000400}'Eat - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Sleep', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Wander', itU16, wbFlags([\n {0x00000001}'Wander - No Eating',\n {0x00000002}'Wander - No Sleeping',\n {0x00000004}'Wander - No Conversation',\n {0x00000008}'Wander - No Idle Markers',\n {0x00000010}'Wander - No Furniture',\n {0x00000020}'Wander - No Wandering'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Travel', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Accompany', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Use Item At', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'Use Item At - Sit Down',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Use Item At - Allow Buying',\n {0x00000200}'Use Item At - Allow Killing',\n {0x00000400}'Use Item At - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Ambush', itU16, wbFlags([\n {0x00000001}'Ambush - Hide While Ambushing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Flee Not Combat', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - ?', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Sandbox', itU16, wbFlags([\n {0x00000001}'Sandbox - No Eating',\n {0x00000002}'Sandbox - No Sleeping',\n {0x00000004}'Sandbox - No Conversation',\n {0x00000008}'Sandbox - No Idle Markers',\n {0x00000010}'Sandbox - No Furniture',\n {0x00000020}'Sandbox - No Wandering'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Patrol', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Guard', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'Guard - Remain Near Reference to Guard'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Dialogue', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Use Weapon', itU16, wbFlags([], wbPKDTSpecificFlagsUnused))\n ]),\n wbByteArray('Unused', 2)\n ], cpNormal, True, nil, 2),\n wbRStruct('Locations', [\n wbStruct(PLDT, 'Location 1', [\n wbInteger('Type', itS32, wbEnum([ // Byte + filler\n {0} 'Near reference',\n {1} 'In cell',\n {2} 'Near current location',\n {3} 'Near editor location',\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference',\n {7} 'At package location'\n ])),\n wbUnion('Location', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [REFR, PGRE, PMIS, PBEA, ACHR, ACRE, PLYR], True),\n wbFormIDCkNoReach('Cell', [CELL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, CHIP, CMNY, CCRD, IMOD]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Radius', itS32)\n ], cpNormal, True),\n wbStruct(PLD2, 'Location 2', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Near reference',\n {1} 'In cell',\n {2} 'Near current location',\n {3} 'Near editor location',\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference',\n {7} 'At package location'\n ])),\n wbUnion('Location', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [REFR, PGRE, PMIS, PBEA, ACHR, ACRE, PLYR], True),\n wbFormIDCkNoReach('Cell', [CELL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, CHIP, CMNY, CCRD, IMOD]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Radius', itS32)\n ])\n ], [], cpNormal, False, nil, True),\n wbStruct(PSDT, 'Schedule', [\n wbInteger('Month', itS8),\n wbInteger('Day of week', itS8, wbEnum([\n 'Sunday',\n 'Monday',\n 'Tuesday',\n 'Wednesday',\n 'Thursday',\n 'Friday',\n 'Saturday',\n 'Weekdays',\n 'Weekends',\n 'Monday, Wednesday, Friday',\n 'Tuesday, Thursday'\n ], [\n -1, 'Any'\n ])),\n wbInteger('Date', itU8),\n wbInteger('Time', itS8),\n wbInteger('Duration', itS32)\n ], cpNormal, True),\n wbStruct(PTDT, 'Target 1', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Specific Reference',\n {1} 'Object ID',\n {2} 'Object Type',\n {3} 'Linked Reference'\n ]), cpNormal, False, nil, nil, 2),\n wbUnion('Target', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [ACHR, ACRE, REFR, PGRE, PMIS, PBEA, PLYR], True),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, LVLN, LVLC, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, FACT, FLST, IDLM, CHIP, CMNY, CCRD, IMOD]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Count / Distance', itS32),\n wbFloat('Unknown')\n ], cpNormal, False, nil, 3),\n wbCTDAs,\n wbRStruct('Idle Animations', [\n wbInteger(IDLF, 'Flags', itU8, wbFlags([\n 'Run in Sequence',\n '',\n 'Do Once'\n ]), cpNormal, True),\n wbStruct(IDLC, '', [\n wbInteger( 'Animation Count', itU8),\n wbByteArray('Unused', 3)\n ], cpNormal, True, nil, 1),\n wbFloat(IDLT, 'Idle Timer Setting', cpNormal, True),\n wbArray(IDLA, 'Animations', wbFormIDCk('Animation', [IDLE]), 0, nil, wbIDLAsAfterSet, cpNormal, True),\n wbByteArray(IDLB, 'Unused', 4, cpIgnore)\n ], [], cpNormal, False, nil, False, nil {cannot be totally removed , wbAnimationsAfterSet}),\n wbFormIDCk(CNAM, 'Combat Style', [CSTY]),\n wbEmpty(PKED, 'Eat Marker'),\n wbInteger(PKE2, 'Escort Distance', itU32),\n wbFloat(PKFD, 'Follow - Start Location - Trigger Radius'),\n wbStruct(PKPT, 'Patrol Flags', [\n wbInteger('Repeatable', itU8, wbEnum(['No', 'Yes']), cpNormal, False, nil, nil, 1),\n wbByteArray('Unused', 1)\n ], cpNormal, False, nil, 1),\n wbStruct(PKW3, 'Use Weapon Data', [\n wbInteger('Flags', itU32, wbFlags([\n 'Always Hit',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Do No Damage',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Crouch To Reload',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Hold Fire When Blocked'\n ])),\n wbInteger('Fire Rate', itU8, wbEnum([\n 'Auto Fire',\n 'Volley Fire'\n ])),\n wbInteger('Fire Count', itU8, wbEnum([\n 'Number of Bursts',\n 'Repeat Fire'\n ])),\n wbInteger('Number of Bursts', itU16),\n wbStruct('Shoots Per Volleys', [\n wbInteger('Min', itU16),\n wbInteger('Max', itU16)\n ]),\n wbStruct('Pause Between Volleys', [\n wbFloat('Min'),\n wbFloat('Max')\n ]),\n wbByteArray('Unused', 4)\n ]),\n wbStruct(PTD2, 'Target 2', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Specific reference',\n {1} 'Object ID',\n {2} 'Object Type',\n {3} 'Linked Reference'\n ])),\n wbUnion('Target', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [ACHR, ACRE, REFR, PGRE, PMIS, PBEA, PLYR], True),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, LVLN, LVLC, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, FACT, FLST, CHIP, CMNY, CCRD, IMOD]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Count / Distance', itS32),\n wbFloat('Unknown')\n ], cpNormal, False, nil, 3),\n wbEmpty(PUID, 'Use Item Marker'),\n wbEmpty(PKAM, 'Ambush Marker'),\n wbStruct(PKDD, 'Dialogue Data', [\n wbFloat('FOV'),\n wbFormIDCk('Topic', [DIAL, NULL]),\n wbInteger('Flags', itU32, wbFlags([\n 'No Headtracking',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Don''t Control Target Movement'\n ])),\n wbByteArray('Unused', 4),\n wbInteger('Dialogue Type', itU32, wbEnum([\n 'Conversation',\n 'Say To'\n ])),\n wbByteArray('Unknown', 4)\n ], cpNormal, False, nil, 3),\n wbStruct(PLD2, 'Location 2 (again??)', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Near reference',\n {1} 'In cell',\n {2} 'Near current location',\n {3} 'Near editor location',\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference',\n {7} 'At package location'\n ])),\n wbUnion('Location', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [REFR, PGRE, PMIS, PBEA, ACHR, ACRE, PLYR], True),\n wbFormIDCkNoReach('Cell', [CELL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, CHIP, CMNY, CCRD, IMOD]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Radius', itS32)\n ]),\n wbRStruct('OnBegin', [\n wbEmpty(POBA, 'OnBegin Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('OnEnd', [\n wbEmpty(POEA, 'OnEnd Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('OnChange', [\n wbEmpty(POCA, 'OnChange Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], [], cpNormal, True)\n ], False, nil, cpNormal, False, wbPACKAfterLoad);\n\n wbRecord(QUST, 'Quest', [\n wbEDIDReq,\n wbSCRI,\n wbFULL,\n wbICON,\n wbStruct(DATA, 'General', [\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Start game enabled',\n {0x02} '',\n {0x04} 'Allow repeated conversation topics',\n {0x08} 'Allow repeated stages',\n {0x10} 'Unknown 4'\n ])),\n wbInteger('Priority', itU8),\n wbByteArray('Unused', 2),\n wbFloat('Quest Delay')\n ], cpNormal, True, nil, 3),\n wbCTDAs,\n wbRArrayS('Stages', wbRStructSK([0], 'Stage', [\n wbInteger(INDX, 'Stage Index', itS16),\n wbRArray('Log Entries', wbRStruct('Log Entry', [\n wbInteger(QSDT, 'Stage Flags', itU8, wbFlags([\n {0x01} 'Complete Quest',\n {0x02} 'Fail Quest'\n ])),\n wbCTDAs,\n wbString(CNAM, 'Log Entry', 0, cpTranslate),\n wbEmbeddedScriptReq,\n wbFormIDCk(NAM0, 'Next Quest', [QUST])\n ], []))\n ], [])),\n wbRArray('Objectives', wbRStruct('Objective', [\n wbInteger(QOBJ, 'Objective Index', itS32),\n wbString(NNAM, 'Description', 0, cpNormal, True),\n wbRArray('Targets', wbRStruct('Target', [\n wbStruct(QSTA, 'Target', [\n wbFormIDCkNoReach('Target', [REFR, PGRE, PMIS, PBEA, ACRE, ACHR], True),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Compass Marker Ignores Locks'\n ])),\n wbByteArray('Unused', 3)\n ]),\n wbCTDAs\n ], []))\n ], []))\n ]);\n\n wbHeadPartIndexEnum := wbEnum([\n 'Head',\n 'Ears',\n 'Mouth',\n 'Teeth Lower',\n 'Teeth Upper',\n 'Tongue',\n 'Left Eye',\n 'Right Eye'\n ]);\n\n wbBodyPartIndexEnum := wbEnum([\n 'Upper Body',\n 'Left Hand',\n 'Right Hand',\n 'Upper Body Texture'\n ]);\n\n wbRecord(RACE, 'Race', [\n wbEDIDReq,\n wbFULLReq,\n wbDESCReq,\n wbXNAMs,\n wbStruct(DATA, '', [\n wbArrayS('Skill Boosts', wbStructSK([0], 'Skill Boost', [\n wbInteger('Skill', itS8, wbActorValueEnum),\n wbInteger('Boost', itS8)\n ]), 7),\n wbByteArray('Unused', 2),\n wbFloat('Male Height'),\n wbFloat('Female Height'),\n wbFloat('Male Weight'),\n wbFloat('Female Weight'),\n wbInteger('Flags', itU32, wbFlags([\n 'Playable',\n '',\n 'Child'\n ]))\n ], cpNormal, True),\n wbFormIDCk(ONAM, 'Older', [RACE]),\n wbFormIDCk(YNAM, 'Younger', [RACE]),\n wbEmpty(NAM2, 'Unknown Marker', cpNormal, True),\n wbArray(VTCK, 'Voices', wbFormIDCk('Voice', [VTYP]), ['Male', 'Female'], cpNormal, True),\n wbArray(DNAM, 'Default Hair Styles', wbFormIDCk('Default Hair Style', [HAIR, NULL]), ['Male', 'Female'], cpNormal, True),\n wbArray(CNAM, 'Default Hair Colors', wbInteger('Default Hair Color', itU8, wbEnum([\n 'Bleached',\n 'Brown',\n 'Chocolate',\n 'Platinum',\n 'Cornsilk',\n 'Suede',\n 'Pecan',\n 'Auburn',\n 'Ginger',\n 'Honey',\n 'Gold',\n 'Rosewood',\n 'Black',\n 'Chestnut',\n 'Steel',\n 'Champagne'\n ])), ['Male', 'Female'], cpNormal, True),\n wbFloat(PNAM, 'FaceGen - Main clamp', cpNormal, True),\n wbFloat(UNAM, 'FaceGen - Face clamp', cpNormal, True),\n wbByteArray(ATTR, 'Unused', 0, cpNormal, True),\n wbRStruct('Head Data', [\n wbEmpty(NAM0, 'Head Data Marker', cpNormal, True),\n wbRStruct('Male Head Data', [\n wbEmpty(MNAM, 'Male Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbHeadPartIndexEnum),\n wbMODLReq,\n wbICON\n ], [], cpNormal, False, nil, False, nil, wbHeadPartsAfterSet), cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female Head Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbHeadPartIndexEnum),\n wbMODLReq,\n wbICON\n ], [], cpNormal, False, nil, False, nil, wbHeadPartsAfterSet), cpNormal, True)\n ], [], cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Body Data', [\n wbEmpty(NAM1, 'Body Data Marker', cpNormal, True),\n wbRStruct('Male Body Data', [\n wbEmpty(MNAM, 'Male Data Marker'),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbBodyPartIndexEnum),\n wbICON,\n wbMODLReq\n ], []), cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female Body Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbBodyPartIndexEnum),\n wbICON,\n wbMODLReq\n ], []), cpNormal, True)\n ], [], cpNormal, True)\n ], [], cpNormal, True),\n wbArrayS(HNAM, 'Hairs', wbFormIDCk('Hair', [HAIR]), 0, cpNormal, True),\n wbArrayS(ENAM, 'Eyes', wbFormIDCk('Eye', [EYES]), 0, cpNormal, True),\n wbRStruct('FaceGen Data', [\n wbRStruct('Male FaceGen Data', [\n wbEmpty(MNAM, 'Male Data Marker', cpNormal, True),\n wbFaceGen,\n wbInteger(SNAM, 'Unknown', itU16, nil, cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female FaceGen Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbFaceGen,\n wbInteger(SNAM, 'Unknown', itU16, nil, cpNormal, True)\t// will effectivly overwrite the SNAM from the male :)\n ], [], cpNormal, True)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(REFR, 'Placed Object', [\n wbEDID,\n {\n wbStruct(RCLR, 'Linked Reference Color (Old Format?)', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ], cpIgnore),}\n wbByteArray(RCLR, 'Unused', 0, cpIgnore),\n wbFormIDCk(NAME, 'Base', [TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, LVLN, LVLC,\n MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, CHIP,\n MSTT, NOTE, PWAT, SCOL, TACT, TERM, TXST, CCRD, IMOD, CMNY], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n {--- ?? ---}\n wbXRGD,\n wbXRGB,\n\n {--- Primitive ---}\n wbStruct(XPRM, 'Primitive', [\n wbStruct('Bounds', [\n wbFloat('X', cpNormal, True, 2, 4),\n wbFloat('Y', cpNormal, True, 2, 4),\n wbFloat('Z', cpNormal, True, 2, 4)\n ]),\n wbStruct('Color', [\n {84} wbFloat('Red', cpNormal, False, 255, 0),\n {88} wbFloat('Green', cpNormal, False, 255, 0),\n {92} wbFloat('Blue', cpNormal, False, 255, 0)\n ]),\n wbFloat('Unknown'),\n wbInteger('Type', itU32, wbEnum([\n 'None',\n 'Box',\n 'Sphere',\n 'Portal Box'\n ]))\n ]),\n wbInteger(XTRI, 'Collision Layer', itU32, wbEnum([\n 'Unidentified',\n 'Static',\n 'AnimStatic',\n 'Transparent',\n 'Clutter',\n 'Weapon',\n 'Projectile',\n 'Spell',\n 'Biped',\n 'Trees',\n 'Props',\n 'Water',\n 'Trigger',\n 'Terrain',\n 'Trap',\n 'Non Collidable',\n 'Cloud Trap',\n 'Ground',\n 'Portal',\n 'Debris Small',\n 'Debris Large',\n 'Acustic Space',\n 'Actor Zone',\n 'Projectile Zone',\n 'Gas Trap',\n 'Shell Casing',\n 'Transparent Small',\n 'Invisible Wall',\n 'Transparent Small Anim',\n 'Dead Bip',\n 'Char Controller',\n 'Avoid Box',\n 'Collision Box',\n 'Camera Sphere',\n 'Door Detection',\n 'Camera Pick',\n 'Item Pick',\n 'Line Of Sight',\n 'Path Pick',\n 'Custom Pick 1',\n 'Custom Pick 2',\n 'Spell Explosion',\n 'Dropping Pick'\n ])),\n wbEmpty(XMBP, 'MultiBound Primitive Marker'),\n\n {--- Bound Contents ---}\n\n {--- Bound Data ---}\n wbStruct(XMBO, 'Bound Half Extents', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n\n {--- Teleport ---}\n wbStruct(XTEL, 'Teleport Destination', [\n wbFormIDCk('Door', [REFR], True),\n wbPosRot,\n wbInteger('Flags', itU32, wbFlags([\n 'No Alarm'\n ]))\n ]),\n\n {--- Map Data ---}\n wbRStruct('Map Marker', [\n wbEmpty(XMRK, 'Map Marker Data'),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n {0x01} 'Visible',\n {0x02} 'Can Travel To',\n {0x04} '\"Show All\" Hidden'\n ]), cpNormal, True),\n wbFULLReq,\n wbStruct(TNAM, '', [\n wbInteger('Type', itU8, wbEnum([\n 'None',\n 'City',\n 'Settlement',\n 'Encampment',\n 'Natural Landmark',\n 'Cave',\n 'Factory',\n 'Monument',\n 'Military',\n 'Office',\n 'Town Ruins',\n 'Urban Ruins',\n 'Sewer Ruins',\n 'Metro',\n 'Vault'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbFormIDCk(WMI1, 'Reputation', [REPU])\n ], []),\n\n {--- Audio Data ---}\n wbRStruct('Audio Data', [\n wbEmpty(MMRK, 'Audio Marker'),\n wbUnknown(FULL),\n wbFormIDCk(CNAM, 'Audio Location', [ALOC]),\n wbInteger(BNAM, 'Flags', itU32, wbFlags(['Use Controller Values'])),\n wbFloat(MNAM, 'Layer 2 Trigger %', cpNormal, True, 100),\n wbFloat(NNAM, 'Layer 3 Trigger %', cpNormal, True, 100)\n ], []),\n\n wbInteger(XSRF, 'Special Rendering Flags', itU32, wbFlags([\n 'Unknown 0',\n 'Imposter',\n 'Use Full Shader in LOD'\n ])),\n wbByteArray(XSRD, 'Special Rendering Data', 4),\n\n {--- X Target Data ---}\n wbFormIDCk(XTRG, 'Target', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA], True),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Radio ---}\n wbStruct(XRDO, 'Radio Data', [\n wbFloat('Range Radius'),\n wbInteger('Broadcast Range Type', itU32, wbEnum([\n 'Radius',\n 'Everywhere',\n 'Worldspace and Linked Interiors',\n 'Linked Interiors',\n 'Current Cell Only'\n ])),\n wbFloat('Static Percentage'),\n wbFormIDCkNoReach('Position Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, NULL])\n ]),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Lock ---}\n wbStruct(XLOC, 'Lock Data', [\n wbInteger('Level', itU8),\n wbByteArray('Unused', 3),\n wbFormIDCkNoReach('Key', [KEYM, NULL]),\n wbInteger('Flags', itU8, wbFlags(['', '', 'Leveled Lock'])),\n wbByteArray('Unused', 3),\n wbByteArray('Unknown', 8)\n ], cpNormal, False, nil, 5),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n wbFloat(XRAD, 'Radiation'),\n wbFloat(XCHG, 'Charge'),\n wbRStruct('Ammo', [\n wbFormIDCk(XAMT, 'Type', [AMMO], False, cpNormal, True),\n wbInteger(XAMC, 'Count', itS32, nil, cpNormal, True)\n ], []),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Lit Water ---}\n wbRArrayS('Lit Water',\n wbFormIDCk(XLTW, 'Water', [REFR])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbString(XATO, 'Activation Prompt'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbInteger(XACT, 'Action Flag', itU32, wbFlags([\n 'Use Default',\n 'Activate',\n 'Open',\n 'Open by Default'\n ])),\n wbEmpty(ONAM, 'Open by Default'),\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- Generated Data ---}\n wbStruct(XNDP, 'Navigation Door Link', [\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbInteger('Teleport Marker Triangle', itS16, wbREFRNavmeshTriangleToStr, wbStringToInt),\n wbByteArray('Unused', 2)\n ]),\n\n wbArray(XPOD, 'Portal Data', wbFormIDCk('Room', [REFR, NULL]), 2),\n wbStruct(XPTL, 'Portal Data', [\n wbStruct('Size', [\n wbFloat('Width', cpNormal, False, 2),\n wbFloat('Height', cpNormal, False, 2)\n ]),\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation (Quaternion?)', [\n wbFloat('q1'),\n wbFloat('q2'),\n wbFloat('q3'),\n wbFloat('q4')\n ])\n ]),\n\n wbInteger(XSED, 'SpeedTree Seed', itU8),\n\n wbRStruct('Room Data', [\n wbStruct(XRMR, 'Header', [\n wbInteger('Linked Rooms Count', itU16),\n wbByteArray('Unknown', 2)\n ]),\n wbRArrayS('Linked Rooms',\n wbFormIDCk(XLRM, 'Linked Room', [REFR])\n )\n ], []),\n\n wbStruct(XOCP, 'Occlusion Plane Data', [\n wbStruct('Size', [\n wbFloat('Width', cpNormal, False, 2),\n wbFloat('Height', cpNormal, False, 2)\n ]),\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation (Quaternion?)', [\n wbFloat('q1'),\n wbFloat('q2'),\n wbFloat('q3'),\n wbFloat('q4')\n ])\n ]),\n wbArray(XORD, 'Linked Occlusion Planes', wbFormIDCk('Plane', [REFR, NULL]), [\n 'Right',\n 'Left',\n 'Bottom',\n 'Top'\n ]),\n\n wbXLOD,\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo, cpNormal, False, wbREFRAfterLoad);\n\n\n wbRecord(REGN, 'Region', [\n wbEDID,\n wbICON,\n wbStruct(RCLR, 'Map Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbFormIDCkNoReach(WNAM, 'Worldspace', [WRLD]),\n\n wbRArray('Region Areas', wbRStruct('Region Area', [\n wbInteger(RPLI, 'Edge Fall-off', itU32),\n wbArray(RPLD, 'Region Point List Data', wbStruct('Point', [\n wbFloat('X'),\n wbFloat('Y')\n ]), 0, wbRPLDAfterLoad)\n ], [])),\n\n wbRArrayS('Region Data Entries', wbRStructSK([0], 'Region Data Entry', [\n {always starts with an RDAT}\n wbStructSK(RDAT, [0], 'Data Header', [\n wbInteger('Type', itU32, wbEnum([\n {0}'',\n {1}'',\n {2}'Objects',\n {3}'Weather',\n {4}'Map',\n {5}'Land',\n {6}'Grass',\n {7}'Sound',\n {8}'Imposter',\n {9}''\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Override'\n ])),\n wbInteger('Priority', itU8),\n wbByteArray('Unused')\n ], cpNormal, True),\n\n {followed by one of these: }\n\n {--- Objects ---}\n wbArray(RDOT, 'Objects', wbStruct('Object', [\n wbFormIDCk('Object', [TREE, STAT, LTEX]),\n wbInteger('Parent Index', itU16, wbHideFFFF),\n wbByteArray('Unused', 2),\n wbFloat('Density'),\n wbInteger('Clustering', itU8),\n wbInteger('Min Slope', itU8),\n wbInteger('Max Slope', itU8),\n wbInteger('Flags', itU8, wbFlags([\n {0}'Conform to slope',\n {1}'Paint Vertices',\n {2}'Size Variance +/-',\n {3}'X +/-',\n {4}'Y +/-',\n {5}'Z +/-',\n {6}'Tree',\n {7}'Huge Rock'\n ])),\n wbInteger('Radius wrt Parent', itU16),\n wbInteger('Radius', itU16),\n wbFloat('Min Height'),\n wbFloat('Max Height'),\n wbFloat('Sink'),\n wbFloat('Sink Variance'),\n wbFloat('Size Variance'),\n wbStruct('Angle Variance', [\n wbInteger('X', itU16),\n wbInteger('Y', itU16),\n wbInteger('Z', itU16)\n ]),\n wbByteArray('Unused', 2),\n wbByteArray('Unknown', 4)\n ]), 0, nil, nil, cpNormal, False, wbREGNObjectsDontShow),\n\n {--- Map ---}\n wbString(RDMP, 'Map Name', 0, cpTranslate, False, wbREGNMapDontShow),\n\n {--- Grass ---}\n wbArrayS(RDGS, 'Grasses', wbStructSK([0], 'Grass', [\n wbFormIDCk('Grass', [GRAS]),\n wbByteArray('Unknown',4)\n ]), 0, cpNormal, False, nil, nil, wbREGNGrassDontShow),\n\n {--- Sound ---}\n wbInteger(RDMD, 'Music Type', itU32, wbMusicEnum, cpIgnore, False, False, wbNeverShow),\n wbFormIDCk(RDMO, 'Music', [MUSC], False, cpNormal, False, wbREGNSoundDontShow),\n wbFormIDCk(RDSI, 'Incidental MediaSet', [MSET], False, cpNormal, False, wbREGNSoundDontShow),\n wbRArray('Battle MediaSets', wbFormIDCk(RDSB, 'Battle MediaSet', [MSET]), cpNormal, False, nil, nil, wbREGNSoundDontShow),\n wbArrayS(RDSD, 'Sounds', wbStructSK([0], 'Sound', [\n wbFormIDCk('Sound', [SOUN]),\n wbInteger('Flags', itU32, wbFlags([\n 'Pleasant',\n 'Cloudy',\n 'Rainy',\n 'Snowy'\n ])),\n wbInteger('Chance', itU32, wbScaledInt4ToStr, wbScaledInt4ToInt)\n ]), 0, cpNormal, False, nil, nil, wbREGNSoundDontShow),\n\n {--- Weather ---}\n wbArrayS(RDWT, 'Weather Types', wbStructSK([0], 'Weather Type', [\n wbFormIDCk('Weather', [WTHR]),\n wbInteger('Chance', itU32),\n wbFormIDCk('Global', [GLOB, NULL])\n ]), 0, cpNormal, False, nil, nil, wbREGNWeatherDontShow),\n\n {--- Imposter ---}\n wbArrayS(RDID, 'Imposters', wbFormIDCk('Imposter', [REFR]), 0, cpNormal, False, nil, nil, wbREGNImposterDontShow)\n ], []))\n ], True);\n\n wbRecord(SOUN, 'Sound', [\n wbEDIDReq,\n wbOBNDReq,\n wbString(FNAM, 'Sound Filename'),\n wbInteger(RNAM, 'Random Chance %', itU8),\n wbRUnion('Sound Data', [\n wbStruct(SNDD, 'Sound Data', [\n wbInteger('Minimum Attentuation Distance', itU8, wbMul(5)),\n wbInteger('Maximum Attentuation Distance', itU8, wbMul(100)),\n wbInteger('Frequency Adjustment %', itS8),\n wbByteArray('Unused', 1),\n wbInteger('Flags', itU32, wbFlags([\n {0x0001} 'Random Frequency Shift',\n {0x0002} 'Play At Random',\n {0x0004} 'Environment Ignored',\n {0x0008} 'Random Location',\n {0x0010} 'Loop',\n {0x0020} 'Menu Sound',\n {0x0040} '2D',\n {0x0080} '360 LFE',\n {0x0100} 'Dialogue Sound',\n {0x0200} 'Envelope Fast',\n {0x0400} 'Envelope Slow',\n {0x0800} '2D Radius',\n {0x1000} 'Mute When Submerged',\n {0x2000} 'Start at Random Position'\n ])),\n wbInteger('Static attentuation cdB', itS16),\n wbInteger('Stop time ', itU8),\n wbInteger('Start time ', itU8),\n wbArray('Attenuation Curve', wbInteger('Point', itS16), 5),\n wbInteger('Reverb Attenuation Control', itS16),\n wbInteger('Priority', itS32),\n// wbByteArray('Unknown', 8)\n wbInteger('x', itS32),\n wbInteger('y', itS32)\n\n ], cpNormal, True),\n wbStruct(SNDX, 'Sound Data', [\n wbInteger('Minimum attentuation distance', itU8, wbMul(5)),\n wbInteger('Maximum attentuation distance', itU8, wbMul(100)),\n wbInteger('Frequency adjustment %', itS8),\n wbByteArray('Unused', 1),\n wbInteger('Flags', itU32, wbFlags([\n {0x0001} 'Random Frequency Shift',\n {0x0002} 'Play At Random',\n {0x0004} 'Environment Ignored',\n {0x0008} 'Random Location',\n {0x0010} 'Loop',\n {0x0020} 'Menu Sound',\n {0x0040} '2D',\n {0x0080} '360 LFE',\n {0x0100} 'Dialogue Sound',\n {0x0200} 'Envelope Fast',\n {0x0400} 'Envelope Slow',\n {0x0800} '2D Radius',\n {0x1000} 'Mute When Submerged'\n ])),\n wbInteger('Static attentuation cdB', itS16),\n wbInteger('Stop time ', itU8),\n wbInteger('Start time ', itU8)\n ], cpNormal, True)\n ], [], cpNormal, True),\n wbArray(ANAM, 'Attenuation Curve', wbInteger('Point', itS16), 5, nil, nil, cpNormal, False, wbNeverShow),\n wbInteger(GNAM, 'Reverb Attenuation Control', itS16, nil, cpNormal, False, False, wbNeverShow),\n wbInteger(HNAM, 'Priority', itS32, nil, cpNormal, False, False, wbNeverShow)\n ], False, nil, cpNormal, False, wbSOUNAfterLoad);\n\n wbRecord(SPEL, 'Actor Effect', [\n wbEDIDReq,\n wbFULL,\n wbStruct(SPIT, '', [\n wbInteger('Type', itU32, wbEnum([\n {0} 'Actor Effect',\n {1} 'Disease',\n {2} 'Power',\n {3} 'Lesser Power',\n {4} 'Ability',\n {5} 'Poison',\n {6} '',\n {7} '',\n {8} '',\n {9} '',\n {10} 'Addiction'\n ])),\n wbInteger('Cost (Unused)', itU32),\n wbInteger('Level (Unused)', itU32, wbEnum([\n {0} 'Unused'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n {0x00000001} 'No Auto-Calc',\n {0x00000002} 'Immune to Silence 1?',\n {0x00000004} 'PC Start Effect',\n {0x00000008} 'Immune to Silence 2?',\n {0x00000010} 'Area Effect Ignores LOS',\n {0x00000020} 'Script Effect Always Applies',\n {0x00000040} 'Disable Absorb/Reflect',\n {0x00000080} 'Force Touch Explode'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(STAT, 'Static', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODL,\n wbInteger(BRUS, 'Passthrough Sound', itS8, wbEnum([\n 'BushA',\n 'BushB',\n 'BushC',\n 'BushD',\n 'BushE',\n 'BushF',\n 'BushG',\n 'BushH',\n 'BushI',\n 'BushJ'\n ], [\n -1, 'NONE'\n ])),\n wbFormIDCk(RNAM, 'Sound - Looping/Random', [SOUN])\n ]);\n\n wbRecord(TES4, 'Main File Header', [\n wbStruct(HEDR, 'Header', [\n wbFloat('Version'),\n wbInteger('Number of Records', itU32),\n wbInteger('Next Object ID', itU32)\n ], cpNormal, True),\n wbByteArray(OFST, 'Unknown', 0, cpIgnore),\n wbByteArray(DELE, 'Unknown', 0, cpIgnore),\n wbString(CNAM, 'Author', 0, cpTranslate, True),\n wbString(SNAM, 'Description', 0, cpTranslate),\n wbRArray('Master Files', wbRStruct('Master File', [\n wbString(MAST, 'Filename', 0, cpNormal, True),\n wbByteArray(DATA, 'Unused', 8, cpIgnore, True)\n ], [ONAM])),\n wbArray(ONAM, 'Overriden Forms', wbFormIDCk('Form', [REFR, ACHR, ACRE, PMIS, PBEA, PGRE, LAND, NAVM]), 0, nil, nil, cpNormal, False, wbTES4ONAMDontShow),\n wbByteArray(SCRN, 'Screenshot')\n ], True, nil, cpNormal, True, wbRemoveOFST);\n\n wbRecord(TREE, 'Tree', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbICONReq,\n wbArrayS(SNAM, 'SpeedTree Seeds', wbInteger('SpeedTree Seed', itU32), 0, cpNormal, True),\n wbStruct(CNAM, 'Tree Data', [\n wbFloat('Leaf Curvature'),\n wbFloat('Minimum Leaf Angle'),\n wbFloat('Maximum Leaf Angle'),\n wbFloat('Branch Dimming Value'),\n wbFloat('Leaf Dimming Value'),\n wbInteger('Shadow Radius', itS32),\n wbFloat('Rock Speed'),\n wbFloat('Rustle Speed')\n ], cpNormal, True),\n wbStruct(BNAM, 'Billboard Dimensions', [\n wbFloat('Width'),\n wbFloat('Height')\n ], cpNormal, True)\n ]);\nend;\n\nprocedure DefineFNVf;\nbegin\n wbRecord(WATR, 'Water', [\n wbEDIDReq,\n wbFULL,\n wbString(NNAM, 'Noise Map', 0, cpNormal, True),\n wbInteger(ANAM, 'Opacity', itU8, nil, cpNormal, True),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n {0}'Causes Damage',\n {1}'Reflective'\n ]), cpNormal, True),\n wbString(MNAM, 'Material ID', 0, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN]),\n wbFormIDCk(XNAM, 'Actor Effect', [SPEL]),\n wbInteger(DATA, 'Damage', itU16, nil, cpNormal, True, True),\n wbRUnion('Visual Data', [\n wbStruct(DNAM, 'Visual Data', [\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Water Properties - Sun Power'),\n wbFloat('Water Properties - Reflectivity Amount'),\n wbFloat('Water Properties - Fresnel Amount'),\n wbByteArray('Unused', 4),\n wbFloat('Fog Properties - Above Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Above Water - Fog Distance - Far Plane'),\n wbStruct('Shallow Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Deep Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Reflection Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbByteArray('Unused', 4),\n wbFloat('Rain Simulator - Force'),\n wbFloat('Rain Simulator - Velocity'),\n wbFloat('Rain Simulator - Falloff'),\n wbFloat('Rain Simulator - Dampner'),\n wbFloat('Displacement Simulator - Starting Size'),\n wbFloat('Displacement Simulator - Force'),\n wbFloat('Displacement Simulator - Velocity'),\n wbFloat('Displacement Simulator - Falloff'),\n wbFloat('Displacement Simulator - Dampner'),\n wbFloat('Rain Simulator - Starting Size'),\n wbFloat('Noise Properties - Normals - Noise Scale'),\n wbFloat('Noise Properties - Noise Layer One - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer One - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Speed'),\n wbFloat('Noise Properties - Normals - Depth Falloff Start'),\n wbFloat('Noise Properties - Normals - Depth Falloff End'),\n wbFloat('Fog Properties - Above Water - Fog Amount'),\n wbFloat('Noise Properties - Normals - UV Scale'),\n wbFloat('Fog Properties - Under Water - Fog Amount'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Far Plane'),\n wbFloat('Water Properties - Distortion Amount'),\n wbFloat('Water Properties - Shininess'),\n wbFloat('Water Properties - Reflection HDR Multiplier'),\n wbFloat('Water Properties - Light Radius'),\n wbFloat('Water Properties - Light Brightness'),\n wbFloat('Noise Properties - Noise Layer One - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Two - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Three - UV Scale'),\n wbFloat('Noise Properties - Noise Layer One - Amplitude Scale'),\n wbFloat('Noise Properties - Noise Layer Two - Amplitude Scale'),\n wbFloat('Noise Properties - Noise Layer Three - Amplitude Scale')\n ], cpNormal, True, nil, 46),\n wbStruct(DATA, 'Visual Data', [\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Water Properties - Sun Power'),\n wbFloat('Water Properties - Reflectivity Amount'),\n wbFloat('Water Properties - Fresnel Amount'),\n wbByteArray('Unused', 4),\n wbFloat('Fog Properties - Above Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Above Water - Fog Distance - Far Plane'),\n wbStruct('Shallow Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Deep Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Reflection Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbByteArray('Unused', 4),\n wbFloat('Rain Simulator - Force'),\n wbFloat('Rain Simulator - Velocity'),\n wbFloat('Rain Simulator - Falloff'),\n wbFloat('Rain Simulator - Dampner'),\n wbFloat('Displacement Simulator - Starting Size'),\n wbFloat('Displacement Simulator - Force'),\n wbFloat('Displacement Simulator - Velocity'),\n wbFloat('Displacement Simulator - Falloff'),\n wbFloat('Displacement Simulator - Dampner'),\n wbFloat('Rain Simulator - Starting Size'),\n wbFloat('Noise Properties - Normals - Noise Scale'),\n wbFloat('Noise Properties - Noise Layer One - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer One - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Speed'),\n wbFloat('Noise Properties - Normals - Depth Falloff Start'),\n wbFloat('Noise Properties - Normals - Depth Falloff End'),\n wbFloat('Fog Properties - Above Water - Fog Amount'),\n wbFloat('Noise Properties - Normals - UV Scale'),\n wbFloat('Fog Properties - Under Water - Fog Amount'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Far Plane'),\n wbFloat('Water Properties - Distortion Amount'),\n wbFloat('Water Properties - Shininess'),\n wbFloat('Water Properties - Reflection HDR Multiplier'),\n wbFloat('Water Properties - Light Radius'),\n wbFloat('Water Properties - Light Brightness'),\n wbFloat('Noise Properties - Noise Layer One - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Two - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Three - UV Scale'),\n wbEmpty('Noise Properties - Noise Layer One - Amplitude Scale'),\n wbEmpty('Noise Properties - Noise Layer Two - Amplitude Scale'),\n wbEmpty('Noise Properties - Noise Layer Three - Amplitude Scale'),\n wbInteger('Damage (Old Format)', itU16)\n ], cpNormal, True)\n ], [], cpNormal, True),\n wbStruct(GNAM, 'Related Waters (Unused)', [\n wbFormIDCk('Daytime', [WATR, NULL]),\n wbFormIDCk('Nighttime', [WATR, NULL]),\n wbFormIDCk('Underwater', [WATR, NULL])\n ], cpNormal, True)\n ], False, nil, cpNormal, False, wbWATRAfterLoad);\n\n wbRecord(WEAP, 'Weapon', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbEITM,\n wbInteger(EAMT, 'Enchantment Charge Amount', itS16),\n wbFormIDCkNoReach(NAM0, 'Ammo', [AMMO, FLST]),\n wbDEST,\n wbREPL,\n wbETYPReq,\n wbBIPL,\n wbYNAM,\n wbZNAM,\n wbRStruct('Shell Casing Model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO2S\n ], []),\n wbRStruct('Scope Model', [\n wbString(MOD3, 'Model Filename'),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO3S\n ], []),\n wbFormIDCK(EFSD, 'Scope Effect', [EFSH]),\n wbRStruct('World Model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO4S\n ], []),\n wbString(MWD1, 'Model - Mod 1'),\n wbString(MWD2, 'Model - Mod 2'),\n wbString(MWD3, 'Model - Mod 1 and 2'),\n wbString(MWD4, 'Model - Mod 3'),\n wbString(MWD5, 'Model - Mod 1 and 3'),\n wbString(MWD6, 'Model - Mod 2 and 3'),\n wbString(MWD7, 'Model - Mod 1, 2 and 3'),\n {wbRStruct( 'Model with Mods', [\n wbString(MWD1, 'Mod 1'),\n wbString(MWD2, 'Mod 2'),\n wbString(MWD3, 'Mod 1 and 2'),\n wbString(MWD4, 'Mod 3'),\n wbString(MWD5, 'Mod 1 and 3'),\n wbString(MWD6, 'Mod 2 and 3'),\n wbString(MWD7, 'Mod 1, 2 and 3')\n ], [], cpNormal, False, nil, True),}\n\n wbString(VANM, 'VATS Attack Name'),\n wbString(NNAM, 'Embedded Weapon Node'),\n\n wbFormIDCk(INAM, 'Impact DataSet', [IPDS]),\n wbFormIDCk(WNAM, '1st Person Model', [STAT]),\n wbFormIDCk(WNM1, '1st Person Model - Mod 1', [STAT]),\n wbFormIDCk(WNM2, '1st Person Model - Mod 2', [STAT]),\n wbFormIDCk(WNM3, '1st Person Model - Mod 1 and 2', [STAT]),\n wbFormIDCk(WNM4, '1st Person Model - Mod 3', [STAT]),\n wbFormIDCk(WNM5, '1st Person Model - Mod 1 and 3', [STAT]),\n wbFormIDCk(WNM6, '1st Person Model - Mod 2 and 3', [STAT]),\n wbFormIDCk(WNM7, '1st Person Model - Mod 1, 2 and 3', [STAT]),\n {wbRStruct('1st Person Models with Mods', [\n wbFormIDCk(WNM1, 'Mod 1', [STAT]),\n wbFormIDCk(WNM2, 'Mod 2', [STAT]),\n wbFormIDCk(WNM3, 'Mod 1 and 2', [STAT]),\n wbFormIDCk(WNM4, 'Mod 3', [STAT]),\n wbFormIDCk(WNM5, 'Mod 1 and 3', [STAT]),\n wbFormIDCk(WNM6, 'Mod 2 and 3', [STAT]),\n wbFormIDCk(WNM7, 'Mod 1, 2 and 3', [STAT])\n ], [], cpNormal, False, nil, True),}\n wbFormIDCk(WMI1, 'Weapon Mod 1', [IMOD]),\n wbFormIDCk(WMI2, 'Weapon Mod 2', [IMOD]),\n wbFormIDCk(WMI3, 'Weapon Mod 3', [IMOD]),\n {wbRStruct('Weapon Mods', [\n wbFormIDCk(WMI1, 'Mod 1', [IMOD]),\n wbFormIDCk(WMI2, 'Mod 2', [IMOD]),\n wbFormIDCk(WMI3, 'Mod 3', [IMOD])\n ], [], cpNormal, False, nil, True),}\n wbRStruct('Sound - Gun', [\n wbFormIDCk(SNAM, 'Shoot 3D', [SOUN]),\n wbFormIDCk(SNAM, 'Shoot Dist', [SOUN])\n ], []),\n //wbFormIDCk(SNAM, 'Sound - Gun - Shoot 3D', [SOUN]),\n //wbFormIDCk(SNAM, 'Sound - Gun - Shoot Dist', [SOUN]),\n wbFormIDCk(XNAM, 'Sound - Gun - Shoot 2D', [SOUN]),\n wbFormIDCk(NAM7, 'Sound - Gun - Shoot 3D Looping', [SOUN]),\n wbFormIDCk(TNAM, 'Sound - Melee - Swing / Gun - No Ammo', [SOUN]),\n wbFormIDCk(NAM6, 'Sound - Block', [SOUN]),\n wbFormIDCk(UNAM, 'Sound - Idle', [SOUN]),\n wbFormIDCk(NAM9, 'Sound - Equip', [SOUN]),\n wbFormIDCk(NAM8, 'Sound - Unequip', [SOUN]),\n wbRStruct('Sound - Mod 1', [\n wbFormIDCk(WMS1, 'Shoot 3D', [SOUN]),\n wbFormIDCk(WMS1, 'Shoot Dist', [SOUN])\n ], []),\n //wbFormIDCk(WMS1, 'Sound - Mod 1 - Shoot 3D', [SOUN]),\n //wbFormIDCk(WMS1, 'Sound - Mod 1 - Shoot Dist', [SOUN]),\n wbFormIDCk(WMS2, 'Sound - Mod 1 - Shoot 2D', [SOUN]),\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbInteger('Health', itS32),\n wbFloat('Weight'),\n wbInteger('Base Damage', itS16),\n wbInteger('Clip Size', itU8)\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n {00} wbInteger('Animation Type', itU32, wbWeaponAnimTypeEnum),\n {04} wbFloat('Animation Multiplier'),\n {08} wbFloat('Reach'),\n {12} wbInteger('Flags 1', itU8, wbFlags([\n 'Ignores Normal Weapon Resistance',\n 'Is Automatic',\n 'Has Scope',\n 'Can''t Drop',\n 'Hide Backpack',\n 'Embedded Weapon',\n 'Don''t Use 1st Person IS Animations',\n 'Non-Playable'\n ])),\n {13} wbInteger('Grip Animation', itU8, wbEnum([\n ], [\n 230, 'HandGrip1',\n 231, 'HandGrip2',\n 232, 'HandGrip3',\n 233, 'HandGrip4',\n 234, 'HandGrip5',\n 235, 'HandGrip6',\n 255, 'DEFAULT'\n ])),\n {14} wbInteger('Ammo Use', itU8),\n {15} wbInteger('Reload Animation', itU8, wbReloadAnimEnum),\n {16} wbFloat('Min Spread'),\n {20} wbFloat('Spread'),\n {24} wbFloat('Unknown'),\n {28} wbFloat('Sight FOV'),\n {32} wbFloat,\n {36} wbFormIDCk('Projectile', [PROJ, NULL]),\n {40} wbInteger('Base VATS To-Hit Chance', itU8),\n {41} wbInteger('Attack Animation', itU8, wbEnum([\n ], [\n 26, 'AttackLeft',\n 32, 'AttackRight',\n 38, 'Attack3',\n 44, 'Attack4',\n 50, 'Attack5',\n 56, 'Attack6',\n 62, 'Attack7',\n 68, 'Attack8',\n 144, 'Attack9',\n 74, 'AttackLoop',\n 80, 'AttackSpin',\n 86, 'AttackSpin2',\n 114, 'AttackThrow',\n 120, 'AttackThrow2',\n 126, 'AttackThrow3',\n 132, 'AttackThrow4',\n 138, 'AttackThrow5',\n 150, 'AttackThrow6',\n 156, 'AttackThrow7',\n 162, 'AttackThrow8',\n 102, 'PlaceMine',\n 108, 'PlaceMine2',\n 255, 'DEFAULT'\n ])),\n {42} wbInteger('Projectile Count', itU8),\n {43} wbInteger('Embedded Weapon - Actor Value', itU8, wbEnum([\n {00} 'Perception',\n {01} 'Endurance',\n {02} 'Left Attack',\n {03} 'Right Attack',\n {04} 'Left Mobility',\n {05} 'Right Mobilty',\n {06} 'Brain'\n ])),\n {44} wbFloat('Min Range'),\n {48} wbFloat('Max Range'),\n {52} wbInteger('On Hit', itU32, wbEnum([\n 'Normal formula behavior',\n 'Dismember Only',\n 'Explode Only',\n 'No Dismember/Explode'\n ])),\n {56} wbInteger('Flags 2', itU32, wbFlags([\n {0x00000001}'Player Only',\n {0x00000002}'NPCs Use Ammo',\n {0x00000004}'No Jam After Reload',\n {0x00000008}'Override - Action Points',\n {0x00000010}'Minor Crime',\n {0x00000020}'Range - Fixed',\n {0x00000040}'Not Used In Normal Combat',\n {0x00000080}'Override - Damage to Weapon Mult',\n {0x00000100}'Don''t Use 3rd Person IS Animations',\n {0x00000200}'Short Burst',\n {0x00000400}'Rumble Alternate',\n {0x00000800}'Long Burst',\n {0x00001000}'Scope has NightVision',\n {0x00002000}'Scope from Mod'\n ])),\n {60} wbFloat('Animation Attack Multiplier'),\n {64} wbFloat('Fire Rate'),\n {68} wbFloat('Override - Action Points'),\n {72} wbFloat('Rumble - Left Motor Strength'),\n {76} wbFloat('Rumble - Right Motor Strength'),\n {80} wbFloat('Rumble - Duration'),\n {84} wbFloat('Override - Damage to Weapon Mult'),\n {88} wbFloat('Attack Shots/Sec'),\n {92} wbFloat('Reload Time'),\n {96} wbFloat('Jam Time'),\n {100} wbFloat('Aim Arc'),\n {104} wbInteger('Skill', itS32, wbActorValueEnum),\n {108} wbInteger('Rumble - Pattern', itU32, wbEnum([\n 'Constant',\n 'Square',\n 'Triangle',\n 'Sawtooth'\n ])),\n {112} wbFloat('Rumble - Wavelength'),\n {116} wbFloat('Limb Dmg Mult'),\n {120} wbInteger('Resist Type', itS32, wbActorValueEnum),\n {124} wbFloat('Sight Usage'),\n {128} wbFloat('Semi-Automatic Fire Delay Min'),\n {132} wbFloat('Semi-Automatic Fire Delay Max'),\n wbFloat,\n wbInteger('Effect - Mod 1', itU32, wbModEffectEnum),\n wbInteger('Effect - Mod 2', itU32, wbModEffectEnum),\n wbInteger('Effect - Mod 3', itU32, wbModEffectEnum),\n wbFloat('Value A - Mod 1'),\n wbFloat('Value A - Mod 2'),\n wbFloat('Value A - Mod 3'),\n wbInteger('Power Attack Animation Override', itU32, wbEnum([\n ], [\n 0, '0?',\n 97, 'AttackCustom1Power',\n 98, 'AttackCustom2Power',\n 99, 'AttackCustom3Power',\n 100, 'AttackCustom4Power',\n 101, 'AttackCustom5Power',\n 255, 'DEFAULT'\n ])),\n wbInteger('Strength Req', itU32),\n wbByteArray('Unknown', 1),\n wbInteger('Reload Animation - Mod', itU8, wbReloadAnimEnum),\n wbByteArray('Unknown', 2),\n wbFloat('Regen Rate'),\n wbFloat('Kill Impulse'),\n wbFloat('Value B - Mod 1'),\n wbFloat('Value B - Mod 2'),\n wbFloat('Value B - Mod 3'),\n wbFloat('Impulse Dist'),\n wbInteger('Skill Req', itU32)\n ], cpNormal, True, nil, 36),\n\n wbStruct(CRDT, 'Critical Data', [\n {00} wbInteger('Critical Damage', itU16),\n {09} wbByteArray('Unused', 2),\n {04} wbFloat('Crit % Mult'),\n {08} wbInteger('Flags', itU8, wbFlags([\n 'On Death'\n ])),\n {09} wbByteArray('Unused', 3),\n {12} wbFormIDCk('Effect', [SPEL, NULL])\n ], cpNormal, True),\n wbStruct(VATS, 'VATS', [\n wbFormIDCk('Effect',[SPEL, NULL]),\n wbFloat('Skill'),\n wbFloat('Dam. Mult'),\n wbFloat('AP'),\n wbInteger('Silent', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Mod Required', itU8, wbEnum(['No', 'Yes'])),\n wbByteArray('Unused', 2)\n ]),\n wbInteger(VNAM, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ], True, nil, cpNormal, False, wbWEAPAfterLoad);\n\n if wbSimpleRecords then\n wbRecord(WRLD, 'Worldspace', [\n wbEDIDReq,\n wbFULL,\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbRStruct('Parent', [\n wbFormIDCk(WNAM, 'Worldspace', [WRLD]),\n wbInteger(PNAM, 'Flags', itU16, wbFlags([\n {0x00000001}'Use Land Data',\n {0x00000002}'Use LOD Data',\n {0x00000004}'Use Map Data',\n {0x00000008}'Use Water Data',\n {0x00000010}'Use Climate Data',\n {0x00000020}'Use Image Space Data'\n ], True), cpNormal, True)\n ], []),\n wbFormIDCk(CNAM, 'Climate', [CLMT]),\n wbFormIDCk(NAM2, 'Water', [WATR]),\n wbFormIDCk(NAM3, 'LOD Water Type', [WATR]),\n wbFloat(NAM4, 'LOD Water Height'),\n wbStruct(DNAM, 'Land Data', [\n wbFloat('Default Land Height'),\n wbFloat('Default Water Height')\n ]),\n wbICON,\n wbStruct(MNAM, 'Map Data', [\n wbStruct('Usable Dimensions', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32)\n ]),\n wbStruct('Cell Coordinates', [\n wbStruct('NW Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbStruct('SE Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ])\n ])\n ]),\n wbStruct(ONAM, 'World Map Offset Data', [\n wbFloat('World Map Scale'),\n wbFloat('Cell X Offset'),\n wbFloat('Cell Y Offset')\n ], cpNormal, True),\n wbFormIDCk(INAM, 'Image Space', [IMGS]),\n wbInteger(DATA, 'Flags', itU8, wbFlags([ // LoadForm supports a DWord here, but only first byte would be used.\n {0x01} 'Small World',\n {0x02} 'Can''t Fast Travel',\n {0x04} '',\n {0x08} '',\n {0x10} 'No LOD Water',\n {0x20} 'No LOD Noise',\n {0x40} 'Don''t Allow NPC Fall Damage',\n {0x80} 'Needs Water Adjustment'\n ]), cpNormal, True),\n wbRStruct('Object Bounds', [\n wbStruct(NAM0, 'Min', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True),\n wbStruct(NAM9, 'Max', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True)\n ], []),\n wbFormIDCk(ZNAM, 'Music', [MUSC]),\n wbString(NNAM, 'Canopy Shadow', 0, cpNormal, True),\n wbString(XNAM, 'Water Noise Texture', 0, cpNormal, True),\n wbRArrayS('Swapped Impacts', wbStructExSK(IMPS, [0, 1], [2], 'Swapped Impact', [\n wbInteger('Material Type', itU32, wbImpactMaterialTypeEnum),\n wbFormIDCkNoReach('Old', [IPCT]),\n wbFormIDCk('New', [IPCT, NULL])\n ])),\n wbArray(IMPF, 'Footstep Materials', wbString('Unknown', 30), [\n 'ConcSolid',\n 'ConcBroken',\n 'MetalSolid',\n 'MetalHollow',\n 'MetalSheet',\n 'Wood',\n 'Sand',\n 'Dirt',\n 'Grass',\n 'Water'\n ]),\n wbByteArray(OFST, 'Offset Data')\n ], False, nil, cpNormal, False, wbRemoveOFST)\n else\n wbRecord(WRLD, 'Worldspace', [\n wbEDIDReq,\n wbFULL,\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbRStruct('Parent', [\n wbFormIDCk(WNAM, 'Worldspace', [WRLD]),\n wbInteger(PNAM, 'Flags', itU16, wbFlags([\n {0x00000001}'Use Land Data',\n {0x00000002}'Use LOD Data',\n {0x00000004}'Use Map Data',\n {0x00000008}'Use Water Data',\n {0x00000010}'Use Climate Data',\n {0x00000020}'Use Image Space Data' // in order to use this \"Image Space\" needs to be NULL.\n // Other parent flags are checked before the form value.\n ], True), cpNormal, True)\n ], []),\n wbFormIDCk(CNAM, 'Climate', [CLMT]),\n wbFormIDCk(NAM2, 'Water', [WATR]),\n wbFormIDCk(NAM3, 'LOD Water Type', [WATR]),\n wbFloat(NAM4, 'LOD Water Height'),\n wbStruct(DNAM, 'Land Data', [\n wbFloat('Default Land Height'),\n wbFloat('Default Water Height')\n ]),\n wbICON,\n wbStruct(MNAM, 'Map Data', [\n wbStruct('Usable Dimensions', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32)\n ]),\n wbStruct('Cell Coordinates', [\n wbStruct('NW Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbStruct('SE Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ])\n ])\n ]),\n wbStruct(ONAM, 'World Map Offset Data', [\n wbFloat('World Map Scale'),\n wbFloat('Cell X Offset'),\n wbFloat('Cell Y Offset')\n ], cpNormal, True),\n wbFormIDCk(INAM, 'Image Space', [IMGS]),\n wbInteger(DATA, 'Flags', itU8, wbFlags([ // LoadForm supports a DWord here, but only first byte would be used.\n {0x01} 'Small World',\n {0x02} 'Can''t Fast Travel',\n {0x04} '',\n {0x08} '',\n {0x10} 'No LOD Water',\n {0x20} 'No LOD Noise',\n {0x40} 'Don''t Allow NPC Fall Damage',\n {0x80} 'Needs Water Adjustment'\n ]), cpNormal, True),\n wbRStruct('Object Bounds', [\n wbStruct(NAM0, 'Min', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True),\n wbStruct(NAM9, 'Max', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True)\n ], []),\n wbFormIDCk(ZNAM, 'Music', [MUSC]),\n wbString(NNAM, 'Canopy Shadow', 0, cpNormal, True),\n wbString(XNAM, 'Water Noise Texture', 0, cpNormal, True),\n wbRArrayS('Swapped Impacts', wbStructExSK(IMPS, [0, 1], [2], 'Swapped Impact', [\n wbInteger('Material Type', itU32, wbImpactMaterialTypeEnum),\n wbFormIDCkNoReach('Old', [IPCT]),\n wbFormIDCk('New', [IPCT, NULL])\n ])),\n wbArray(IMPF, 'Footstep Materials', wbString('Unknown', 30), [\n 'ConcSolid',\n 'ConcBroken',\n 'MetalSolid',\n 'MetalHollow',\n 'MetalSheet',\n 'Wood',\n 'Sand',\n 'Dirt',\n 'Grass',\n 'Water'\n ]),\n wbArray(OFST, 'Offset Data', wbArray('Rows', wbInteger('Offset', itU32), wbOffsetDataColsCounter), 0) // cannot be saved by GECK\n ], False, nil, cpNormal, False, wbRemoveOFST);\n\n wbRecord(WTHR, 'Weather', [\n wbEDIDReq,\n wbFormIDCk(_0_IAD, 'Sunrise Image Space Modifier', [IMAD]),\n wbFormIDCk(_1_IAD, 'Day Image Space Modifier', [IMAD]),\n wbFormIDCk(_2_IAD, 'Sunset Image Space Modifier', [IMAD]),\n wbFormIDCk(_3_IAD, 'Night Image Space Modifier', [IMAD]),\n wbFormIDCk(_4_IAD, 'Unknown', [IMAD]),\n wbFormIDCk(_5_IAD, 'Unknown', [IMAD]),\n wbString(DNAM, 'Cloud Textures - Layer 0', 0, cpNormal, True),\n wbString(CNAM, 'Cloud Textures - Layer 1', 0, cpNormal, True),\n wbString(ANAM, 'Cloud Textures - Layer 2', 0, cpNormal, True),\n wbString(BNAM, 'Cloud Textures - Layer 3', 0, cpNormal, True),\n wbMODL,\n wbByteArray(LNAM, 'Unknown', 4, cpNormal, True),\n wbArray(ONAM, 'Cloud Speed', wbInteger('Layer', itU8{, wbDiv(2550)}), 4, nil, nil, cpNormal, True),\n wbArray(PNAM, 'Cloud Layer Colors',\n wbArray('Layer',\n wbStruct('Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n ['Sunrise', 'Day', 'Sunset', 'Night', 'High Noon', 'Midnight']\n ),\n 4),\n wbArray(NAM0, 'Colors by Types/Times',\n wbArray('Type',\n wbStruct('Time', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n ['Sunrise', 'Day', 'Sunset', 'Night', 'High Noon', 'Midnight']\n ),\n ['Sky-Upper','Fog','Unused','Ambient','Sunlight','Sun','Stars','Sky-Lower','Horizon','Unused']\n , cpNormal, True),\n wbStruct(FNAM, 'Fog Distance', [\n wbFloat('Day - Near'),\n wbFloat('Day - Far'),\n wbFloat('Night - Near'),\n wbFloat('Night - Far'),\n wbFloat('Day - Power'),\n wbFloat('Night - Fower')\n ], cpNormal, True),\n wbByteArray(INAM, 'Unused', 304, cpIgnore, True),\n wbStruct(DATA, '', [\n wbInteger('Wind Speed', itU8),\n wbInteger('Cloud Speed (Lower)', itU8),\n wbInteger('Cloud Speed (Upper)', itU8),\n wbInteger('Trans Delta', itU8),\n wbInteger('Sun Glare', itU8),\n wbInteger('Sun Damage', itU8),\n wbInteger('Precipitation - Begin Fade In', itU8),\n wbInteger('Precipitation - End Fade Out', itU8),\n wbInteger('Thunder/Lightning - Begin Fade In', itU8),\n wbInteger('Thunder/Lightning - End Fade Out', itU8),\n wbInteger('Thunder/Lightning - Frequency', itU8),\n wbInteger('Weather Classification', itU8, wbWthrDataClassification),\n wbStruct('Lightning Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8)\n ])\n ], cpNormal, True),\n wbRArray('Sounds', wbStruct(SNAM, 'Sound', [\n wbFormIDCk('Sound', [SOUN]),\n wbInteger('Type', itU32, wbEnum([\n {0}'Default',\n {1}'Precip',\n {2}'Wind',\n {3}'Thunder'\n ]))\n ]))\n ]);\n\n wbRecord(IMOD, 'Item Mod', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDESC,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ])\n ]);\n\n wbRecord(ALOC, 'Media Location Controller', [\n wbEDIDReq,\n wbFULL,\n wbByteArray(NAM1, 'Flags and Enums, messily combined'),\n wbUnknown(NAM2),\n wbUnknown(NAM3),\n wbFloat(NAM4, 'Location Delay'),\n wbInteger(NAM5, 'Day Start', itU32, wbAlocTime),\n wbInteger(NAM6, 'Night Start', itU32, wbAlocTime),\n wbFloat(NAM7, 'Retrigger Delay'),\n wbRArrayS('Neutral Sets',\n wbFormIDCk(HNAM, 'Media Set', [MSET])\n ),\n wbRArrayS('Ally Sets',\n wbFormIDCk(ZNAM, 'Media Set', [MSET])\n ),\n wbRArrayS('Friend Sets',\n wbFormIDCk(XNAM, 'Media Set', [MSET])\n ),\n wbRArrayS('Enemy Sets',\n wbFormIDCk(YNAM, 'Media Set', [MSET])\n ),\n wbRArrayS('Location Sets',\n wbFormIDCk(LNAM, 'Media Set', [MSET])\n ),\n wbRArrayS('Battle Sets',\n wbFormIDCk(GNAM, 'Media Set', [MSET])\n ),\n wbFormIDCk(RNAM, 'Conditional Faction', [FACT]),\n wbUnknown(FNAM)\n ]);\n\n wbRecord(MSET, 'Media Set', [\n wbEDIDReq,\n wbFULL,\n wbInteger(NAM1, 'Type', itU32, wbEnum([\n 'Battle Set',\n 'Location Set',\n 'Dungeon Set',\n 'Incidental Set'\n ], [\n -1, 'No Set'\n ])),\n wbString(NAM2, 'Loop (B) / Battle (D) / Day Outer (L)'),\n wbString(NAM3, 'Explore (D) / Day Middle (L)'),\n wbString(NAM4, 'Suspense (D) / Day Inner (L)'),\n wbString(NAM5, 'Night Outer (L)'),\n wbString(NAM6, 'Night Middle (L)'),\n wbString(NAM7, 'Night Inner (L)'),\n wbFloat(NAM8, 'Loop dB (B) / Battle dB (D) / Day Outer dB (L)'),\n wbFloat(NAM9, 'Explore dB (D) / Day Middle dB (L)'),\n wbFloat(NAM0, 'Suspense dB (D) / Day Inner dB (L)'),\n wbFloat(ANAM, 'Night Outer dB (L)'),\n wbFloat(BNAM, 'Night Middle dB (L)'),\n wbFloat(CNAM, 'Night Inner dB (L)'),\n wbFloat(JNAM, 'Day Outer Boundary % (L)'),\n wbFloat(KNAM, 'Day Middle Boundary % (L)'),\n wbFloat(LNAM, 'Day Inner Boundary % (L)'),\n wbFloat(MNAM, 'Night Outer Boundary % (L)'),\n wbFloat(NNAM, 'Night Middle Boundary % (L)'),\n wbFloat(ONAM, 'Night Inner Boundary % (L)'),\n wbInteger(PNAM, 'Enable Flags', itU8, wbFlags([\n {0x01} 'Day Outer',\n {0x02} 'Day Middle',\n {0x04} 'Day Inner',\n {0x08} 'Night Outer',\n {0x10} 'Night Middle',\n {0x20} 'Night Inner'\n ])),\n wbFloat(DNAM, 'Wait Time (B) / Minimum Time On (D,L) / Daytime Min (I)'),\n wbFloat(ENAM, 'Loop Fade Out (B) / Looping/Random Crossfade Overlap (D,L) / Nighttime Min (I)'),\n wbFloat(FNAM, 'Recovery Time (B) / Layer Crossfade Time (D,L) / Daytime Max (I)'),\n wbFloat(GNAM, 'Nighttime Max (I)'),\n wbFormIDCk(HNAM, 'Intro (B,D) / Daytime (I)', [SOUN]),\n wbFormIDCk(INAM, 'Outro (B,D) / Nighttime (I)', [SOUN]),\n wbUnknown(DATA)\n ]);\n\n wbRecord(AMEF, 'Ammo Effect', [\n wbEDIDReq,\n wbFULL,\n wbStruct(DATA, 'Data', [\n wbInteger('Type', itU32, wbEnum([\n 'Damage Mod',\n 'DR Mod',\n 'DT Mod',\n 'Spread Mod',\n 'Weapon Condition Mod',\n 'Fatigue Mod'\n ])),\n wbInteger('Operation', itU32, wbEnum([\n 'Add',\n 'Multiply',\n 'Subtract'\n ])),\n wbFloat('Value')\n ])\n ]);\n\n wbRecord(CCRD, 'Caravan Card', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbYNAM,\n wbZNAM,\n wbRStruct('High Res Image', [\n wbString(TX00, 'Face'),\n wbString(TX01, 'Back')\n ], []),\n wbRStruct('Card', [\n wbInteger(INTV, 'Suit', itU32, wbEnum([\n '',\n 'Hearts',\n 'Spades',\n 'Diamonds',\n 'Clubs',\n 'Joker'\n ])),\n wbInteger(INTV, 'Value', itU32, wbEnum([\n '',\n 'Ace',\n '2',\n '3',\n '4',\n '5',\n '6',\n '7',\n '8',\n '9',\n '10',\n '',\n 'Jack',\n 'Queen',\n 'King',\n 'Joker'\n ]))\n ], []),\n wbInteger(DATA, 'Value', itU32)\n ]);\n\n wbRecord(CDCK, 'Caravan Deck', [\n wbEDIDReq,\n wbFULL,\n wbRArrayS('Cards',\n wbFormIDCk(CARD, 'Card', [CCRD])\n ),\n wbInteger(DATA, 'Count (broken)', itU32)\n ]);\n\n wbRecord(CHAL, 'Challenge', [\n wbEDIDReq,\n wbFULL,\n wbICON,\n wbSCRI,\n wbDESC,\n wbStruct(DATA, 'Data', [\n wbInteger('Type', itU32, wbEnum([\n {00} 'Kill from a Form List',\n {01} 'Kill a specific FormID',\n {02} 'Kill any in a category',\n {03} 'Hit an Enemy',\n {04} 'Discover a Map Marker',\n {05} 'Use an Item',\n {06} 'Acquire an Item',\n {07} 'Use a Skill',\n {08} 'Do Damage',\n {09} 'Use an Item from a List',\n {10} 'Acquire an Item from a List',\n {11} 'Miscellaneous Stat',\n {12} 'Craft Using an Item',\n {13} 'Scripted Challenge'\n ])),\n wbInteger('Threshold', itU32),\n wbInteger('Flags', itU32, wbFlags([\n 'Start Disabled',\n 'Recurring',\n 'Show Zero Progress'\n ])),\n wbInteger('Interval', itU32),\n wbByteArray('(depends on type)', 2),\n wbByteArray('(depends on type)', 2),\n wbByteArray('(depends on type)', 4)\n ]),\n wbFormID(SNAM, '(depends on type)'),\n wbFormID(XNAM, '(depends on type)')\n ]);\n\n wbRecord(CHIP, 'Casino Chip', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbDEST,\n wbYNAM,\n wbZNAM\n ]);\n\n wbRecord(CMNY, 'Caravan Money', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbYNAM,\n wbZNAM,\n wbInteger(DATA, 'Absolute Value', itU32)\n ]);\n\n wbRecord(CSNO, 'Casino', [\n wbEDIDReq,\n wbFULL,\n wbStruct(DATA, 'Data', [\n wbFloat('Decks % Before Shuffle'),\n wbFloat('BlackJack Payout Ratio'),\n wbArray('Slot Reel Stops', wbInteger('Reel', itU32),[\n 'Symbol 1',\n 'Symbol 2',\n 'Symbol 3',\n 'Symbol 4',\n 'Symbol 5',\n 'Symbol 6',\n 'Symbol W'\n ]),\n wbInteger('Number of Decks', itU32),\n wbInteger('Max Winnings', itU32),\n wbFormIDCk('Currency', [CHIP]),\n wbFormIDCk('Casino Winnings Quest', [QUST]),\n wbInteger('Flags', itU32, wbFlags([\n 'Dealer Stay on Soft 17'\n ]))\n ]),\n wbRStruct('Casino Chip Models', [\n wbString(MODL, '$1 Chip'),\n wbString(MODL, '$5 Chip'),\n wbString(MODL, '$10 Chip'),\n wbString(MODL, '$25 Chip'),\n wbString(MODL, '$100 Chip'),\n wbString(MODL, '$500 Chip'),\n wbString(MODL, 'Roulette Chip')\n ], []),\n wbString(MODL, 'Slot Machine Model'),\n wbString(MOD2, 'Slot Machine Model (again?)'),\n wbString(MOD3, 'BlackJack Table Model'),\n wbString(MODT, 'BlackJack Table Model related'),\n wbString(MOD4, 'Roulette Table Model'),\n wbRStruct('Slot Reel Textures', [\n wbString(ICON, 'Symbol 1'),\n wbString(ICON, 'Symbol 2'),\n wbString(ICON, 'Symbol 3'),\n wbString(ICON, 'Symbol 4'),\n wbString(ICON, 'Symbol 5'),\n wbString(ICON, 'Symbol 6'),\n wbString(ICON, 'Symbol W')\n ], []),\n wbRStruct('BlackJack Decks', [\n wbString(ICO2, 'Deck 1'),\n wbString(ICO2, 'Deck 2'),\n wbString(ICO2, 'Deck 3'),\n wbString(ICO2, 'Deck 4')\n ], [])\n ]);\n\n wbRecord(DEHY, 'Dehydration Stage', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbInteger('Trigger Threshold', itU32),\n wbFormIDCk('Actor Effect', [SPEL])\n ], cpNormal, True)\n ]);\n\n wbRecord(HUNG, 'Hunger Stage', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbInteger('Trigger Threshold', itU32),\n wbFormIDCk('Actor Effect', [SPEL])\n ], cpNormal, True)\n ]);\n\n wbRecord(LSCT, 'Load Screen Type', [\n wbEDIDReq,\n wbStruct(DATA, 'Data', [\n wbInteger('Type', itU32, wbEnum([\n 'None',\n 'XP Progress',\n 'Objective',\n 'Tip',\n 'Stats'\n ])),\n wbStruct('Data 1', [\n wbInteger('X', itU32),\n wbInteger('Y', itU32),\n wbInteger('Width', itU32),\n wbInteger('Height', itU32),\n wbFloat('Orientation', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbInteger('Font', itU32, wbEnum([\n '',\n '2',\n '3',\n '4',\n '5',\n '6',\n '7',\n '8'\n ])),\n wbStruct('Font Color', [\n wbFloat('R'),\n wbFloat('G'),\n wbFloat('B')\n ]),\n wbInteger('Font', itU32, wbEnum([\n '',\n 'Left',\n 'Center',\n '',\n 'Right'\n ]))\n ]),\n wbByteArray('Unknown', 20),\n wbStruct('Data 2', [\n wbInteger('Font', itU32, wbEnum([\n '',\n '2',\n '3',\n '4',\n '5',\n '6',\n '7',\n '8'\n ])),\n wbStruct('Font Color', [\n wbFloat('R'),\n wbFloat('G'),\n wbFloat('B')\n ]),\n wbByteArray('', 4),\n wbInteger('Stats', itU32, wbEnum([\n '',\n '2',\n '3',\n '4',\n '5',\n '6',\n '7',\n '8'\n ]))\n ])\n ])\n ]);\n\n wbRecord(RCCT, 'Recipe Category', [\n wbEDIDReq,\n wbFULL,\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Subcategory?',\n '',\n '',\n '',\n '',\n '',\n '',\n ''\n ]))\n ]);\n\n wbRecord(RCPE, 'Recipe', [\n wbEDIDReq,\n wbFULL,\n wbCTDAs,\n wbStruct(DATA, 'Data', [\n wbInteger('Skill', itS32, wbActorValueEnum),\n wbInteger('Level', itU32),\n wbFormIDCk('Category', [RCCT, NULL]), // Some of DeadMoney are NULL\n wbFormIDCk('Sub-Category', [RCCT])\n ]),\n wbRStructs('Ingredients', 'Ingredient', [\n wbFormIDCk(RCIL, 'Item', [ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, NOTE, IMOD, CMNY, CCRD, CHIP, LIGH], False, cpNormal, True),\n wbInteger(RCQY, 'Quantity', itU32, nil, cpNormal, True)\n ], []),\n wbRStructs('Outputs', 'Output', [\n wbFormIDCk(RCOD, 'Item', [ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, NOTE, IMOD, CMNY, CCRD, CHIP, LIGH], False, cpNormal, True),\n wbInteger(RCQY, 'Quantity', itU32, nil, cpNormal, True)\n ], [])\n ]);\n\n wbRecord(REPU, 'Reputation', [\n wbEDIDReq,\n wbFULL,\n wbICON,\n wbFloat(DATA, 'Value')\n ]);\n\n wbRecord(SLPD, 'Sleep Deprivation Stage', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbInteger('Trigger Threshold', itU32),\n wbFormIDCk('Actor Effect', [SPEL])\n ], cpNormal, True)\n ]);\n\n wbAddGroupOrder(GMST);\n wbAddGroupOrder(TXST);\n wbAddGroupOrder(MICN);\n wbAddGroupOrder(GLOB);\n wbAddGroupOrder(CLAS);\n wbAddGroupOrder(FACT);\n wbAddGroupOrder(HDPT);\n wbAddGroupOrder(HAIR);\n wbAddGroupOrder(EYES);\n wbAddGroupOrder(RACE);\n wbAddGroupOrder(SOUN);\n wbAddGroupOrder(ASPC);\n wbAddGroupOrder(MGEF);\n wbAddGroupOrder(SCPT);\n wbAddGroupOrder(LTEX);\n wbAddGroupOrder(ENCH);\n wbAddGroupOrder(SPEL);\n wbAddGroupOrder(ACTI);\n wbAddGroupOrder(TACT);\n wbAddGroupOrder(TERM);\n wbAddGroupOrder(ARMO);\n wbAddGroupOrder(BOOK);\n wbAddGroupOrder(CONT);\n wbAddGroupOrder(DOOR);\n wbAddGroupOrder(INGR);\n wbAddGroupOrder(LIGH);\n wbAddGroupOrder(MISC);\n wbAddGroupOrder(STAT);\n wbAddGroupOrder(SCOL);\n wbAddGroupOrder(MSTT);\n wbAddGroupOrder(PWAT);\n wbAddGroupOrder(GRAS);\n wbAddGroupOrder(TREE);\n wbAddGroupOrder(FURN);\n wbAddGroupOrder(WEAP);\n wbAddGroupOrder(AMMO);\n wbAddGroupOrder(NPC_);\n wbAddGroupOrder(CREA);\n wbAddGroupOrder(LVLC);\n wbAddGroupOrder(LVLN);\n wbAddGroupOrder(KEYM);\n wbAddGroupOrder(ALCH);\n wbAddGroupOrder(IDLM);\n wbAddGroupOrder(NOTE);\n wbAddGroupOrder(COBJ);\n wbAddGroupOrder(PROJ);\n wbAddGroupOrder(LVLI);\n wbAddGroupOrder(WTHR);\n wbAddGroupOrder(CLMT);\n wbAddGroupOrder(REGN);\n wbAddGroupOrder(NAVI);\n wbAddGroupOrder(DIAL);\n wbAddGroupOrder(QUST);\n wbAddGroupOrder(IDLE);\n wbAddGroupOrder(PACK);\n wbAddGroupOrder(CSTY);\n wbAddGroupOrder(LSCR);\n wbAddGroupOrder(ANIO);\n wbAddGroupOrder(WATR);\n wbAddGroupOrder(EFSH);\n wbAddGroupOrder(EXPL);\n wbAddGroupOrder(DEBR);\n wbAddGroupOrder(IMGS);\n wbAddGroupOrder(IMAD);\n wbAddGroupOrder(FLST);\n wbAddGroupOrder(PERK);\n wbAddGroupOrder(BPTD);\n wbAddGroupOrder(ADDN);\n wbAddGroupOrder(AVIF);\n wbAddGroupOrder(RADS);\n wbAddGroupOrder(CAMS);\n wbAddGroupOrder(CPTH);\n wbAddGroupOrder(VTYP);\n wbAddGroupOrder(IPCT);\n wbAddGroupOrder(IPDS);\n wbAddGroupOrder(ARMA);\n wbAddGroupOrder(ECZN);\n wbAddGroupOrder(MESG);\n wbAddGroupOrder(RGDL);\n wbAddGroupOrder(DOBJ);\n wbAddGroupOrder(LGTM);\n wbAddGroupOrder(MUSC);\n wbAddGroupOrder(IMOD);\n wbAddGroupOrder(REPU);\n wbAddGroupOrder(RCPE);\n wbAddGroupOrder(RCCT);\n wbAddGroupOrder(CHIP);\n wbAddGroupOrder(CSNO);\n wbAddGroupOrder(LSCT);\n wbAddGroupOrder(MSET);\n wbAddGroupOrder(ALOC);\n wbAddGroupOrder(CHAL);\n wbAddGroupOrder(AMEF);\n wbAddGroupOrder(CCRD);\n wbAddGroupOrder(CMNY);\n wbAddGroupOrder(CDCK);\n wbAddGroupOrder(DEHY);\n wbAddGroupOrder(HUNG);\n wbAddGroupOrder(SLPD);\n // Forced at the end.\n wbAddGroupOrder(CELL);\n wbAddGroupOrder(WRLD);\nend;\n\nprocedure DefineFNV;\nbegin\n DefineFNVa;\n DefineFNVb;\n DefineFNVc;\n DefineFNVd;\n DefineFNVe;\n DefineFNVf;\nend;\n\nend.\n"
},
{
"path": "lib/xedit/wbDefinitionsFO3.pas",
"content": "{*******************************************************************************\n\n The contents of this file are subject to the Mozilla Public License\n Version 1.1 (the \"License\"); you may not use this file except in\n compliance with the License. You may obtain a copy of the License at\n http://www.mozilla.org/MPL/\n\n Software distributed under the License is distributed on an \"AS IS\"\n basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the\n License for the specific language governing rights and limitations\n under the License.\n\n*******************************************************************************}\n\nunit wbDefinitionsFO3;\n\n{$I wbDefines.inc}\n\ninterface\n\nuses\n wbInterface;\n\nvar\n\twbAggroRadiusFlags: IwbFlagsDef;\n wbPKDTFlags: IwbFlagsDef;\n\twbRecordFlagsFlags: IwbFlagsDef;\n\twbServiceFlags: IwbFlagsDef;\n\twbTemplateFlags: IwbFlagsDef;\n\n\twbAgressionEnum: IwbEnumDef;\n\twbAlignmentEnum: IwbEnumDef;\n\twbArchtypeEnum: IwbEnumDef;\n\twbAssistanceEnum: IwbEnumDef;\n\twbAttackAnimationEnum: IwbEnumDef;\n\twbAxisEnum: IwbEnumDef;\n\twbBlendModeEnum: IwbEnumDef;\n\twbBlendOpEnum: IwbEnumDef;\n\twbBodyLocationEnum: IwbEnumDef;\n\twbBodyPartIndexEnum: IwbEnumDef;\n\twbConfidenceEnum: IwbEnumDef;\n\twbCreatureTypeEnum: IwbEnumDef;\n\twbCrimeTypeEnum: IwbEnumDef;\n\twbCriticalStageEnum: IwbEnumDef;\n\twbEquipTypeEnum: IwbEnumDef;\n\twbFormTypeEnum: IwbEnumDef;\n\twbFunctionsEnum: IwbEnumDef;\n\twbHeadPartIndexEnum: IwbEnumDef;\n\twbImpactMaterialTypeEnum: IwbEnumDef;\n\twbMenuModeEnum: IwbEnumDef;\n\twbMiscStatEnum: IwbEnumDef;\n\twbModEffectEnum: IwbEnumDef;\n\twbMoodEnum: IwbEnumDef;\n\twbMusicEnum: IwbEnumDef;\n\twbObjectTypeEnum: IwbEnumDef;\n\twbPKDTType: IwbEnumDef;\n\twbPlayerActionEnum: IwbEnumDef;\n\twbQuadrantEnum: IwbEnumDef;\n\twbReloadAnimEnum: IwbEnumDef;\n\twbSexEnum: IwbEnumDef;\n\twbSkillEnum: IwbEnumDef;\n\twbSoundLevelEnum: IwbEnumDef;\n\twbSpecializationEnum: IwbEnumDef;\n\twbVatsValueFunctionEnum: IwbEnumDef;\n\twbWeaponAnimTypeEnum: IwbEnumDef;\n\twbZTestFuncEnum: IwbEnumDef;\n\nprocedure DefineFO3;\n\nimplementation\n\nuses\n Types,\n Classes,\n SysUtils,\n Math,\n Variants,\n wbHelpers;\n\nconst\n _00_IAD: TwbSignature = #$00'IAD';\n _40_IAD: TwbSignature = #$40'IAD';\n _01_IAD: TwbSignature = #$01'IAD';\n _41_IAD: TwbSignature = #$41'IAD';\n _02_IAD: TwbSignature = #$02'IAD';\n _42_IAD: TwbSignature = #$42'IAD';\n _03_IAD: TwbSignature = #$03'IAD';\n _43_IAD: TwbSignature = #$43'IAD';\n _04_IAD: TwbSignature = #$04'IAD';\n _44_IAD: TwbSignature = #$44'IAD';\n _05_IAD: TwbSignature = #$05'IAD';\n _45_IAD: TwbSignature = #$45'IAD';\n _06_IAD: TwbSignature = #$06'IAD';\n _46_IAD: TwbSignature = #$46'IAD';\n _07_IAD: TwbSignature = #$07'IAD';\n _47_IAD: TwbSignature = #$47'IAD';\n _08_IAD: TwbSignature = #$08'IAD';\n _48_IAD: TwbSignature = #$48'IAD';\n _09_IAD: TwbSignature = #$09'IAD';\n _49_IAD: TwbSignature = #$49'IAD';\n _0A_IAD: TwbSignature = #$0A'IAD';\n _4A_IAD: TwbSignature = #$4A'IAD';\n _0B_IAD: TwbSignature = #$0B'IAD';\n _4B_IAD: TwbSignature = #$4B'IAD';\n _0C_IAD: TwbSignature = #$0C'IAD';\n _4C_IAD: TwbSignature = #$4C'IAD';\n _0D_IAD: TwbSignature = #$0D'IAD';\n _4D_IAD: TwbSignature = #$4D'IAD';\n _0E_IAD: TwbSignature = #$0E'IAD';\n _4E_IAD: TwbSignature = #$4E'IAD';\n _0F_IAD: TwbSignature = #$0F'IAD';\n _4F_IAD: TwbSignature = #$4F'IAD';\n _10_IAD: TwbSignature = #$10'IAD';\n _50_IAD: TwbSignature = #$50'IAD';\n _11_IAD: TwbSignature = #$11'IAD';\n _51_IAD: TwbSignature = #$51'IAD';\n _12_IAD: TwbSignature = #$12'IAD';\n _52_IAD: TwbSignature = #$52'IAD';\n _13_IAD: TwbSignature = #$13'IAD';\n _53_IAD: TwbSignature = #$53'IAD';\n _14_IAD: TwbSignature = #$14'IAD';\n _54_IAD: TwbSignature = #$54'IAD';\n\n _0_IAD : TwbSignature = #0'IAD';\n _1_IAD : TwbSignature = #1'IAD';\n _2_IAD : TwbSignature = #2'IAD';\n _3_IAD : TwbSignature = #3'IAD';\n ACBS : TwbSignature = 'ACBS';\n ACHR : TwbSignature = 'ACHR';\n ACRE : TwbSignature = 'ACRE';\n ACTI : TwbSignature = 'ACTI';\n ADDN : TwbSignature = 'ADDN';\n AIDT : TwbSignature = 'AIDT';\n ALCH : TwbSignature = 'ALCH';\n AMMO : TwbSignature = 'AMMO';\n ANAM : TwbSignature = 'ANAM';\n ANIO : TwbSignature = 'ANIO';\n ARMA : TwbSignature = 'ARMA';\n ARMO : TwbSignature = 'ARMO';\n ASPC : TwbSignature = 'ASPC';\n ATTR : TwbSignature = 'ATTR';\n ATXT : TwbSignature = 'ATXT';\n AVIF : TwbSignature = 'AVIF';\n BIPL : TwbSignature = 'BIPL';\n BMCT : TwbSignature = 'BMCT';\n BMDT : TwbSignature = 'BMDT';\n BNAM : TwbSignature = 'BNAM';\n BOOK : TwbSignature = 'BOOK';\n BPND : TwbSignature = 'BPND';\n BPNI : TwbSignature = 'BPNI';\n BPNN : TwbSignature = 'BPNN';\n BPNT : TwbSignature = 'BPNT';\n BPTD : TwbSignature = 'BPTD';\n BPTN : TwbSignature = 'BPTN';\n BTXT : TwbSignature = 'BTXT';\n CAMS : TwbSignature = 'CAMS';\n CELL : TwbSignature = 'CELL';\n CLAS : TwbSignature = 'CLAS';\n CLMT : TwbSignature = 'CLMT';\n CNAM : TwbSignature = 'CNAM';\n CNTO : TwbSignature = 'CNTO';\n COBJ : TwbSignature = 'COBJ';\n COED : TwbSignature = 'COED';\n CONT : TwbSignature = 'CONT';\n CPTH : TwbSignature = 'CPTH';\n CRDT : TwbSignature = 'CRDT';\n CREA : TwbSignature = 'CREA';\n CSAD : TwbSignature = 'CSAD';\n CSCR : TwbSignature = 'CSCR';\n CSDC : TwbSignature = 'CSDC';\n CSDI : TwbSignature = 'CSDI';\n CSDT : TwbSignature = 'CSDT';\n CSSD : TwbSignature = 'CSSD';\n CSTD : TwbSignature = 'CSTD';\n CSTY : TwbSignature = 'CSTY';\n CTDA : TwbSignature = 'CTDA';\n DATA : TwbSignature = 'DATA';\n DEBR : TwbSignature = 'DEBR';\n DELE : TwbSignature = 'DELE';\n DESC : TwbSignature = 'DESC';\n DEST : TwbSignature = 'DEST';\n DIAL : TwbSignature = 'DIAL';\n DMDL : TwbSignature = 'DMDL';\n DMDT : TwbSignature = 'DMDT';\n DNAM : TwbSignature = 'DNAM';\n DOBJ : TwbSignature = 'DOBJ';\n DODT : TwbSignature = 'DODT';\n DOOR : TwbSignature = 'DOOR';\n DSTD : TwbSignature = 'DSTD';\n DSTF : TwbSignature = 'DSTF';\n EAMT : TwbSignature = 'EAMT';\n ECZN : TwbSignature = 'ECZN';\n EDID : TwbSignature = 'EDID';\n EFID : TwbSignature = 'EFID';\n EFIT : TwbSignature = 'EFIT';\n EFSD : TwbSignature = 'EFSD';\n EFSH : TwbSignature = 'EFSH';\n EITM : TwbSignature = 'EITM';\n ENAM : TwbSignature = 'ENAM';\n ENCH : TwbSignature = 'ENCH';\n ENIT : TwbSignature = 'ENIT';\n EPF2 : TwbSignature = 'EPF2';\n EPF3 : TwbSignature = 'EPF3';\n EPFD : TwbSignature = 'EPFD';\n EPFT : TwbSignature = 'EPFT';\n ESCE : TwbSignature = 'ESCE';\n ETYP : TwbSignature = 'ETYP';\n EXPL : TwbSignature = 'EXPL';\n EYES : TwbSignature = 'EYES';\n FACT : TwbSignature = 'FACT';\n FGGA : TwbSignature = 'FGGA';\n FGGS : TwbSignature = 'FGGS';\n FGTS : TwbSignature = 'FGTS';\n FLST : TwbSignature = 'FLST';\n FLTV : TwbSignature = 'FLTV';\n FNAM : TwbSignature = 'FNAM';\n FULL : TwbSignature = 'FULL';\n FURN : TwbSignature = 'FURN';\n GLOB : TwbSignature = 'GLOB';\n GMST : TwbSignature = 'GMST';\n GNAM : TwbSignature = 'GNAM';\n GRAS : TwbSignature = 'GRAS';\n HAIR : TwbSignature = 'HAIR';\n HCLR : TwbSignature = 'HCLR';\n HDPT : TwbSignature = 'HDPT';\n HEDR : TwbSignature = 'HEDR';\n HNAM : TwbSignature = 'HNAM';\n ICO2 : TwbSignature = 'ICO2';\n ICON : TwbSignature = 'ICON';\n IDLA : TwbSignature = 'IDLA';\n IDLB : TwbSignature = 'IDLB';\n IDLC : TwbSignature = 'IDLC';\n IDLE : TwbSignature = 'IDLE';\n IDLF : TwbSignature = 'IDLF';\n IDLM : TwbSignature = 'IDLM';\n IDLT : TwbSignature = 'IDLT';\n IMAD : TwbSignature = 'IMAD';\n IMGS : TwbSignature = 'IMGS';\n INAM : TwbSignature = 'INAM';\n INDX : TwbSignature = 'INDX';\n INFO : TwbSignature = 'INFO';\n INGR : TwbSignature = 'INGR';\n IPCT : TwbSignature = 'IPCT';\n IPDS : TwbSignature = 'IPDS';\n ITXT : TwbSignature = 'ITXT';\n JNAM : TwbSignature = 'JNAM';\n KEYM : TwbSignature = 'KEYM';\n KFFZ : TwbSignature = 'KFFZ';\n KNAM : TwbSignature = 'KNAM';\n LAND : TwbSignature = 'LAND';\n LGTM : TwbSignature = 'LGTM';\n LIGH : TwbSignature = 'LIGH';\n LNAM : TwbSignature = 'LNAM';\n LSCR : TwbSignature = 'LSCR';\n LTEX : TwbSignature = 'LTEX';\n LTMP : TwbSignature = 'LTMP';\n LVLC : TwbSignature = 'LVLC';\n LVLD : TwbSignature = 'LVLD';\n LVLF : TwbSignature = 'LVLF';\n LVLG : TwbSignature = 'LVLG';\n LVLI : TwbSignature = 'LVLI';\n LVLN : TwbSignature = 'LVLN';\n LVLO : TwbSignature = 'LVLO';\n MAST : TwbSignature = 'MAST';\n MESG : TwbSignature = 'MESG';\n MGEF : TwbSignature = 'MGEF';\n MICN : TwbSignature = 'MICN';\n MICO : TwbSignature = 'MICO';\n MIC2 : TwbSignature = 'MIC2';\n MISC : TwbSignature = 'MISC';\n MNAM : TwbSignature = 'MNAM';\n MO2B : TwbSignature = 'MO2B';\n MO2S : TwbSignature = 'MO2S';\n MO2T : TwbSignature = 'MO2T';\n MO3B : TwbSignature = 'MO3B';\n MO3S : TwbSignature = 'MO3S';\n MO3T : TwbSignature = 'MO3T';\n MO4B : TwbSignature = 'MO4B';\n MO4S : TwbSignature = 'MO4S';\n MO4T : TwbSignature = 'MO4T';\n MOD2 : TwbSignature = 'MOD2';\n MOD3 : TwbSignature = 'MOD3';\n MOD4 : TwbSignature = 'MOD4';\n MODB : TwbSignature = 'MODB';\n MODD : TwbSignature = 'MODD';\n MODL : TwbSignature = 'MODL';\n MODS : TwbSignature = 'MODS';\n MODT : TwbSignature = 'MODT';\n MOSD : TwbSignature = 'MOSD';\n MSTT : TwbSignature = 'MSTT';\n MUSC : TwbSignature = 'MUSC';\n IMPS : TwbSignature = 'IMPS';\n IMPF : TwbSignature = 'IMPF';\n NAM0 : TwbSignature = 'NAM0';\n NAM1 : TwbSignature = 'NAM1';\n NAM2 : TwbSignature = 'NAM2';\n NAM3 : TwbSignature = 'NAM3';\n NAM4 : TwbSignature = 'NAM4';\n NAM5 : TwbSignature = 'NAM5';\n NAM6 : TwbSignature = 'NAM6';\n NAM7 : TwbSignature = 'NAM7';\n NAM8 : TwbSignature = 'NAM8';\n NAM9 : TwbSignature = 'NAM9';\n NAME : TwbSignature = 'NAME';\n NAVI : TwbSignature = 'NAVI';\n NAVM : TwbSignature = 'NAVM';\n NEXT : TwbSignature = 'NEXT';\n NIFT : TwbSignature = 'NIFT';\n NIFZ : TwbSignature = 'NIFZ';\n NNAM : TwbSignature = 'NNAM';\n NOTE : TwbSignature = 'NOTE';\n NPC_ : TwbSignature = 'NPC_';\n NULL : TwbSignature = 'NULL';\n NVCA : TwbSignature = 'NVCA';\n NVCI : TwbSignature = 'NVCI';\n NVDP : TwbSignature = 'NVDP';\n NVER : TwbSignature = 'NVER';\n NVEX : TwbSignature = 'NVEX';\n NVGD : TwbSignature = 'NVGD';\n NVMI : TwbSignature = 'NVMI';\n NVTR : TwbSignature = 'NVTR';\n NVVX : TwbSignature = 'NVVX';\n OBND : TwbSignature = 'OBND';\n OFST : TwbSignature = 'OFST';\n ONAM : TwbSignature = 'ONAM';\n PACK : TwbSignature = 'PACK';\n PBEA : TwbSignature = 'PBEA';\n PERK : TwbSignature = 'PERK';\n PFIG : TwbSignature = 'PFIG';\n PFPC : TwbSignature = 'PFPC';\n PGAG : TwbSignature = 'PGAG';\n PGRE : TwbSignature = 'PGRE';\n PMIS : TwbSignature = 'PMIS';\n TRGT : TwbSignature = 'TRGT';\n PGRI : TwbSignature = 'PGRI';\n PGRL : TwbSignature = 'PGRL';\n PGRP : TwbSignature = 'PGRP';\n PGRR : TwbSignature = 'PGRR';\n PKAM : TwbSignature = 'PKAM';\n PKDD : TwbSignature = 'PKDD';\n PKDT : TwbSignature = 'PKDT';\n PKE2 : TwbSignature = 'PKE2';\n PKED : TwbSignature = 'PKED';\n PKFD : TwbSignature = 'PKFD';\n PKID : TwbSignature = 'PKID';\n PKPT : TwbSignature = 'PKPT';\n PKW3 : TwbSignature = 'PKW3';\n PLD2 : TwbSignature = 'PLD2';\n PLDT : TwbSignature = 'PLDT';\n PLYR : TwbSignature = 'PLYR';\n PNAM : TwbSignature = 'PNAM';\n POBA : TwbSignature = 'POBA';\n POCA : TwbSignature = 'POCA';\n POEA : TwbSignature = 'POEA';\n PRKC : TwbSignature = 'PRKC';\n PRKE : TwbSignature = 'PRKE';\n PRKF : TwbSignature = 'PRKF';\n PROJ : TwbSignature = 'PROJ';\n PSDT : TwbSignature = 'PSDT';\n PTD2 : TwbSignature = 'PTD2';\n PTDT : TwbSignature = 'PTDT';\n PUID : TwbSignature = 'PUID';\n PWAT : TwbSignature = 'PWAT';\n QNAM : TwbSignature = 'QNAM';\n QOBJ : TwbSignature = 'QOBJ';\n QSDT : TwbSignature = 'QSDT';\n QSTA : TwbSignature = 'QSTA';\n QSTI : TwbSignature = 'QSTI';\n TPIC : TwbSignature = 'TPIC';\n QSTR : TwbSignature = 'QSTR';\n QUST : TwbSignature = 'QUST';\n RACE : TwbSignature = 'RACE';\n RADS : TwbSignature = 'RADS';\n RAFB : TwbSignature = 'RAFB';\n RAFD : TwbSignature = 'RAFD';\n RAGA : TwbSignature = 'RAGA';\n RAPS : TwbSignature = 'RAPS';\n RCLR : TwbSignature = 'RCLR';\n RDAT : TwbSignature = 'RDAT';\n RDMD : TwbSignature = 'RDMD';\n RDMO : TwbSignature = 'RDMO';\n RDMP : TwbSignature = 'RDMP';\n RDGS : TwbSignature = 'RDGS';\n RDOT : TwbSignature = 'RDOT';\n RDSD : TwbSignature = 'RDSD';\n RDWT : TwbSignature = 'RDWT';\n REFR : TwbSignature = 'REFR';\n REGN : TwbSignature = 'REGN';\n REPL : TwbSignature = 'REPL';\n RGDL : TwbSignature = 'RGDL';\n RNAM : TwbSignature = 'RNAM';\n RPLD : TwbSignature = 'RPLD';\n RPLI : TwbSignature = 'RPLI';\n SCDA : TwbSignature = 'SCDA';\n SCHR : TwbSignature = 'SCHR';\n SCOL : TwbSignature = 'SCOL';\n SCPT : TwbSignature = 'SCPT';\n SCRI : TwbSignature = 'SCRI';\n SCRN : TwbSignature = 'SCRN';\n SCRO : TwbSignature = 'SCRO';\n SCRV : TwbSignature = 'SCRV';\n SCTX : TwbSignature = 'SCTX';\n SCVR : TwbSignature = 'SCVR';\n SLCP : TwbSignature = 'SLCP';\n SLSD : TwbSignature = 'SLSD';\n SNAM : TwbSignature = 'SNAM';\n SNDD : TwbSignature = 'SNDD';\n SNDX : TwbSignature = 'SNDX';\n SOUL : TwbSignature = 'SOUL';\n SOUN : TwbSignature = 'SOUN';\n SPEL : TwbSignature = 'SPEL';\n SPIT : TwbSignature = 'SPIT';\n SPLO : TwbSignature = 'SPLO';\n STAT : TwbSignature = 'STAT';\n TACT : TwbSignature = 'TACT';\n TCLF : TwbSignature = 'TCLF';\n TCLT : TwbSignature = 'TCLT';\n TERM : TwbSignature = 'TERM';\n TES4 : TwbSignature = 'TES4';\n TNAM : TwbSignature = 'TNAM';\n TPLT : TwbSignature = 'TPLT';\n TRDT : TwbSignature = 'TRDT';\n TREE : TwbSignature = 'TREE';\n TX00 : TwbSignature = 'TX00';\n TX01 : TwbSignature = 'TX01';\n TX02 : TwbSignature = 'TX02';\n TX03 : TwbSignature = 'TX03';\n TX04 : TwbSignature = 'TX04';\n TX05 : TwbSignature = 'TX05';\n TXST : TwbSignature = 'TXST';\n UNAM : TwbSignature = 'UNAM';\n VCLR : TwbSignature = 'VCLR';\n VHGT : TwbSignature = 'VHGT';\n VNAM : TwbSignature = 'VNAM';\n VNML : TwbSignature = 'VNML';\n VTCK : TwbSignature = 'VTCK';\n VTEX : TwbSignature = 'VTEX';\n VTXT : TwbSignature = 'VTXT';\n VTYP : TwbSignature = 'VTYP';\n WATR : TwbSignature = 'WATR';\n WEAP : TwbSignature = 'WEAP';\n WLST : TwbSignature = 'WLST';\n WNAM : TwbSignature = 'WNAM';\n WRLD : TwbSignature = 'WRLD';\n WTHR : TwbSignature = 'WTHR';\n XACT : TwbSignature = 'XACT';\n XAMC : TwbSignature = 'XAMC';\n XAMT : TwbSignature = 'XAMT';\n XAPD : TwbSignature = 'XAPD';\n XAPR : TwbSignature = 'XAPR';\n XCAS : TwbSignature = 'XCAS';\n XCCM : TwbSignature = 'XCCM';\n XCET : TwbSignature = 'XCET';\n XCHG : TwbSignature = 'XCHG';\n XCIM : TwbSignature = 'XCIM';\n XCLC : TwbSignature = 'XCLC';\n XCLL : TwbSignature = 'XCLL';\n XCLP : TwbSignature = 'XCLP';\n XCLR : TwbSignature = 'XCLR';\n XCLW : TwbSignature = 'XCLW';\n XCMO : TwbSignature = 'XCMO';\n XCMT : TwbSignature = 'XCMT';\n XCNT : TwbSignature = 'XCNT';\n XCWT : TwbSignature = 'XCWT';\n XEMI : TwbSignature = 'XEMI';\n XESP : TwbSignature = 'XESP';\n XEZN : TwbSignature = 'XEZN';\n XGLB : TwbSignature = 'XGLB';\n XHLP : TwbSignature = 'XHLP';\n XDCR : TwbSignature = 'XDCR';\n XHLT : TwbSignature = 'XHLT';\n XIBS : TwbSignature = 'XIBS';\n XLCM : TwbSignature = 'XLCM';\n XLKR : TwbSignature = 'XLKR';\n XLOC : TwbSignature = 'XLOC';\n XLOD : TwbSignature = 'XLOD';\n XLRM : TwbSignature = 'XLRM';\n XLTW : TwbSignature = 'XLTW';\n XMBO : TwbSignature = 'XMBO';\n XMBP : TwbSignature = 'XMBP';\n XMBR : TwbSignature = 'XMBR';\n XMRC : TwbSignature = 'XMRC';\n XMRK : TwbSignature = 'XMRK';\n XNAM : TwbSignature = 'XNAM';\n XNDP : TwbSignature = 'XNDP';\n XOCP : TwbSignature = 'XOCP';\n XORD : TwbSignature = 'XORD';\n XOWN : TwbSignature = 'XOWN';\n XPOD : TwbSignature = 'XPOD';\n XPTL : TwbSignature = 'XPTL';\n XPPA : TwbSignature = 'XPPA';\n XPRD : TwbSignature = 'XPRD';\n XPRM : TwbSignature = 'XPRM';\n XPWR : TwbSignature = 'XPWR';\n XRAD : TwbSignature = 'XRAD';\n XRDO : TwbSignature = 'XRDO';\n XRDS : TwbSignature = 'XRDS';\n XRGB : TwbSignature = 'XRGB';\n XRGD : TwbSignature = 'XRGD';\n XRMR : TwbSignature = 'XRMR';\n XRNK : TwbSignature = 'XRNK';\n XRTM : TwbSignature = 'XRTM';\n XSCL : TwbSignature = 'XSCL';\n XSED : TwbSignature = 'XSED';\n XSRF : TwbSignature = 'XSRF';\n XSRD : TwbSignature = 'XSRD';\n XTEL : TwbSignature = 'XTEL';\n XTRG : TwbSignature = 'XTRG';\n XTRI : TwbSignature = 'XTRI';\n XXXX : TwbSignature = 'XXXX';\n YNAM : TwbSignature = 'YNAM';\n ZNAM : TwbSignature = 'ZNAM';\n\nvar\n wbPKDTSpecificFlagsUnused : Boolean;\n wbEDID: IwbSubRecordDef;\n wbEDIDReq: IwbSubRecordDef;\n wbBMDT: IwbSubRecordDef;\n wbYNAM: IwbSubRecordDef;\n wbZNAM: IwbSubRecordDef;\n wbCOED: IwbSubRecordDef;\n wbXLCM: IwbSubRecordDef;\n wbEITM: IwbSubRecordDef;\n wbREPL: IwbSubRecordDef;\n wbBIPL: IwbSubRecordDef;\n wbOBND: IwbSubRecordDef;\n wbOBNDReq: IwbSubRecordDef;\n wbDEST: IwbSubRecordStructDef;\n wbDESTActor: IwbSubRecordStructDef;\n wbDODT: IwbSubRecordDef;\n wbXOWN: IwbSubRecordDef;\n wbXGLB: IwbSubRecordDef;\n wbXRGD: IwbSubRecordDef;\n wbXRGB: IwbSubRecordDef;\n wbSLSD: IwbSubRecordDef;\n wbSPLO: IwbSubRecordDef;\n wbSPLOs: IwbSubRecordArrayDef;\n wbCNTO: IwbSubRecordStructDef;\n wbCNTOs: IwbSubRecordArrayDef;\n wbAIDT: IwbSubRecordDef;\n wbCSDT: IwbSubRecordStructDef;\n wbCSDTs: IwbSubRecordArrayDef;\n wbFULL: IwbSubRecordDef;\n wbFULLActor: IwbSubRecordDef;\n wbFULLReq: IwbSubRecordDef;\n wbXNAM: IwbSubRecordDef;\n wbXNAMs: IwbSubRecordArrayDef;\n wbDESC: IwbSubRecordDef;\n wbDESCReq: IwbSubRecordDef;\n wbXSCL: IwbSubRecordDef;\n wbDATAPosRot : IwbSubRecordDef;\n wbPosRot : IwbStructDef;\n wbMODD: IwbSubRecordDef;\n wbMOSD: IwbSubRecordDef;\n wbMODL: IwbSubRecordStructDef;\n wbMODS: IwbSubRecordDef;\n wbMO2S: IwbSubRecordDef;\n wbMO3S: IwbSubRecordDef;\n wbMO4S: IwbSubRecordDef;\n wbMODLActor: IwbSubRecordStructDef;\n wbMODLReq: IwbSubRecordStructDef;\n wbCTDA: IwbSubRecordDef;\n wbSCHRReq: IwbSubRecordDef;\n wbCTDAs: IwbSubRecordArrayDef;\n wbCTDAsReq: IwbSubRecordArrayDef;\n wbSCROs: IwbSubRecordArrayDef;\n wbPGRP: IwbSubRecordDef;\n wbEmbeddedScript: IwbSubRecordStructDef;\n wbEmbeddedScriptPerk: IwbSubRecordStructDef;\n wbEmbeddedScriptReq: IwbSubRecordStructDef;\n wbSCRI: IwbSubRecordDef;\n wbSCRIActor: IwbSubRecordDef;\n wbFaceGen: IwbSubRecordStructDef;\n wbFaceGenNPC: IwbSubRecordStructDef;\n wbENAM: IwbSubRecordDef;\n wbFGGS: IwbSubRecordDef;\n wbXLOD: IwbSubRecordDef;\n wbXESP: IwbSubRecordDef;\n wbICON: IwbSubRecordStructDef;\n wbICONReq: IwbSubRecordStructDef;\n wbActorValue: IwbIntegerDef;\n wbETYP: IwbSubRecordDef;\n wbETYPReq: IwbSubRecordDef;\n wbEFID: IwbSubRecordDef;\n wbEFIT: IwbSubRecordDef;\n wbEffects: IwbSubRecordArrayDef;\n wbEffectsReq: IwbSubRecordArrayDef;\n wbBPNDStruct: IwbSubRecordDef;\n wbTimeInterpolator: IwbStructDef;\n wbColorInterpolator: IwbStructDef;\n\nfunction wbNVTREdgeToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Index : Integer;\n Flags : Cardinal;\n IsExternal : Boolean;\n Container : IwbContainerElementRef;\nbegin\n Result := '';\n IsExternal := False;\n if Supports(aElement, IwbContainerElementRef, Container) then begin\n Index := StrToIntDef(Copy(Container.Name, 11, 1), -1);\n if (Index >= 0) and (Index <= 2) then begin\n Flags := Container.ElementNativeValues['..\\..\\Flags'];\n IsExternal := Flags and (Cardinal(1) shl Index) <> 0;\n end;\n end;\n\n if IsExternal then begin\n case aType of\n ctToStr: begin\n Result := IntToStr(aInt);\n if Container.ElementExists['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt)] then\n Result := Result + ' (Triangle #' +\n Container.ElementValues['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Triangle'] + ' in ' +\n Container.ElementValues['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Navigation Mesh'] + ')'\n else\n Result := Result + ' ';\n end;\n ctToSortKey:\n if Container.ElementExists['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt)] then\n Result :=\n Container.ElementSortKeys['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Navigation Mesh', True] + '|' +\n Container.ElementSortKeys['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt) + '\\Triangle', True];\n ctCheck:\n if Container.ElementExists['..\\..\\..\\..\\NVEX\\Connection #' + IntToStr(aInt)] then\n Result := ''\n else\n Result := 'NVEX\\Connection #' + IntToStr(aInt) + ' is missing';\n end\n end else\n case aType of\n ctToStr: Result := IntToStr(aInt);\n end;\nend;\n\nfunction wbNVTREdgeToInt(const aString: string; const aElement: IwbElement): Int64;\nbegin\n Result := StrToInt64(aString);\nend;\n\n\nfunction wbEPFDActorValueToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n AsCardinal : Cardinal;\n AsFloat : Single;\nbegin\n AsCardinal := aInt;\n AsFloat := PSingle(@AsCardinal)^;\n aInt := Round(AsFloat);\n case aType of\n ctToStr: Result := wbActorValueEnum.ToString(aInt, aElement);\n ctToSortKey: Result := wbActorValueEnum.ToSortKey(aInt, aElement);\n ctCheck: Result := wbActorValueEnum.Check(aInt, aElement);\n ctToEditValue: Result := wbActorValueEnum.ToEditValue(aInt, aElement);\n ctEditType: Result := 'ComboBox';\n ctEditInfo: Result := wbActorValueEnum.EditInfo[aInt, aElement];\n end;\nend;\n\nfunction wbEPFDActorValueToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n AsCardinal : Cardinal;\n AsFloat : Single;\nbegin\n AsFloat := wbActorValueEnum.FromEditValue(aString, aElement);\n PSingle(@AsCardinal)^ := AsFloat;\n Result := AsCardinal;\nend;\n\nfunction wbCTDAParam2VariableNameToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n //Container2 : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\n ScriptRef : IwbElement;\n Script : IwbMainRecord;\n Variables : TStringList;\n LocalVars : IwbContainerElementRef;\n LocalVar : IwbContainerElementRef;\n i, j : Integer;\n s : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n MainRecord := nil;\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n{ if Param1.NativeValue = 0 then\n if Supports(Container.Container, IwbContainerElementRef, Container) then\n for i := 0 to Pred(Container.ElementCount) do\n if Supports(Container.Elements[i], IwbContainerElementRef, Container2) then\n if SameText(Container2.ElementValues['Function'], 'GetIsID') then begin\n Param1 := Container2.ElementByName['Parameter #1'];\n if Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Break;\n end;}\n\n if not Assigned(MainRecord) then\n Exit;\n\n BaseRecord := MainRecord.BaseRecord;\n if Assigned(BaseRecord) then\n MainRecord := BaseRecord;\n\n ScriptRef := MainRecord.RecordBySignature['SCRI'];\n\n if not Assigned(ScriptRef) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n if not Supports(ScriptRef.LinksTo, IwbMainRecord, Script) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n Script := Script.HighestOverrideOrSelf[aElement._File.LoadOrder];\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n Variables := TStringList.Create;\n else\n Variables := nil;\n end;\n try\n if Supports(Script.ElementByName['Local Variables'], IwbContainerElementRef, LocalVars) then begin\n for i := 0 to Pred(LocalVars.ElementCount) do\n if Supports(LocalVars.Elements[i], IwbContainerElementRef, LocalVar) then begin\n j := LocalVar.ElementNativeValues['SLSD\\Index'];\n s := LocalVar.ElementNativeValues['SCVR'];\n if Assigned(Variables) then\n Variables.AddObject(s, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := s;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n Variables.Sort;\n Result := Variables.CommaText;\n end;\n end;\n finally\n FreeAndNil(Variables);\n end;\nend;\n\nfunction wbCTDAParam2VariableNameToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\n ScriptRef : IwbElement;\n Script : IwbMainRecord;\n LocalVars : IwbContainerElementRef;\n LocalVar : IwbContainerElementRef;\n i, j : Integer;\n s : string;\nbegin\n Result := StrToInt64Def(aString, Low(Cardinal));\n if Result <> Low(Cardinal) then\n Exit;\n\n if not Assigned(aElement) then\n raise Exception.Create('aElement not specified');\n\n Container := GetContainerRefFromUnionOrValue(aElement);\n\n if not Assigned(Container) then\n raise Exception.Create('Container not assigned');\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n raise Exception.Create('Could not find \"Parameter #1\"');\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n raise Exception.Create('\"Parameter #1\" does not reference a valid main record');\n\n BaseRecord := MainRecord.BaseRecord;\n if Assigned(BaseRecord) then\n MainRecord := BaseRecord;\n\n ScriptRef := MainRecord.RecordBySignature['SCRI'];\n\n if not Assigned(ScriptRef) then\n raise Exception.Create('\"'+MainRecord.ShortName+'\" does not contain a SCRI subrecord');\n\n if not Supports(ScriptRef.LinksTo, IwbMainRecord, Script) then\n raise Exception.Create('\"'+MainRecord.ShortName+'\" does not have a valid script');\n\n Script := Script.HighestOverrideOrSelf[aElement._File.LoadOrder];\n\n if Supports(Script.ElementByName['Local Variables'], IwbContainerElementRef, LocalVars) then begin\n for i := 0 to Pred(LocalVars.ElementCount) do\n if Supports(LocalVars.Elements[i], IwbContainerElementRef, LocalVar) then begin\n j := LocalVar.ElementNativeValues['SLSD\\Index'];\n s := LocalVar.ElementNativeValues['SCVR'];\n if SameText(s, Trim(aString)) then begin\n Result := j;\n Exit;\n end;\n end;\n end;\n\n raise Exception.Create('Variable \"'+aString+'\" was not found in \"'+MainRecord.ShortName+'\"');\nend;\n\nfunction wbCTDAParam2QuestStageToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Stages : IwbContainerElementRef;\n Stage : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Stages'], IwbContainerElementRef, Stages) then begin\n for i := 0 to Pred(Stages.ElementCount) do\n if Supports(Stages.Elements[i], IwbContainerElementRef, Stage) then begin\n j := Stage.ElementNativeValues['INDX'];\n s := Trim(Stage.ElementValues['Log Entries\\Log Entry\\CNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbPerkDATAQuestStageToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Stages : IwbContainerElementRef;\n Stage : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Quest'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Stages'], IwbContainerElementRef, Stages) then begin\n for i := 0 to Pred(Stages.ElementCount) do\n if Supports(Stages.Elements[i], IwbContainerElementRef, Stage) then begin\n j := Stage.ElementNativeValues['INDX'];\n s := Trim(Stage.ElementValues['Log Entries\\Log Entry\\CNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbCTDAParam2QuestObjectiveToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Objectives : IwbContainerElementRef;\n Objective : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Objectives'], IwbContainerElementRef, Objectives) then begin\n for i := 0 to Pred(Objectives.ElementCount) do\n if Supports(Objectives.Elements[i], IwbContainerElementRef, Objective) then begin\n j := Objective.ElementNativeValues['QOBJ'];\n s := Trim(Objective.ElementValues['NNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbCTDAParam2QuestStageToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i : Integer;\n s : string;\nbegin\n i := 1;\n s := Trim(aString);\n while (i <= Length(s)) and (s[i] in ['0'..'9']) do\n Inc(i);\n s := Copy(s, 1, Pred(i));\n\n Result := StrToInt(s);\nend;\n\nfunction wbCTDAParam2QuestObjectiveToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i : Integer;\n s : string;\nbegin\n i := 1;\n s := Trim(aString);\n while (i <= Length(s)) and (s[i] in ['0'..'9']) do\n Inc(i);\n s := Copy(s, 1, Pred(i));\n\n Result := StrToInt(s);\nend;\n\n\nfunction wbClmtMoonsPhaseLength(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n PhaseLength : Byte;\n Masser : Boolean;\n Secunda : Boolean;\nbegin\n Result := '';\n if aType = ctToSortKey then begin\n Result := IntToHex64(aInt, 2);\n end else if aType = ctToStr then begin\n PhaseLength := aInt mod 64;\n Masser := (aInt and 64) <> 0;\n Secunda := (aInt and 128) <> 0;\n if Masser then\n if Secunda then\n Result := 'Masser, Secunda / '\n else\n Result := 'Masser / '\n else\n if Secunda then\n Result := 'Secunda / '\n else\n Result := 'No Moon / ';\n Result := Result + IntToStr(PhaseLength);\n end;\nend;\n\nfunction wbClmtTime(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n Result := TimeToStr( EncodeTime(aInt div 6, (aInt mod 6) * 10, 0, 0) )\n else\n Result := '';\nend;\n\nfunction wbREFRNavmeshTriangleToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Navmesh : IwbElement;\n MainRecord : IwbMainRecord;\n Triangles : IwbContainerElementRef;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt);\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Navmesh := Container.Elements[0];\n\n if not Assigned(Navmesh) then\n Exit;\n\n if not Supports(Navmesh.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> NAVM then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n if not wbSimpleRecords and (aType = ctCheck) and Supports(MainRecord.ElementByPath['NVTR'], IwbContainerElementRef, Triangles) then\n if aInt >= Triangles.ElementCount then\n Result := '';\nend;\n\nfunction wbStringToInt(const aString: string; const aElement: IwbElement): Int64;\nbegin\n Result := StrToIntDef(aString, 0);\nend;\n\n\nvar\n wbCtdaTypeFlags : IwbFlagsDef;\n\nfunction wbCtdaTypeToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n s: string;\nbegin\n Result := '';\n case aType of\n ctEditType:\n Result := 'CheckComboBox';\n ctEditInfo:\n Result := 'Equal,Greater,Lesser,Or,\"Use Global\",\"Run on Target\"';\n ctToEditValue: begin\n Result := '000000';\n case aInt and $F0 of\n $00 : Result[1] := '1';\n $40 : Result[2] := '1';\n $60 : begin\n Result[1] := '1';\n Result[2] := '1';\n end;\n $80 : Result[3] := '1';\n $A0 : begin\n Result[1] := '1';\n Result[3] := '1';\n end;\n end;\n if (aInt and $01) <> 0 then\n Result[4] := '1';\n if (aInt and $02) <> 0 then\n Result[6] := '1';\n if (aInt and $04) <> 0 then\n Result[5] := '1';\n end;\n ctToStr: begin\n case aInt and $F0 of\n $00 : Result := 'Equal to';\n $20 : Result := 'Not equal to';\n $40 : Result := 'Greater than';\n $60 : Result := 'Greater than or equal to';\n $80 : Result := 'Less than';\n $A0 : Result := 'Less than or equal to';\n else\n Result := ''\n end;\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Run on target',\n {0x04} 'Use global'\n ]);\n\n s := wbCtdaTypeFlags.ToString(aInt and $0F, aElement);\n\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: begin\n case aInt and $F0 of\n $00, $20, $40, $60, $80, $A0 : Result := '';\n else\n Result := ''\n end;\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Run on target',\n {0x04} 'Use global'\n ]);\n\n s := wbCtdaTypeFlags.Check(aInt and $0F, aElement);\n\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n end;\nend;\n\nfunction wbCtdaTypeToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\nbegin\n s := aString + '000000';\n// Result := 0;\n if s[1] = '1' then begin\n if s[2] = '1' then begin\n if s[3] = '1' then begin\n Result := $00;\n end else begin\n Result := $60;\n end;\n end else begin\n if s[3] = '1' then begin\n Result := $A0;\n end else begin\n Result := $00;\n end;\n end;\n end else begin\n if s[2] = '1' then begin\n if s[3] = '1' then begin\n Result := $20;\n end else begin\n Result := $40;\n end;\n end else begin\n if s[3] = '1' then begin\n Result := $80;\n end else begin\n Result := $20;\n end;\n end;\n end;\n if s[4] = '1' then\n Result := Result or $01;\n if s[6] = '1' then\n Result := Result or $02;\n if s[5] = '1' then\n Result := Result or $04;\nend;\n\nprocedure wbHeadPartsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainerElementRef;\nbegin\n if wbBeginInternalEdit then try\n if Supports(aElement, IwbContainerElementRef, Container) then\n if (Container.Elements[0].NativeValue = 1) and (Container.ElementCount > 2) then\n Container.RemoveElement(1);\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMESGDNAMAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : Integer;\n Container : IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := Integer(aOldValue) and 1;\n NewValue := Integer(aNewValue) and 1;\n if NewValue = OldValue then\n Exit;\n if NewValue = 1 then\n Container.RemoveElement('TNAM')\n else\n Container.Add('TNAM', True);\n end;\nend;\n\nprocedure wbGMSTEDIDAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : string;\n Container : IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := aOldValue;\n NewValue := aNewValue;\n if (Length(OldValue) < 1) or (Length(OldValue) < 1) or (OldValue[1] <> NewValue[1]) then begin\n Container.RemoveElement('DATA');\n Container.Add('DATA', True);\n end;\n end;\nend;\n\nprocedure wbFLSTEDIDAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : string;\n OldOrdered, NewOrdered : Boolean;\n Container : IwbContainerElementRef;\nconst\n OrderedList = 'OrderedList';\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := aOldValue;\n NewValue := aNewValue;\n\n if Length(OldValue) > Length(OrderedList) then\n Delete(OldValue, 1, Length(OldValue)-Length(OrderedList));\n if Length(NewValue) > Length(OrderedList) then\n Delete(NewValue, 1, Length(NewValue)-Length(OrderedList));\n\n OldOrdered := SameText(OldValue, OrderedList);\n NewOrdered := SameText(NewValue, OrderedList);\n\n if OldOrdered <> NewOrdered then\n Container.RemoveElement('FormIDs');\n end;\nend;\n\nprocedure wbCtdaTypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue: Integer;\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n OldValue := aOldValue and $04;\n NewValue := aNewValue and $04;\n if OldValue <> NewValue then\n Container.ElementNativeValues['..\\Comparison Value'] := 0;\n\n if aNewValue and $02 then begin\n Container.ElementNativeValues['..\\Run On'] := 1;\n if Integer(Container.ElementNativeValues['..\\Run On']) = 1 then\n aElement.NativeValue := Byte(aNewValue) and not $02;\n end;\nend;\n\nfunction wbMODTCallback(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Strings: TDynStrings;\n i: Integer;\nbegin\n Result := '';\n if wbLoaderDone and (aType in [ctToStr, ctToSortKey] ) then begin\n Strings := wbContainerHandler.ResolveHash(aInt);\n for i := Low(Strings) to High(Strings) do\n Result := Result + Strings[i] + ', ';\n SetLength(Result, Length(Result) -2 );\n end;\nend;\n\n\nfunction wbIdleAnam(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and not $C0 of\n 0: Result := 'Idle';\n 1: Result := 'Movement';\n 2: Result := 'Left Arm';\n 3: Result := 'Left Hand';\n 4: Result := 'Weapon';\n 5: Result := 'Weapon Up';\n 6: Result := 'Weapon Down';\n 7: Result := 'Special Idle';\n 20: Result := 'Whole Body';\n 21: Result := 'Upper Body';\n else\n Result := '';\n end;\n\n if (aInt and $80) = 0 then\n Result := Result + ', Must return a file';\n if (aInt and $40) = 1 then\n Result := Result + ', Unknown Flag';\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n end;\n ctCheck: begin\n case aInt and not $C0 of\n 0..7, 20, 21: Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbScaledInt4ToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nconst\n PlusMinus : array[Boolean] of string = ('+', '-');\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n ctToSortKey: begin\n Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n if Length(Result) < 22 then\n Result := StringOfChar('0', 22 - Length(Result)) + Result;\n Result := PlusMinus[aInt < 0] + Result;\n end;\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbScaledInt4ToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n f: Extended;\nbegin\n f := StrToFloat(aString);\n f := f * 10000;\n Result := Round(f);\nend;\n\nfunction wbHideFFFF(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n if aInt = $FFFF then\n Result := 'None'\n else\n Result := IntToStr(aInt);\nend;\n\nfunction wbAtxtPosition(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt div 17, 2) + IntToHex64(aInt mod 17, 2)\n else if aType = ctCheck then begin\n if (aInt < 0) or (aInt > 288) then\n Result := ''\n else\n Result := '';\n end else if aType = ctToStr then\n Result := IntToStr(aInt) + ' -> ' + IntToStr(aInt div 17) + ':' + IntToStr(aInt mod 17);\nend;\n\nfunction wbGLOBFNAM(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt of\n Ord('s'): Result := 'Short';\n Ord('l'): Result := 'Long';\n Ord('f'): Result := 'Float';\n else\n Result := '';\n end;\n end;\n ctToSortKey: Result := Chr(aInt);\n ctCheck: begin\n case aInt of\n Ord('s'), Ord('l'), Ord('f'): Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPlacedAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n s: string;\n Cell: IwbMainRecord;\n Position: TwbVector;\n Grid: TwbGridCell;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['NAME'];\n if Assigned(Rec) then begin\n s := Trim(Rec.Value);\n if s <> '' then\n Result := 'places ' + s;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n\n // grid position of persistent reference in exterior persistent cell (interior cells are not persistent)\n if Supports(aMainRecord.Container, IwbGroupRecord, Container) then\n Cell := IwbGroupRecord(Container).ChildrenOf;\n if Assigned(Cell) and Cell.IsPersistent and (Cell.Signature = 'CELL') then\n if aMainRecord.GetPosition(Position) then begin\n Grid := wbPositionToGridCell(Position);\n Result := Result + ' at ' + IntToStr(Grid.x) + ',' + IntToStr(Grid.y);\n end;\n end;\n end;\nend;\n\nfunction wbINFOAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Container: IwbContainer;\n s: string;\nbegin\n Result := Trim(aMainRecord.ElementValues['Responses\\Response\\NAM1']);\n if Result <> '' then\n Result := '''' + Result + '''';\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n end;\n end;\n\n s := Trim(aMainRecord.ElementValues['QSTI']);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'for ' + s;\n end;\nend;\n\nfunction wbNAVMAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec : IwbRecord;\n Element : IwbElement;\n s : string;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['DATA'];\n if Assigned(Rec) then begin\n Element := Rec.ElementByName['Cell'];\n if Assigned(Element) then\n Element := Element.LinksTo;\n if Assigned(Element) then\n s := Trim(Element.Name);\n if s <> '' then\n Result := 'for ' + s;\n end;\nend;\n\nfunction wbCellAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n GroupRecord : IwbGroupRecord;\n s: string;\nbegin\n Result := '';\n\n if not aMainRecord.IsPersistent then begin\n Rec := aMainRecord.RecordBySignature['XCLC'];\n if Assigned(Rec) then\n Result := 'at ' + Rec.Elements[0].Value + ',' + Rec.Elements[1].Value;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and not\n (Supports(Container, IwbGroupRecord, GroupRecord) and (GroupRecord.GroupType = 1)) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := wbFormID.ToString(GroupRecord.GroupLabel, aMainRecord);\n if s <> '' then begin\n if Result <> '' then\n s := s + ' ';\n Result := 'in ' + s + Result;\n end;\n end;\nend;\n\nfunction wbWthrDataClassification(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and not 192 of\n 0: Result := 'None';\n 1: Result := 'Pleasant';\n 2: Result := 'Cloudy';\n 4: Result := 'Rainy';\n 8: Result := 'Snow';\n else\n Result := '';\n end;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2)\n end;\n ctCheck: begin\n case aInt and not 192 of\n 0, 1, 2, 4, 8: Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbNOTETNAMDecide(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rDATA: IwbRecord;\nbegin\n Result := 0;\n rDATA := aElement.Container.RecordBySignature[DATA];\n if Assigned(rDATA) then\n if rDATA.NativeValue = 3 then //Voice\n Result := 1;\nend;\n\nfunction wbNOTESNAMDecide(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rDATA: IwbRecord;\nbegin\n Result := 0;\n rDATA := aElement.Container.RecordBySignature[DATA];\n if Assigned(rDATA) then\n if rDATA.NativeValue = 3 then //Voice\n Result := 1;\nend;\n\nfunction wbIPDSDATACount(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nbegin\n if Assigned(aBasePtr) and Assigned(aEndPtr) then\n Result := (Cardinal(aBasePtr) - Cardinal(aBasePtr)) div 4\n else\n Result := 12;\nend;\n\nfunction wbNAVINAVMGetCount1(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n DataContainer : IwbDataContainer;\nbegin\n Result := 0;\n\n if Supports(aElement, IwbDataContainer, DataContainer) then begin\n if DataContainer.ElementType = etArray then\n if not Supports(DataContainer.Container, IwbDataContainer, DataContainer) then\n Exit;\n Assert(DataContainer.Name = 'Data');\n Result := PWord(Cardinal(DataContainer.DataBasePtr) + 3*3*4)^;\n end;\nend;\n\nfunction wbNAVINAVMGetCount2(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n DataContainer : IwbDataContainer;\nbegin\n Result := 0;\n\n if Supports(aElement, IwbDataContainer, DataContainer) then begin\n if DataContainer.ElementType = etArray then\n if not Supports(DataContainer.Container, IwbDataContainer, DataContainer) then\n Exit;\n Assert(DataContainer.Name = 'Data');\n Result := PWord(Cardinal(DataContainer.DataBasePtr) + 3*3*4 + 2)^;\n end;\nend;\n\nprocedure wbCTDARunOnAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n if aOldValue <> aNewValue then\n if aNewValue <> 2 then\n aElement.Container.ElementNativeValues['Reference'] := 0;\nend;\n\nprocedure wbPERKPRKETypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainerElementRef;\n// rDATA : IwbRecord;\nbegin\n if aOldValue <> aNewValue then\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n if Supports(Container.Container, IwbContainerElementRef, Container) then begin\n Container.RemoveElement('DATA');\n Container.Add('DATA', True);\n Container.RemoveElement('Perk Conditions');\n Container.RemoveElement('Entry Point Function Parameters');\n if aNewValue = 2 then begin\n Container.Add('EPFT', True);\n Container.ElementNativeValues['DATA\\Entry Point\\Function'] := 2;\n end;\n end;\n end;\nend;\n\nfunction wbMGEFFAssocItemDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n Archtype : Variant;\n DataContainer : IwbDataContainer;\n Element : IwbElement;\nconst\n OffsetArchtype = 56;\n\nbegin\n Result := 1;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n VarClear(ArchType);\n Element := Container.ElementByName['Archtype'];\n if Assigned(Element) then\n ArchType := Element.NativeValue\n else if Supports(Container, IwbDataContainer, DataContainer) and\n DataContainer.IsValidOffset(aBasePtr, aEndPtr, OffsetArchtype) then\n \tbegin // we are part of a proper structure\n aBasePtr := Pointer(Cardinal(aBasePtr) + OffsetArchtype);\n ArchType := PCardinal(aBasePtr)^;\n end;\n\n if not VarIsEmpty(ArchType) then\n case Integer(ArchType) of\n 01: Result := 2;//Script\n 18: Result := 3;//Bound Item\n 19: Result := 4;//Summon Creature\n else\n Result := 0;\n end;\nend;\n\nprocedure wbMGEFFAssocItemAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainer;\n Element : IwbElement;\nbegin\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if (aNewValue <> 0) then begin\n Element := Container.ElementByName['Archtype'];\n if Assigned(Element) and Element.NativeValue = 0 then\n Element.NativeValue := $FF; // Signals ArchType that it should not mess with us on the next change!\n end;\nend;\n\nprocedure wbMGEFArchtypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if (aNewValue < $FF) and (aOldValue < $FF) then begin\n Container.ElementNativeValues['..\\Assoc. Item'] := 0;\n case Integer(aNewValue) of\n 11: Container.ElementNativeValues['..\\Actor Value'] := 48;//Invisibility\n 12: Container.ElementNativeValues['..\\Actor Value'] := 49;//Chameleon\n 24: Container.ElementNativeValues['..\\Actor Value'] := 47;//Paralysis\n else\n Container.ElementNativeValues['..\\Actor Value'] := -1;\n end;\n end;\nend;\n\nprocedure wbCounterEffectsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterByPathAfterSet('DATA - Data\\Counter effect count', aElement);\nend;\n\nprocedure wbMGEFAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerByPathAfterSet('DATA - Data\\Counter effect count', 'Counter Effects', aElement);\nend;\n\nfunction wbCTDAReferenceDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Integer(Container.ElementNativeValues['Run On']) = 2 then\n Result := 1;\nend;\n\nfunction wbNAVINVMIDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n case Integer(Container.ElementNativeValues['Type']) of\n $00: Result :=1;\n $20: Result :=2;\n $30: Result :=3;\n end;\nend;\n\nfunction wbIMGSSkinDimmerDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Supports(Container, IwbSubRecord, SubRecord) then\n if SubRecord.SubRecordHeaderSize in [132, 148] then\n Result := 1;\nend;\n\nfunction wbCOEDOwnerDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n LinksTo : IwbElement;\n MainRecord : IwbMainRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n LinksTo := Container.ElementByName['Owner'].LinksTo;\n\n if Supports(LinksTo, IwbMainRecord, MainRecord) then\n if MainRecord.Signature = 'NPC_' then\n Result := 1\n else if MainRecord.Signature = 'FACT' then\n Result := 2;\nend;\n\nfunction wbCreaLevelDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\n i: Int64;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n i := Container.ElementByName['Flags'].NativeValue;\n if i and $00000080 <> 0 then\n Result := 1;\nend;\n\n\nfunction wbGMSTUnionDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rEDID: IwbRecord;\n s: string;\nbegin\n Result := 1;\n rEDID := aElement.Container.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > 0 then\n case s[1] of\n 's': Result := 0;\n 'f': Result := 2;\n end;\n end;\nend;\n\nfunction wbFLSTLNAMIsSorted(const aContainer: IwbContainer): Boolean;\nvar\n rEDID : IwbRecord;\n s : string;\n _File : IwbFile;\n MainRecord : IwbMainRecord;\nconst\n OrderedList = 'OrderedList';\nbegin\n Result := wbSortFLST; {>>> Should not be sorted according to Arthmoor and JustinOther, left as sorted for compatibility <<<}\n rEDID := aContainer.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > Length(OrderedList) then\n Delete(s, 1, Length(s)-Length(OrderedList));\n if SameText(s, OrderedList) then\n Result := False;\n end;\n if Result then begin\n MainRecord := aContainer.ContainingMainRecord;\n if not Assigned(MainRecord) then\n Exit;\n MainRecord := MainRecord.MasterOrSelf;\n if not Assigned(MainRecord) then\n Exit;\n _File := MainRecord._File;\n if not Assigned(_File) then\n Exit;\n if not SameText(_File.FileName, 'WeaponModKits.esp') then\n Exit;\n case (MainRecord.FormID and $FFFFFF) of\n $0130EB, $0130ED, $01522D, $01522E, $0158D5, $0158D6, $0158D7, $0158D8, $0158D9, $0158DA, $0158DC, $0158DD, $018E20:\n Result := False;\n end;\n end;\nend;\n\nfunction wbPerkDATADecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rPRKE: IwbRecord;\n eType: IwbElement;\nbegin\n Result := 0;\n rPRKE := aElement.Container.RecordBySignature[PRKE];\n if Assigned(rPRKE) then begin\n eType := rPRKE.ElementByName['Type'];\n if Assigned(eType) then begin\n Result := eType.NativeValue;\n end;\n end;\nend;\n\nfunction wbEPFDDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := 0;\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n Result := Container.ElementNativeValues['EPFT'];\n if Result = 2 then\n if Integer(Container.ElementNativeValues['..\\DATA\\Entry Point\\Function']) = 5 then\n Result := 5;\nend;\n\ntype\n TCTDAFunctionParamType = (\n ptNone,\n ptInteger,\n ptVariableName, //Integer\n ptSex, //Enum: Male, Female\n ptActorValue, //Enum: wbActorValue\n ptCrimeType, //?? Enum\n ptAxis, //?? Char\n ptQuestStage, //?? Integer\n ptMiscStat, //?? Enum\n ptAlignment, //?? Enum\n ptEquipType, //?? Enum\n ptFormType, //?? Enum\n ptCriticalStage, //?? Enum\n\n ptObjectReference, //REFR, ACHR, ACRE, PGRE\n ptInventoryObject, //ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, ARMA\n ptActor, //ACHR, ACRE\n ptVoiceType, //VTYP\n ptIdleForm, //IDLE\n ptFormList, //FLST\n ptNote, //NOTE\n ptQuest, //QUST\n ptFaction, //FACT\n ptWeapon, //WEAP\n ptCell, //CELL\n ptClass, //CLAS\n ptRace, //RACE\n ptActorBase, //NPC_, CREA\n ptGlobal, //GLOB\n ptWeather, //WTHR\n ptPackage, //PACK\n ptEncounterZone, //ECZN\n ptPerk, //PERK\n ptOwner, //FACT, NPC_\n ptFurniture, //FURN\n ptMagicItem, //SPEL\n ptMagicEffect, //MGEF\n ptWorldspace, //WRLD\n ptVATSValueFunction,\n ptVATSValueParam,\n ptCreatureType,\n ptMenuMode,\n ptPlayerAction,\n ptBodyLocation,\n ptReferencableObject //TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM\n );\n\n PCTDAFunction = ^TCTDAFunction;\n TCTDAFunction = record\n Index: Integer;\n Name: string;\n ParamType1: TCTDAFunctionParamType;\n ParamType2: TCTDAFunctionParamType;\n end;\n\nconst\n wbCTDAFunctions : array[0..243] of TCTDAFunction = (\n (Index: 1; Name: 'GetDistance'; ParamType1: ptObjectReference),\n (Index: 5; Name: 'GetLocked'),\n (Index: 6; Name: 'GetPos'; ParamType1: ptAxis),\n (Index: 8; Name: 'GetAngle'; ParamType1: ptAxis),\n (Index: 10; Name: 'GetStartingPos'; ParamType1: ptAxis),\n (Index: 11; Name: 'GetStartingAngle'; ParamType1: ptAxis),\n (Index: 12; Name: 'GetSecondsPassed'),\n (Index: 14; Name: 'GetActorValue'; ParamType1: ptActorValue),\n (Index: 18; Name: 'GetCurrentTime'),\n (Index: 24; Name: 'GetScale'),\n (Index: 25; Name: 'IsMoving'),\n (Index: 26; Name: 'IsTurning'),\n (Index: 27; Name: 'GetLineOfSight'; ParamType1: ptObjectReference),\n (Index: 32; Name: 'GetInSameCell'; ParamType1: ptObjectReference),\n (Index: 35; Name: 'GetDisabled'),\n (Index: 36; Name: 'MenuMode'; ParamType1: ptMenuMode),\n (Index: 39; Name: 'GetDisease'),\n (Index: 40; Name: 'GetVampire'),\n (Index: 41; Name: 'GetClothingValue'),\n (Index: 42; Name: 'SameFaction'; ParamType1: ptActor),\n (Index: 43; Name: 'SameRace'; ParamType1: ptActor),\n (Index: 44; Name: 'SameSex'; ParamType1: ptActor),\n (Index: 45; Name: 'GetDetected'; ParamType1: ptActor),\n (Index: 46; Name: 'GetDead'),\n (Index: 47; Name: 'GetItemCount'; ParamType1: ptInventoryObject),\n (Index: 48; Name: 'GetGold'),\n (Index: 49; Name: 'GetSleeping'),\n (Index: 50; Name: 'GetTalkedToPC'),\n (Index: 53; Name: 'GetScriptVariable'; ParamType1: ptObjectReference; ParamType2: ptVariableName),\n (Index: 56; Name: 'GetQuestRunning'; ParamType1: ptQuest),\n (Index: 58; Name: 'GetStage'; ParamType1: ptQuest),\n (Index: 59; Name: 'GetStageDone'; ParamType1: ptQuest; ParamType2: ptQuestStage),\n (Index: 60; Name: 'GetFactionRankDifference'; ParamType1: ptFaction; ParamType2: ptActor),\n (Index: 61; Name: 'GetAlarmed'),\n (Index: 62; Name: 'IsRaining'),\n (Index: 63; Name: 'GetAttacked'),\n (Index: 64; Name: 'GetIsCreature'),\n (Index: 65; Name: 'GetLockLevel'),\n (Index: 66; Name: 'GetShouldAttack'; ParamType1: ptActor),\n (Index: 67; Name: 'GetInCell'; ParamType1: ptCell),\n (Index: 68; Name: 'GetIsClass'; ParamType1: ptClass),\n (Index: 69; Name: 'GetIsRace'; ParamType1: ptRace),\n (Index: 70; Name: 'GetIsSex'; ParamType1: ptSex),\n (Index: 71; Name: 'GetInFaction'; ParamType1: ptFaction),\n (Index: 72; Name: 'GetIsID'; ParamType1: ptReferencableObject),\n (Index: 73; Name: 'GetFactionRank'; ParamType1: ptFaction),\n (Index: 74; Name: 'GetGlobalValue'; ParamType1: ptGlobal),\n (Index: 75; Name: 'IsSnowing'),\n (Index: 76; Name: 'GetDisposition'; ParamType1: ptActor),\n (Index: 77; Name: 'GetRandomPercent'),\n (Index: 79; Name: 'GetQuestVariable'; ParamType1: ptQuest; ParamType2: ptVariableName),\n (Index: 80; Name: 'GetLevel'),\n (Index: 81; Name: 'GetArmorRating'),\n (Index: 84; Name: 'GetDeadCount'; ParamType1: ptActorBase),\n (Index: 91; Name: 'GetIsAlerted'),\n (Index: 98; Name: 'GetPlayerControlsDisabled'; ParamType1: ptInteger; ParamType2: ptInteger{; ParamType3: ptInteger; ParamType4: ptInteger; ParamType5: ptInteger; ParamType6: ptInteger; ParamType7: ptInteger}),\n (Index: 99; Name: 'GetHeadingAngle'; ParamType1: ptObjectReference),\n (Index: 101; Name: 'IsWeaponOut'),\n (Index: 102; Name: 'IsTorchOut'),\n (Index: 103; Name: 'IsShieldOut'),\n (Index: 106; Name: 'IsFacingUp'),\n (Index: 107; Name: 'GetKnockedState'),\n (Index: 108; Name: 'GetWeaponAnimType'),\n (Index: 109; Name: 'IsWeaponSkillType'; ParamType1: ptActorValue),\n (Index: 110; Name: 'GetCurrentAIPackage'),\n (Index: 111; Name: 'IsWaiting'),\n (Index: 112; Name: 'IsIdlePlaying'),\n (Index: 116; Name: 'GetMinorCrimeCount'),\n (Index: 117; Name: 'GetMajorCrimeCount'),\n (Index: 118; Name: 'GetActorAggroRadiusViolated'),\n (Index: 122; Name: 'GetCrime'; ParamType1: ptActor; ParamType2: ptCrimeType),\n (Index: 123; Name: 'IsGreetingPlayer'),\n (Index: 125; Name: 'IsGuard'),\n (Index: 127; Name: 'HasBeenEaten'),\n (Index: 128; Name: 'GetFatiguePercentage'),\n (Index: 129; Name: 'GetPCIsClass'; ParamType1: ptClass),\n (Index: 130; Name: 'GetPCIsRace'; ParamType1: ptRace),\n (Index: 131; Name: 'GetPCIsSex'; ParamType1: ptSex),\n (Index: 132; Name: 'GetPCInFaction'; ParamType1: ptFaction),\n (Index: 133; Name: 'SameFactionAsPC'),\n (Index: 134; Name: 'SameRaceAsPC'),\n (Index: 135; Name: 'SameSexAsPC'),\n (Index: 136; Name: 'GetIsReference'; ParamType1: ptObjectReference),\n (Index: 141; Name: 'IsTalking'),\n (Index: 142; Name: 'GetWalkSpeed'),\n (Index: 143; Name: 'GetCurrentAIProcedure'),\n (Index: 144; Name: 'GetTrespassWarningLevel'),\n (Index: 145; Name: 'IsTrespassing'),\n (Index: 146; Name: 'IsInMyOwnedCell'),\n (Index: 147; Name: 'GetWindSpeed'),\n (Index: 148; Name: 'GetCurrentWeatherPercent'),\n (Index: 149; Name: 'GetIsCurrentWeather'; ParamType1: ptWeather),\n (Index: 150; Name: 'IsContinuingPackagePCNear'),\n (Index: 153; Name: 'CanHaveFlames'),\n (Index: 154; Name: 'HasFlames'),\n (Index: 157; Name: 'GetOpenState'),\n (Index: 159; Name: 'GetSitting'),\n (Index: 160; Name: 'GetFurnitureMarkerID'),\n (Index: 161; Name: 'GetIsCurrentPackage'; ParamType1: ptPackage),\n (Index: 162; Name: 'IsCurrentFurnitureRef'; ParamType1: ptObjectReference),\n (Index: 163; Name: 'IsCurrentFurnitureObj'; ParamType1: ptFurniture),\n (Index: 170; Name: 'GetDayOfWeek'),\n (Index: 172; Name: 'GetTalkedToPCParam'; ParamType1: ptActor),\n (Index: 175; Name: 'IsPCSleeping'),\n (Index: 176; Name: 'IsPCAMurderer'),\n (Index: 180; Name: 'GetDetectionLevel'; ParamType1: ptActor),\n (Index: 182; Name: 'GetEquipped'; ParamType1: ptInventoryObject),\n (Index: 185; Name: 'IsSwimming'),\n (Index: 190; Name: 'GetAmountSoldStolen'),\n (Index: 192; Name: 'GetIgnoreCrime'),\n (Index: 193; Name: 'GetPCExpelled'; ParamType1: ptFaction),\n (Index: 195; Name: 'GetPCFactionMurder'; ParamType1: ptFaction),\n (Index: 197; Name: 'GetPCEnemyofFaction'; ParamType1: ptFaction),\n (Index: 199; Name: 'GetPCFactionAttack'; ParamType1: ptFaction),\n (Index: 203; Name: 'GetDestroyed'),\n (Index: 214; Name: 'HasMagicEffect'; ParamType1: ptMagicEffect),\n (Index: 215; Name: 'GetDefaultOpen'),\n (Index: 219; Name: 'GetAnimAction'),\n (Index: 223; Name: 'IsSpellTarget'; ParamType1: ptMagicItem),\n (Index: 224; Name: 'GetVATSMode'),\n (Index: 225; Name: 'GetPersuasionNumber'),\n (Index: 226; Name: 'GetSandman'),\n (Index: 227; Name: 'GetCannibal'),\n (Index: 228; Name: 'GetIsClassDefault'; ParamType1: ptClass),\n (Index: 229; Name: 'GetClassDefaultMatch'),\n (Index: 230; Name: 'GetInCellParam'; ParamType1: ptCell; ParamType2: ptObjectReference),\n (Index: 235; Name: 'GetVatsTargetHeight'),\n (Index: 237; Name: 'GetIsGhost'),\n (Index: 242; Name: 'GetUnconscious'),\n (Index: 244; Name: 'GetRestrained'),\n (Index: 246; Name: 'GetIsUsedItem'; ParamType1: ptReferencableObject),\n (Index: 247; Name: 'GetIsUsedItemType'; ParamType1: ptFormType),\n (Index: 254; Name: 'GetIsPlayableRace'),\n (Index: 255; Name: 'GetOffersServicesNow'),\n (Index: 258; Name: 'GetUsedItemLevel'),\n (Index: 259; Name: 'GetUsedItemActivate'),\n (Index: 264; Name: 'GetBarterGold'),\n (Index: 265; Name: 'IsTimePassing'),\n (Index: 266; Name: 'IsPleasant'),\n (Index: 267; Name: 'IsCloudy'),\n (Index: 274; Name: 'GetArmorRatingUpperBody'),\n (Index: 277; Name: 'GetBaseActorValue'; ParamType1: ptActorValue),\n (Index: 278; Name: 'IsOwner'; ParamType1: ptOwner),\n (Index: 280; Name: 'IsCellOwner'; ParamType1: ptCell; ParamType2: ptOwner),\n (Index: 282; Name: 'IsHorseStolen'),\n (Index: 285; Name: 'IsLeftUp'),\n (Index: 286; Name: 'IsSneaking'),\n (Index: 287; Name: 'IsRunning'),\n (Index: 288; Name: 'GetFriendHit'),\n (Index: 289; Name: 'IsInCombat'),\n (Index: 300; Name: 'IsInInterior'),\n (Index: 304; Name: 'IsWaterObject'),\n (Index: 306; Name: 'IsActorUsingATorch'),\n (Index: 309; Name: 'IsXBox'),\n (Index: 310; Name: 'GetInWorldspace'; ParamType1: ptWorldSpace),\n (Index: 312; Name: 'GetPCMiscStat'; ParamType1: ptMiscStat),\n (Index: 313; Name: 'IsActorEvil'),\n (Index: 314; Name: 'IsActorAVictim'),\n (Index: 315; Name: 'GetTotalPersuasionNumber'),\n (Index: 318; Name: 'GetIdleDoneOnce'),\n (Index: 320; Name: 'GetNoRumors'),\n (Index: 323; Name: 'WhichServiceMenu'),\n (Index: 327; Name: 'IsRidingHorse'),\n (Index: 332; Name: 'IsInDangerousWater'),\n (Index: 338; Name: 'GetIgnoreFriendlyHits'),\n (Index: 339; Name: 'IsPlayersLastRiddenHorse'),\n (Index: 353; Name: 'IsActor'),\n (Index: 354; Name: 'IsEssential'),\n (Index: 358; Name: 'IsPlayerMovingIntoNewSpace'),\n (Index: 361; Name: 'GetTimeDead'),\n (Index: 362; Name: 'GetPlayerHasLastRiddenHorse'),\n (Index: 365; Name: 'IsChild'),\n (Index: 367; Name: 'GetLastPlayerAction'),\n (Index: 368; Name: 'IsPlayerActionActive'; ParamType1: ptPlayerAction),\n (Index: 370; Name: 'IsTalkingActivatorActor'; ParamType1: ptActor),\n (Index: 372; Name: 'IsInList'; ParamType1: ptFormList),\n (Index: 382; Name: 'GetHasNote'; ParamType1: ptNote),\n (Index: 391; Name: 'GetHitLocation'),\n (Index: 392; Name: 'IsPC1stPerson'),\n (Index: 397; Name: 'GetCauseofDeath'),\n (Index: 398; Name: 'IsLimbGone'; ParamType1: ptBodyLocation),\n (Index: 399; Name: 'IsWeaponInList'; ParamType1: ptFormList),\n (Index: 403; Name: 'HasFriendDisposition'),\n (Index: 408; Name: 'GetVATSValue'; ParamType1: ptVATSValueFunction; ParamType2: ptVATSValueParam),\n (Index: 409; Name: 'IsKiller'; ParamType1: ptActor),\n (Index: 410; Name: 'IsKillerObject'; ParamType1: ptFormList),\n (Index: 411; Name: 'GetFactionCombatReaction'; ParamType1: ptFaction; ParamType2: ptFaction),\n (Index: 415; Name: 'Exists'; ParamType1: ptObjectReference),\n (Index: 416; Name: 'GetGroupMemberCount'),\n (Index: 417; Name: 'GetGroupTargetCount'),\n (Index: 427; Name: 'GetIsVoiceType'; ParamType1: ptVoiceType),\n (Index: 428; Name: 'GetPlantedExplosive'),\n (Index: 430; Name: 'IsActorTalkingThroughActivator'),\n (Index: 431; Name: 'GetHealthPercentage'),\n (Index: 433; Name: 'GetIsObjectType'; ParamType1: ptFormType),\n (Index: 435; Name: 'GetDialogueEmotion'),\n (Index: 436; Name: 'GetDialogueEmotionValue'),\n (Index: 438; Name: 'GetIsCreatureType'; ParamType1: ptCreatureType),\n (Index: 446; Name: 'GetInZone'; ParamType1: ptEncounterZone),\n (Index: 449; Name: 'HasPerk'; ParamType1: ptPerk),\n (Index: 450; Name: 'GetFactionRelation'; ParamType1: ptActor),\n (Index: 451; Name: 'IsLastIdlePlayed'; ParamType1: ptIdleForm),\n (Index: 454; Name: 'GetPlayerTeammate'),\n (Index: 455; Name: 'GetPlayerTeammateCount'),\n (Index: 459; Name: 'GetActorCrimePlayerEnemy'),\n (Index: 460; Name: 'GetActorFactionPlayerEnemy'),\n (Index: 464; Name: 'IsPlayerGrabbedRef'; ParamType1: ptObjectReference),\n (Index: 471; Name: 'GetDestructionStage'),\n (Index: 474; Name: 'GetIsAlignment'; ParamType1: ptAlignment),\n (Index: 478; Name: 'GetThreatRatio'; ParamType1: ptActor),\n (Index: 480; Name: 'GetIsUsedItemEquipType'; ParamType1: ptEquipType),\n (Index: 489; Name: 'GetConcussed'),\n (Index: 492; Name: 'GetMapMarkerVisible'),\n (Index: 495; Name: 'GetPermanentActorValue'; ParamType1: ptActorValue),\n (Index: 496; Name: 'GetKillingBlowLimb'),\n (Index: 500; Name: 'GetWeaponHealthPerc'),\n (Index: 503; Name: 'GetRadiationLevel'),\n (Index: 510; Name: 'GetLastHitCritical'),\n (Index: 515; Name: 'IsCombatTarget'; ParamType1: ptActor),\n (Index: 518; Name: 'GetVATSRightAreaFree'; ParamType1: ptObjectReference),\n (Index: 519; Name: 'GetVATSLeftAreaFree'; ParamType1: ptObjectReference),\n (Index: 520; Name: 'GetVATSBackAreaFree'; ParamType1: ptObjectReference),\n (Index: 521; Name: 'GetVATSFrontAreaFree'; ParamType1: ptObjectReference),\n (Index: 522; Name: 'GetIsLockBroken'),\n (Index: 523; Name: 'IsPS3'),\n (Index: 524; Name: 'IsWin32'),\n (Index: 525; Name: 'GetVATSRightTargetVisible'; ParamType1: ptObjectReference),\n (Index: 526; Name: 'GetVATSLeftTargetVisible'; ParamType1: ptObjectReference),\n (Index: 527; Name: 'GetVATSBackTargetVisible'; ParamType1: ptObjectReference),\n (Index: 528; Name: 'GetVATSFrontTargetVisible'; ParamType1: ptObjectReference),\n (Index: 531; Name: 'IsInCriticalStage'; ParamType1: ptCriticalStage),\n (Index: 533; Name: 'GetXPForNextLevel'),\n (Index: 546; Name: 'GetQuestCompleted'; ParamType1: ptQuest),\n (Index: 550; Name: 'IsGoreDisabled'),\n (Index: 555; Name: 'GetSpellUsageNum'; ParamType1: ptMagicItem),\n (Index: 557; Name: 'GetActorsInHigh'),\n (Index: 558; Name: 'HasLoaded3D'),\n\n // Added by FOSE:\n (Index: 1024; Name: 'GetFOSEVersion'; ),\n (Index: 1025; Name: 'GetFOSERevision'; ),\n (Index: 1028; Name: 'GetWeight'; ParamType1: ptInventoryObject; ),\n (Index: 1082; Name: 'IsKeyPressed'; ParamType1: ptInteger;),\n (Index: 1165; Name: 'GetWeaponHasScope'; ParamType1: ptInventoryObject; ),\n (Index: 1166; Name: 'IsControlPressed'; ParamType1: ptInteger; ),\n (Index: 1213; Name: 'GetFOSEBeta'; )\n );\nvar\n wbCTDAFunctionEditInfo: string;\n\nfunction wbCTDAParamDescFromIndex(aIndex: Integer): PCTDAFunction;\nvar\n L, H, I, C: Integer;\nbegin\n Result := nil;\n\n L := Low(wbCTDAFunctions);\n H := High(wbCTDAFunctions);\n while L <= H do begin\n I := (L + H) shr 1;\n C := CmpW32(wbCTDAFunctions[I].Index, aIndex);\n if C < 0 then\n L := I + 1\n else begin\n H := I - 1;\n if C = 0 then begin\n L := I;\n Result := @wbCTDAFunctions[L];\n end;\n end;\n end;\nend;\n\nfunction wbCTDACompValueDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Integer(Container.ElementByName['Type'].NativeValue) and $04 <> 0 then\n Result := 1;\nend;\n\nfunction wbCTDAParam1Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n if Assigned(Desc) then\n Result := Succ(Integer(Desc.ParamType1));\nend;\n\nfunction wbCTDAParam2VATSValueParam(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Result := Container.ElementByName['Parameter #1'].NativeValue;\nend;\n\nfunction wbCTDAParam2Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n if Assigned(Desc) then\n Result := Succ(Integer(Desc.ParamType2));\nend;\n\nfunction wbCTDAFunctionToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Desc : PCTDAFunction;\n i : Integer;\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := Desc.Name\n else if aType = ctToEditValue then\n Result := IntToStr(aInt)\n else\n Result := '';\n end;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctCheck: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := ''\n else\n Result := '';\n end;\n ctEditType:\n Result := 'ComboBox';\n ctEditInfo: begin\n Result := wbCTDAFunctionEditInfo;\n if Result = '' then begin\n with TStringList.Create do try\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n Add(wbCTDAFunctions[i].Name);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n wbCTDAFunctionEditInfo := Result;\n end;\n end;\n end;\nend;\n\nfunction wbCTDAFunctionToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i: Integer;\nbegin\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n with wbCTDAFunctions[i] do\n if SameText(Name, aString) then begin\n Result := Index;\n Exit;\n end;\n Result := StrToInt64(aString);\nend;\n\ntype\n TPERKEntryPointConditionType = (\n epcDefault,\n epcItem,\n epcWeapon,\n epcWeaponTarget,\n epcTarget,\n epcAttacker,\n epcAttackerAttackee,\n epcAttackerAttackerWeapon\n );\n\n TPERKEntryPointFunctionType = (\n epfFloat,\n epfLeveledItem,\n epfScript,\n epfUnknown\n );\n\n TPERKEntryPointFunctionParamType = (\n epfpNone,\n epfpFloat,\n epfpFloatFloat,\n epfpLeveledItem,\n epfpScript\n );\n\n PPERKEntryPoint = ^TPERKEntryPoint;\n TPERKEntryPoint = record\n Name : string;\n Condition : TPERKEntryPointConditionType;\n FunctionType : TPERKEntryPointFunctionType;\n end;\n\n PPERKCondition = ^TPERKCondition;\n TPERKCondition = record\n Count : Integer;\n Caption1 : string;\n Caption2 : string;\n Caption3 : string;\n end;\n\n PPERKFunction = ^TPERKFunction;\n TPERKFunction = record\n Name : string;\n FunctionType : TPERKEntryPointFunctionType;\n ParamType : TPERKEntryPointFunctionParamType;\n end;\n\nconst\n wbPERKCondition : array[TPERKEntryPointConditionType] of TPERKCondition = (\n (Count: 1; Caption1: 'Perk Owner'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Item'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Weapon'),\n (Count: 3; Caption1: 'Perk Owner'; Caption2: 'Weapon'; Caption3: 'Target'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Target'),\n (Count: 2; Caption1: 'Perk Owner'; Caption2: 'Attacker'),\n (Count: 3; Caption1: 'Perk Owner'; Caption2: 'Attacker'; Caption3: 'Attackee'),\n (Count: 3; Caption1: 'Perk Owner'; Caption2: 'Attacker'; Caption3: 'Attacker Weapon')\n );\n\n wbPERKFunctions : array[0..9] of TPERKFunction = (\n (Name: ''; FunctionType: epfUnknown; ParamType: epfpNone),\n (Name: 'Set Value'; FunctionType: epfFloat; ParamType: epfpFloat),\n (Name: 'Add Value'; FunctionType: epfFloat; ParamType: epfpFloat),\n (Name: 'Multiply Value'; FunctionType: epfFloat; ParamType: epfpFloat),\n (Name: 'Add Range To Value'; FunctionType: epfFloat; ParamType: epfpFloatFloat),\n (Name: 'Add Actor Value Mult'; FunctionType: epfFloat; ParamType: epfpFloatFloat),\n (Name: ''; FunctionType: epfUnknown; ParamType: epfpNone),\n (Name: ''; FunctionType: epfUnknown; ParamType: epfpNone),\n (Name: 'Add Leveled List'; FunctionType: epfLeveledItem; ParamType: epfpLeveledItem),\n (Name: 'Add Activate Choice'; FunctionType: epfScript; ParamType: epfpScript)\n );\n\n wbPERKEntryPoints : array[0..36] of TPERKEntryPoint = (\n (Name: 'Calculate Weapon Damage'; Condition: epcWeaponTarget),\n (Name: 'Calculate My Critical Hit Chance'; Condition: epcWeaponTarget),\n (Name: 'Calculate My Critical Hit Damage'; Condition: epcWeaponTarget),\n (Name: 'Calculate Weapon Attack AP Cost'; Condition: epcWeapon),\n (Name: 'Calculate Mine Explode Chance'; Condition: epcItem),\n (Name: 'Adjust Range Penalty'; Condition: epcWeapon),\n (Name: 'Adjust Limb Damage'; Condition: epcAttackerAttackerWeapon),\n (Name: 'Calculate Weapon Range'; Condition: epcWeapon),\n (Name: 'Calculate To Hit Chance'; Condition: epcWeaponTarget),\n (Name: 'Adjust Experience Points'),\n (Name: 'Adjust Gained Skill Points'),\n (Name: 'Adjust Book Skill Points'),\n (Name: 'Modify Recovered Health'),\n (Name: 'Calculate Inventory AP Cost'),\n (Name: 'Get Disposition'; Condition: epcTarget),\n (Name: 'Get Should Attack'; Condition: epcAttacker),\n (Name: 'Get Should Assist'; Condition: epcAttackerAttackee),\n (Name: 'Calculate Buy Price'; Condition: epcItem),\n (Name: 'Get Bad Karma'),\n (Name: 'Get Good Karma'),\n (Name: 'Ignore Locked Terminal'),\n (Name: 'Add Leveled List On Death'; Condition: epcTarget; FunctionType: epfLeveledItem),\n (Name: 'Get Max Carry Weight'),\n (Name: 'Modify Addiction Chance'),\n (Name: 'Modify Addiction Duration'),\n (Name: 'Modify Positive Chem Duration'),\n (Name: 'Adjust Drinking Radiation'),\n (Name: 'Activate'; Condition: epcTarget; FunctionType: epfScript),\n (Name: 'Mysterious Stranger'),\n (Name: 'Has Paralyzing Palm'),\n (Name: 'Hacking Science Bonus'),\n (Name: 'Ignore Running During Detection'),\n (Name: 'Ignore Broken Lock'),\n (Name: 'Has Concentrated Fire'),\n (Name: 'Calculate Gun Spread'; Condition: epcWeapon),\n (Name: 'Player Kill AP Reward'; Condition: epcWeaponTarget),\n (Name: 'Modify Enemy Critical Hit Chance'; Condition: epcWeaponTarget)\n );\n\n wbPERKFunctionParams: array[TPERKEntryPointFunctionParamType] of string = (\n 'None',\n 'Float',\n 'Float, Float',\n 'Leveled Item',\n 'Script'\n );\n\nprocedure wbPERKEntryPointAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldEntryPoint : PPERKEntryPoint;\n NewEntryPoint : PPERKEntryPoint;\n OldCondition : PPERKCondition;\n NewCondition : PPERKCondition;\n OldFunction : PPERKFunction;\n EntryPoint : IwbContainerElementRef;\n Effect : IwbContainerElementRef;\n PerkConditions : IwbContainerElementRef;\n PerkCondition : IwbContainerElementRef;\n Container : IwbContainerElementRef;\n i : Integer;\nbegin\n if aOldValue <> aNewValue then begin\n OldEntryPoint := @wbPERKEntryPoints[Integer(aOldValue)];\n NewEntryPoint := @wbPERKEntryPoints[Integer(aNewValue)];\n OldCondition := @wbPERKCondition[OldEntryPoint.Condition];\n NewCondition := @wbPERKCondition[NewEntryPoint.Condition];\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, EntryPoint) then\n Exit;\n i := EntryPoint.ElementNativeValues['Function'];\n if (i >= Low(wbPERKFunctions)) and (i <= High(wbPERKFunctions)) then\n OldFunction := @wbPERKFunctions[i]\n else\n OldFunction := nil;\n if not Assigned(OldFunction) or (OldFunction.FunctionType <> NewEntryPoint.FunctionType) then\n for i := Low(wbPERKFunctions) to High(wbPERKFunctions) do\n with wbPERKFunctions[i] do\n if FunctionType = NewEntryPoint.FunctionType then begin\n EntryPoint.ElementNativeValues['Function'] := i;\n Break;\n end;\n EntryPoint.ElementNativeValues['Perk Condition Tab Count'] := NewCondition.Count;\n\n if not Supports(EntryPoint.Container, IwbContainerElementRef, Container) then\n Exit;\n if not Supports(Container.Container, IwbContainerElementRef, Effect) then\n Exit;\n\n if not Supports(Effect.ElementByName['Perk Conditions'], IwbContainerElementRef, PerkConditions) then\n Exit;\n\n for i := Pred(PerkConditions.ElementCount) downto 0 do\n if Supports(PerkConditions.Elements[i], IwbContainerElementRef, PerkCondition) then\n if Integer(PerkCondition.ElementNativeValues['PRKC']) >= NewCondition.Count then\n PerkCondition.Remove\n else\n case Integer(PerkCondition.ElementNativeValues['PRKC']) of\n 2: if OldCondition.Caption2 <> NewCondition.Caption2 then\n PerkCondition.Remove;\n 3: if OldCondition.Caption3 <> NewCondition.Caption3 then\n PerkCondition.Remove;\n end;\n end;\nend;\n\nfunction wbPRKCToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n EntryPointVar := Container.ElementNativeValues['..\\..\\..\\DATA\\Entry Point\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n Exit;\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n with wbPERKEntryPoints[EntryPoint] do begin\n with wbPERKCondition[Condition] do begin\n case aType of\n ctEditType: Result := 'ComboBox';\n ctEditInfo: with TStringList.Create do try\n if Caption1 <> '' then\n Add(Caption1);\n if Caption2 <> '' then\n Add(Caption2);\n if Caption3 <> '' then\n Add(Caption3);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n else\n if (aInt < 0) or (aInt >= Count) then\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end\n else\n case aType of\n ctToStr, ctToEditValue: case Integer(aInt) of\n 0: Result := Caption1;\n 1: Result := Caption2;\n 2: Result := Caption3;\n end;\n ctCheck: Result := '';\n end;\n end;\n end;\n end;\nend;\n\nfunction wbPRKCToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\n s : string;\nbegin\n s := Trim(aString);\n\n Result := StrToInt64Def(s, Low(Integer));\n if Result <> Low(Integer) then\n Exit;\n if s = '' then begin\n Result := 0;\n Exit;\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n raise Exception.Create('Could not resolve Entry Point');\n EntryPointVar := Container.ElementNativeValues['..\\..\\..\\DATA\\Entry Point\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n raise Exception.Create('Could not resolve Entry Point');\n\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then\n raise Exception.Create('Unknown Entry Point #'+IntToStr(EntryPoint));\n\n with wbPERKEntryPoints[EntryPoint] do\n with wbPERKCondition[Condition] do\n if SameText(aString, Caption1) then\n Result := 0\n else if SameText(aString, Caption2) then\n Result := 1\n else if SameText(aString, Caption3) then\n Result := 2\n else\n raise Exception.Create('\"'+s+'\" is not valid for this Entry Point');\nend;\n\nfunction wbNeverShow(const aElement: IwbElement): Boolean;\nbegin\n Result := wbHideNeverShow;\nend;\n\nfunction GetREGNType(aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := -1;\n if not Assigned(aElement) then\n Exit;\n while aElement.Name <> 'Region Data Entry' do begin\n aElement := aElement.Container;\n if not Assigned(aElement) then\n Exit;\n end;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n Result := Container.ElementNativeValues['RDAT\\Type'];\nend;\n\nfunction wbREGNObjectsDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 2;\nend;\n\nfunction wbREGNWeatherDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 3;\nend;\n\nfunction wbREGNMapDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 4;\nend;\n\nfunction wbREGNLandDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 5;\nend;\n\nfunction wbREGNGrassDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 6;\nend;\n\nfunction wbREGNSoundDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 7;\nend;\n\nfunction wbMESGTNAMDontShow(const aElement: IwbElement): Boolean;\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n Result := False;\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if Integer(Container.ElementNativeValues['DNAM']) and 1 <> 0 then\n Result := True;\nend;\n\nfunction wbEPFDDontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Entry Point Function Parameters' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if not (Integer(Container.ElementNativeValues['EPFT']) in [1..3]) then\n Result := True;\nend;\n\nfunction wbTES4ONAMDontShow(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n Result := False;\n if not Assigned(aElement) then\n Exit;\n MainRecord := aElement.ContainingMainRecord;\n if not Assigned(MainRecord) then\n Exit;\n if not MainRecord.IsESM then\n Result := True;\nend;\n\n\nfunction wbEPF2DontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Entry Point Function Parameters' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if not (Integer(Container.ElementNativeValues['EPFT']) in [4]) then\n Result := True;\nend;\n\nfunction wbPERKPRKCDontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Effect' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if Integer(Container.ElementNativeValues['PRKE\\Type']) <> 2 then\n Result := True;\nend;\n\nfunction wbPerkDATAFunctionToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\n i : Integer;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n EntryPointVar := Container.ElementNativeValues['..\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n Exit;\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n with wbPERKEntryPoints[EntryPoint] do begin\n case aType of\n ctEditType: Result := 'ComboBox';\n ctEditInfo: with TStringList.Create do try\n for i := Low(wbPERKFunctions) to High(wbPERKFunctions) do\n if wbPERKFunctions[i].FunctionType = FunctionType then\n if (wbPERKFunctions[i].Name <> '') then\n Add(wbPERKFunctions[i].Name);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n else\n if (aInt < Low(wbPERKFunctions)) or (aInt > High(wbPERKFunctions)) then\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end\n else\n case aType of\n ctToStr, ctToEditValue: begin\n Result := wbPERKFunctions[Integer(aInt)].Name;\n if (aType = ctToStr) and (wbPERKFunctions[Integer(aInt)].FunctionType <> FunctionType) then\n Result := Result + ' ';\n end;\n ctCheck:\n if wbPERKFunctions[Integer(aInt)].FunctionType <> FunctionType then\n Result := ''\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPerkDATAFunctionToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n EntryPointVar : Variant;\n EntryPoint : Integer;\n s : string;\n i : Integer;\nbegin\n s := Trim(aString);\n\n Result := StrToInt64Def(s, Low(Integer));\n if Result <> Low(Integer) then\n Exit;\n if s = '' then\n raise Exception.Create('\"\" is not a valid value for this field');\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n raise Exception.Create('Could not resolve Entry Point');\n EntryPointVar := Container.ElementNativeValues['..\\Entry Point'];\n if VarIsNull(EntryPointVar) or VarIsClear(EntryPointVar) then\n raise Exception.Create('Could not resolve Entry Point');\n\n EntryPoint := EntryPointVar;\n if (EntryPoint < Low(wbPERKEntryPoints)) or (EntryPoint > High(wbPERKEntryPoints)) then\n raise Exception.Create('Unknown Entry Point #'+IntToStr(EntryPoint));\n\n with wbPERKEntryPoints[EntryPoint] do\n for i := Low(wbPERKFunctions) to High(wbPERKFunctions) do\n if wbPERKFunctions[i].FunctionType = FunctionType then\n if SameText(s, wbPERKFunctions[i].Name) then begin\n Result := i;\n Exit;\n end;\n\n raise Exception.Create('\"'+s+'\" is not valid for this Entry Point');\nend;\n\nprocedure wbPerkDATAFunctionAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n NewFunction : Integer;\n Container : IwbContainerElementRef;\n OldParamType: Integer;\n NewParamType: Integer;\nbegin\n NewFunction := aNewValue;\n if (NewFunction < Low(wbPERKFunctions)) or (NewFunction > High(wbPERKFunctions)) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n OldParamType := Container.ElementNativeValues['..\\..\\..\\Entry Point Function Parameters\\EPFT'];\n NewParamType := Ord(wbPERKFunctions[NewFunction].ParamType);\n if (OldParamType = NewParamType) and not VarSameValue(aOldValue, aNewValue) and (NewFunction in [4,5]) then\n Container.ElementNativeValues['..\\..\\..\\Entry Point Function Parameters\\EPFT'] := 0;\n Container.ElementNativeValues['..\\..\\..\\Entry Point Function Parameters\\EPFT'] := NewParamType;\nend;\n\nfunction wbPerkEPFTToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n FunctionTypeVar : Variant;\n FunctionType : Integer;\n// i : Integer;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n FunctionTypeVar := Container.ElementNativeValues['..\\..\\DATA\\Entry Point\\Function'];\n if VarIsNull(FunctionTypeVar) or VarIsClear(FunctionTypeVar) then\n Exit;\n FunctionType := FunctionTypeVar;\n if (FunctionType < Low(wbPERKFunctions)) or (FunctionType > High(wbPERKFunctions)) then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n with wbPERKFunctions[FunctionType] do begin\n case aType of\n ctEditType: Result := 'ComboBox';\n ctEditInfo: Result := '\"' + wbPERKFunctionParams[ParamType] + '\"';\n else\n if (aInt < Ord(Low(wbPERKFunctionParams))) or (aInt > Ord(High(wbPERKFunctionParams))) then\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end\n else\n case aType of\n ctToStr, ctToEditValue: begin\n Result := wbPERKFunctionParams[TPERKEntryPointFunctionParamType(aInt)];\n if (aType = ctToStr) and (TPERKEntryPointFunctionParamType(aInt) <> ParamType) then\n Result := Result + ' ';\n end;\n ctCheck:\n if TPERKEntryPointFunctionParamType(aInt) <> ParamType then\n Result := Result + ' '\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPerkEPFTToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n Container : IwbContainerElementRef;\n FunctionTypeVar : Variant;\n FunctionType : Integer;\n s : string;\n// i : Integer;\n j : TPERKEntryPointFunctionParamType;\nbegin\n s := Trim(aString);\n\n Result := StrToInt64Def(s, Low(Integer));\n if Result <> Low(Integer) then\n Exit;\n if s = '' then\n raise Exception.Create('\"\" is not a valid value for this field');\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n raise Exception.Create('Could not resolve Function');\n FunctionTypeVar := Container.ElementNativeValues['..\\..\\DATA\\Entry Point\\Function'];\n if VarIsNull(FunctionTypeVar) or VarIsClear(FunctionTypeVar) then\n raise Exception.Create('Could not resolve Function');\n\n FunctionType := FunctionTypeVar;\n if (FunctionType < Low(wbPERKFunctions)) or (FunctionType > High(wbPERKFunctions)) then\n raise Exception.Create('Unknown Function #'+IntToStr(FunctionType));\n\n with wbPERKFunctions[FunctionType] do begin\n for j := Low(wbPERKFunctionParams) to High(wbPERKFunctionParams) do\n if SameText(s, wbPERKFunctionParams[j]) then begin\n if j <> ParamType then\n raise Exception.Create('\"'+s+'\" is not a valid Parameter Type for Function \"'+Name+'\"');\n Result := Ord(j);\n Exit;\n end;\n end;\n\n raise Exception.Create('\"'+s+'\" is not a valid Parameter Type');\nend;\n\nprocedure wbPerkEPFTAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n i: Integer;\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n i := aNewValue;\n if (i < Ord(Low(wbPERKFunctionParams))) or (i> Ord(High(wbPERKFunctionParams))) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n Container.RemoveElement('EPFD');\n Container.RemoveElement('EPF2');\n Container.RemoveElement('EPF3');\n Container.RemoveElement('Embedded Script');\n case TPERKEntryPointFunctionParamType(i) of\n epfpFloat, epfpFloatFloat, epfpLeveledItem:\n Container.Add('EPFD', True);\n epfpScript: begin\n Container.Add('EPF2', True);\n Container.Add('EPF3', True);\n Container.Add('SCHR', True);\n end;\n end;\nend;\n\nprocedure wbRemoveOFST(const aElement: IwbElement);\nvar\n Container: IwbContainer;\n rOFST: IwbRecord;\nbegin\n if not wbRemoveOffsetData then\n Exit;\n\n if Supports(aElement, IwbContainer, Container) then begin\n if wbBeginInternalEdit then try\n Container.RemoveElement(OFST);\n finally\n wbEndInternalEdit;\n end else begin\n rOFST := Container.RecordBySignature[OFST];\n if Assigned(rOFST) then\n Container.RemoveElement(rOFST);\n end;\n end;\nend;\n\nfunction wbActorTemplateUseTraits(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000001) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseStats(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000002) <> 0;\n end;\nend;\n\nfunction wbActorAutoCalcDontShow(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Flags'];\n Result := (i and $00000010) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseStatsAutoCalc(const aElement: IwbElement): Boolean;\nbegin\n if not wbActorTemplateHide then\n Result := False\n else\n Result := wbActorTemplateUseStats(aElement) or wbActorAutoCalcDontShow(aElement);\nend;\n\nfunction wbActorTemplateUseFactions(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000004) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseActorEffectList(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000008) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseAIData(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000010) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseAIPackages(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000020) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseModelAnimation(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000040) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseBaseData(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000080) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseInventory(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000100) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseScript(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n if not wbActorTemplateHide then Exit;\n Element := GetElementFromUnion(aElement);\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000200) <> 0;\n end;\nend;\n\nprocedure wbCTDAAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n //Size : Cardinal;\n TypeFlags : Cardinal;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n TypeFlags := Container.ElementNativeValues['Type'];\n if (TypeFlags and $02) <> 0 then begin\n if Container.DataSize = 20 then\n Container.DataSize := 28;\n Container.ElementNativeValues['Type'] := TypeFlags and not $02;\n Container.ElementEditValues['Run On'] := 'Target';\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMGEFAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n OldActorValue : Integer;\n NewActorValue : Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n OldActorValue := Container.ElementNativeValues['DATA - Data\\Actor Value'];\n NewActorValue := OldActorValue;\n case Integer(Container.ElementNativeValues['DATA - Data\\Archtype']) of\n 01, //Script\n 02, //Dispel\n 03, //Cure Disease\n 13, //Light\n 16, //Lock\n 17, //Open\n 18, //Bound Item\n 19, //Summon Creature\n 30, //Cure Paralysis\n 31, //Cure Addiction\n 32, //Cure Poison\n 33: //Concussion\n NewActorValue := -1;\n 11: //Invisibility\n NewActorValue := 48; //Invisibility\n 12: //Chameleon\n NewActorValue := 49; //Chameleon\n 24: //Paralysis\n NewActorValue := 47; //Paralysis\n end;\n if OldActorValue <> NewActorValue then\n Container.ElementNativeValues['DATA - Data\\Actor Value'] := NewActorValue;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbPACKAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n NewContainer : IwbContainerElementRef;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n case Integer(Container.ElementNativeValues['PKDT - General\\Type']) of\n 0: begin {Find}\n Container.Add('PTDT');\n end;\n 1: begin {Follow}\n Container.Add('PKFD');\n end;\n 2: begin {Escort}\n end;\n 3: begin {Eat}\n Container.Add('PTDT');\n Container.Add('PKED');\n end;\n 4: begin {Sleep}\n if not Container.ElementExists['Locations'] then\n if Supports(Container.Add('Locations'), IwbContainerElementRef, NewContainer) then\n NewContainer.ElementEditValues['PLDT - Location 1\\Type'] := 'Near editor location';\n end;\n 5: begin {Wander}\n end;\n 6: begin {Travel}\n end;\n 7: begin {Accompany}\n end;\n 8: begin {Use Item At}\n end;\n 9: begin {Ambush}\n end;\n 10: begin {Flee Not Combat}\n end;\n 12: begin {Sandbox}\n end;\n 13: begin {Patrol}\n if not Container.ElementExists['Locations'] then\n if Supports(Container.Add('Locations'), IwbContainerElementRef, NewContainer) then\n NewContainer.ElementEditValues['PLDT - Location 1\\Type'] := 'Near linked reference';\n Container.Add('PKPT');\n end;\n 14: begin {Guard}\n end;\n 15: begin {Dialogue}\n end;\n 16: begin {Use Weapon}\n end;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbNPCAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// BaseRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementNativeValues['NAM5'] > 255 then\n Container.ElementNativeValues['NAM5'] := 255;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbREFRAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n Container.RemoveElement('RCLR');\n\n if Container.ElementExists['Ammo'] then begin\n BaseRecord := MainRecord.BaseRecord;\n if Assigned(BaseRecord) and (BaseRecord.Signature <> 'WEAP') then\n Container.RemoveElement('Ammo');\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbINFOAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if (Integer(Container.ElementNativeValues['DATA\\Flags 1']) and $80) = 0 then\n Container.RemoveElement('DNAM');\n\n Container.RemoveElement('SNDD');\n\n if Container.ElementNativeValues['DATA\\Type'] = 3 {Persuasion} then\n Container.ElementNativeValues['DATA\\Type'] := 0 {Topic};\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbCELLAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n// Container2 : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// i : Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if (not Container.ElementExists['XCLW']) and ((Integer(Container.ElementNativeValues['DATA']) and $02) <> 0) then begin\n Container.Add('XCLW', True);\n Container.ElementEditValues['XCLW'] := 'Default';\n end;\n\n if (not Container.ElementExists['XNAM']) and ((Integer(Container.ElementNativeValues['DATA']) and $02) <> 0) then\n Container.Add('XNAM', True);\n\n// if Supports(Container.ElementBySignature[XCLR], IwbContainerElementRef, Container2) then begin\n// for i:= Pred(Container2.ElementCount) downto 0 do\n// if not Supports(Container2.Elements[i].LinksTo, IwbMainRecord, MainRecord) or (MainRecord.Signature <> 'REGN') then\n// Container2.RemoveElement(i);\n// if Container2.ElementCount < 1 then\n// Container2.Remove;\n// end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbEmbeddedScriptAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if Container.ElementEditValues['SCHR\\Type'] = 'Quest' then\n Container.ElementEditValues['SCHR\\Type'] := 'Object';\n finally\n wbEndInternalEdit;\n end;\nend;\n\n\nprocedure wbSOUNAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n OldCntr: IwbContainerElementRef;\n NewCntr: IwbContainerElementRef;\n NewCntr2: IwbContainerElementRef;\n i: Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementExists['SNDD'] then\n Exit;\n\n if not Supports(Container.RemoveElement('SNDX - Sound Data'), IwbContainerElementRef, OldCntr) then\n Exit;\n if not Supports(Container.Add('SNDD', True), IwbContainerElementRef, NewCntr) then\n Exit;\n for i := 0 to Pred(Min(OldCntr.ElementCount, NewCntr.ElementCount)) do\n NewCntr.Elements[i].Assign(Low(Integer), OldCntr.Elements[i], False);\n\n if not Supports(NewCntr.ElementByName['Attenuation Curve'], IwbContainerElementRef, NewCntr2) then\n Assert(False);\n Assert(NewCntr2.ElementCount = 5);\n\n if Supports(Container.RemoveElement('ANAM'), IwbContainerElementRef, OldCntr) then begin\n Assert(OldCntr.ElementCount = 5);\n for i := 0 to Pred(Min(OldCntr.ElementCount, NewCntr2.ElementCount)) do\n NewCntr2.Elements[i].Assign(Low(Integer), OldCntr.Elements[i], False);\n end else begin\n NewCntr2.Elements[0].NativeValue := 100;\n NewCntr2.Elements[1].NativeValue := 50;\n NewCntr2.Elements[2].NativeValue := 20;\n NewCntr2.Elements[3].NativeValue := 5;\n NewCntr2.Elements[4].NativeValue := 0;\n end;\n\n if not Supports(NewCntr.ElementByName['Reverb Attenuation Control'], IwbContainerElementRef, NewCntr2) then\n Assert(False);\n\n if Supports(Container.RemoveElement('GNAM'), IwbContainerElementRef, OldCntr) then\n NewCntr2.Assign(Low(Integer), OldCntr, False)\n else\n NewCntr2.NativeValue := 80;\n\n if not Supports(NewCntr.ElementByName['Priority'], IwbContainerElementRef, NewCntr2) then\n Assert(False);\n\n if Supports(Container.RemoveElement('HNAM'), IwbContainerElementRef, OldCntr) then\n NewCntr2.Assign(Low(Integer), OldCntr, False)\n else\n NewCntr2.NativeValue := 128;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbWATRAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n// AnimationMultiplier : Extended;\n// AnimationAttackMultiplier : Extended;\n OldCntr: IwbContainerElementRef;\n NewCntr: IwbContainerElementRef;\n i: Integer;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementExists['DNAM'] then\n Exit;\n\n if not Supports(Container.RemoveElement('DATA - Visual Data'), IwbContainerElementRef, OldCntr) then\n Exit;\n if not Supports(Container.Add('DNAM', True), IwbContainerElementRef, NewCntr) then\n Exit;\n for i := 0 to Pred(Min(OldCntr.ElementCount, NewCntr.ElementCount)) do\n if OldCntr.Elements[i].Name = 'Damage (Old Format)' then\n Container.ElementNativeValues['DATA - Damage'] := OldCntr.Elements[i].NativeValue\n else\n NewCntr.Elements[i].Assign(Low(Integer), OldCntr.Elements[i], False);\n\n NewCntr.ElementNativeValues['Noise Properties - Noise Layer One - Amplitude Scale'] := 1.0;\n NewCntr.ElementNativeValues['Noise Properties - Noise Layer Two - Amplitude Scale'] := 0.5;\n NewCntr.ElementNativeValues['Noise Properties - Noise Layer Three - Amplitude Scale'] := 0.25;\n finally\n wbEndInternalEdit;\n end;\nend;\n\n\nprocedure wbWEAPAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['DNAM'] then\n Exit;\n\n if Container.ElementNativeValues['DNAM\\Animation Multiplier'] = 0.0 then\n Container.ElementNativeValues['DNAM\\Animation Multiplier'] := 1.0;\n if Container.ElementNativeValues['DNAM\\Animation Attack Multiplier'] = 0.0 then\n Container.ElementNativeValues['DNAM\\Animation Attack Multiplier'] := 1.0;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMESGAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n IsMessageBox : Boolean;\n HasTimeDelay : Boolean;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n IsMessageBox := (Integer(Container.ElementNativeValues['DNAM']) and 1) = 1;\n HasTimeDelay := Container.ElementExists['TNAM'];\n\n if IsMessageBox = HasTimeDelay then\n if IsMessageBox then\n Container.RemoveElement('TNAM')\n else begin\n if not Container.ElementExists['DNAM'] then\n Container.Add('DNAM', True);\n Container.ElementNativeValues['DNAM'] := Integer(Container.ElementNativeValues['DNAM']) or 1;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\n\nprocedure wbEFSHAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n FullParticleBirthRatio : Extended;\n PersistantParticleBirthRatio : Extended;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['DATA'] then\n Exit;\n\n FullParticleBirthRatio := Container.ElementNativeValues['DATA\\Particle Shader - Full Particle Birth Ratio'];\n PersistantParticleBirthRatio := Container.ElementNativeValues['DATA\\Particle Shader - Persistant Particle Birth Ratio'];\n\n if ((FullParticleBirthRatio <> 0) and (FullParticleBirthRatio <= 1)) then begin\n FullParticleBirthRatio := FullParticleBirthRatio * 78.0;\n Container.ElementNativeValues['DATA\\Particle Shader - Full Particle Birth Ratio'] := FullParticleBirthRatio;\n end;\n\n if ((PersistantParticleBirthRatio <> 0) and (PersistantParticleBirthRatio <= 1)) then begin\n PersistantParticleBirthRatio := PersistantParticleBirthRatio * 78.0;\n Container.ElementNativeValues['DATA\\Particle Shader - Persistant Particle Birth Ratio'] := PersistantParticleBirthRatio;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbFACTAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Container.ElementExists['CNAM'] then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n Container.RemoveElement('CNAM');\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbLIGHAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['FNAM'] then begin\n Container.Add('FNAM', True);\n Container.ElementNativeValues['FNAM'] := 1.0;\n end;\n\n if Container.ElementExists['DATA'] then begin\n if SameValue(Container.ElementNativeValues['DATA\\Falloff Exponent'], 0.0) then\n Container.ElementNativeValues['DATA\\Falloff Exponent'] := 1.0;\n if SameValue(Container.ElementNativeValues['DATA\\FOV'], 0.0) then\n Container.ElementNativeValues['DATA\\FOV'] := 90.0;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbEFITAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n Element : IwbElement;\n ActorValue: Variant;\n MainRecord: IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n MainRecord := Container.ContainingMainRecord;\n if not Assigned(MainRecord) or MainRecord.IsDeleted then\n Exit;\n\n Element := Container.ElementByPath['..\\EFID'];\n if not Assigned(Element) then\n Exit;\n if not Supports(Element.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n if MainRecord.Signature <> 'MGEF' then\n Exit;\n ActorValue := MainRecord.ElementNativeValues['DATA - Data\\Actor Value'];\n if VarIsNull(ActorValue) or VarIsClear(ActorValue) then\n Exit;\n if VarCompareValue(ActorValue, Container.ElementNativeValues['Actor Value']) <> vrEqual then\n Container.ElementNativeValues['Actor Value'] := ActorValue;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbRPLDAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainer;\n a, b: Single;\n NeedsFlip: Boolean;\nbegin\n if wbBeginInternalEdit then try\n if Supports(aElement, IwbContainer, Container) then begin\n NeedsFlip := False;\n if Container.ElementCount > 1 then begin\n a := StrToFloat((Container.Elements[0] as IwbContainer).Elements[0].Value);\n b := StrToFloat((Container.Elements[Pred(Container.ElementCount)] as IwbContainer).Elements[0].Value);\n case CompareValue(a, b) of\n EqualsValue: begin\n a := StrToFloat((Container.Elements[0] as IwbContainer).Elements[1].Value);\n b := StrToFloat((Container.Elements[Pred(Container.ElementCount)] as IwbContainer).Elements[1].Value);\n NeedsFlip := CompareValue(a, b) = GreaterThanValue;\n end;\n GreaterThanValue:\n NeedsFlip := True;\n end;\n end;\n if NeedsFlip then\n Container.ReverseElements;\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbPxDTLocationDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Result := Container.ElementByName['Type'].NativeValue;\nend;\n\nfunction wbPKDTFalloutBehaviorFlagsDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Supports(Container, IwbSubRecord, SubRecord) then\n if SubRecord.SubRecordHeaderSize = 8 then\n Result := 1;\nend;\n\nfunction wbPKDTSpecificFlagsDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Supports(Container, IwbSubRecord, SubRecord) then\n if SubRecord.SubRecordHeaderSize = 8 then\n Exit;\n Result := Container.ElementByName['Type'].NativeValue + 1;\nend;\n\nprocedure wbIDLAsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Container : IwbContainer;\n SelfAsContainer : IwbContainer;\nbegin\n if wbBeginInternalEdit then try\n// if not wbCounterAfterSet('IDLC - Animation Count', aElement) then\n if Supports(aElement.Container, IwbContainer, Container) then begin\n Element := Container.ElementByPath['IDLC\\Animation Count'];\n if Assigned(Element) and Supports(aElement, IwbContainer, SelfAsContainer) and\n (Element.GetNativeValue<>SelfAsContainer.GetElementCount) then\n Element.SetNativeValue(SelfAsContainer.GetElementCount);\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbAnimationsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Elems : IwbElement;\n Container : IwbContainer;\nbegin\n if wbBeginInternalEdit then try\n// if not wbCounterContainerAfterSet('IDLC - Animation Count', 'IDLA - Animations', aElement) then\n if Supports(aElement, IwbContainer, Container) then begin\n Element := Container.ElementByPath['IDLC\\Animation Count'];\n Elems := Container.ElementByName['IDLA - Animations'];\n if Assigned(Element) and not Assigned(Elems) then\n if Element.GetNativeValue<>0 then\n Element.SetNativeValue(0);\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbOffsetDataColsCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbDataContainer;\n Element : IwbElement;\n fResult : Extended;\nbegin\n Result := 0;\n\n if Supports(aElement.Container, IwbDataContainer, Container) and (Container.Name = 'OFST - Offset Data') and\n Supports(Container.Container, IwbDataContainer, Container) then begin\n Element := Container.ElementByPath['Object Bounds\\NAM0 - Min\\X'];\n if Assigned(Element) then begin\n fResult := Element.NativeValue;\n if fResult >= MaxInt then\n Result := 0\n else\n Result := Trunc(fResult);\n Element := Container.ElementByPath['Object Bounds\\NAM9 - Max\\X'];\n if Assigned(Element) then begin\n fResult := Element.NativeValue;\n if fResult >= MaxInt then\n Result := 1\n else\n Result := Trunc(fResult) - Result + 1;\n end;\n end;\n end;\nend;\n\nprocedure DefineFO3a;\nbegin\n wbRecordFlags := wbInteger('Record Flags', itU32, wbFlags([\n {0x00000001}'ESM',\n {0x00000002}'',\n {0x00000004}'', // Plugin selected (Editor)\n {0x00000008}'', // Form cannot be saved (Runtime)/Plugin active (Editor)\n {0x00000010}'Form initialized (Runtime only)', // Plugin cannot be active or selected (Editor)\n {0x00000020}'Deleted',\n {0x00000040}'Border Region / Has Tree LOD / Constant / Hidden From Local Map',\n {0x00000080}'Turn Off Fire',\n {0x00000100}'Inaccessible',\n {0x00000200}'Casts shadows / On Local Map / Motion Blur',\n {0x00000400}'Quest item / Persistent reference',\n {0x00000800}'Initially disabled',\n {0x00001000}'Ignored',\n {0x00002000}'No Voice Filter',\n {0x00004000}'Cannot Save (Runtime only)',\n {0x00008000}'Visible when distant',\n {0x00010000}'Random Anim Start / High Priority LOD',\n {0x00020000}'Dangerous / Off limits (Interior cell) / Radio Station (Talking Activator)',\n {0x00040000}'Compressed',\n {0x00080000}'Can''t wait / Platform Specific Texture / Dead',\n {0x00100000}'Unknown 21',\n {0x00200000}'Load Started', // set when beginning to load the form from save\n {0x00400000}'Unknown 23',\n {0x00800000}'Unknown 24',\n {0x01000000}'Destructible (Runtime only)',\n {0x02000000}'Obstacle / No AI Acquire',\n {0x03000000}'NavMesh Generation - Filter',\n {0x08000000}'NavMesh Generation - Bounding Box',\n {0x10000000}'Non-Pipboy / Reflected by Auto Water',\n {0x20000000}'Child Can Use / Refracted by Auto Water',\n {0x40000000}'NavMesh Generation - Ground',\n {0x80000000}'Multibound'\n ]));\n\n(* wbInteger('Record Flags 2', itU32, wbFlags([\n {0x00000001}'Unknown 1',\n {0x00000002}'Unknown 2',\n {0x00000004}'Unknown 3',\n {0x00000008}'Unknown 4',\n {0x00000010}'Unknown 5',\n {0x00000020}'Unknown 6',\n {0x00000040}'Unknown 7',\n {0x00000080}'Unknown 8',\n {0x00000100}'Unknown 9',\n {0x00000200}'Unknown 10',\n {0x00000400}'Unknown 11',\n {0x00000800}'Unknown 12',\n {0x00001000}'Unknown 13',\n {0x00002000}'Unknown 14',\n {0x00004000}'Unknown 15',\n {0x00008000}'Unknown 16',\n {0x00010000}'Unknown 17',\n {0x00020000}'Unknown 18',\n {0x00040000}'Unknown 19',\n {0x00080000}'Unknown 20',\n {0x00100000}'Unknown 21',\n {0x00200000}'Unknown 22',\n {0x00400000}'Unknown 23',\n {0x00800000}'Unknown 24',\n {0x01000000}'Unknown 25',\n {0x02000000}'Unknown 26',\n {0x03000000}'Unknown 27',\n {0x08000000}'Unknown 28',\n {0x10000000}'Unknown 29',\n {0x20000000}'Unknown 30',\n {0x40000000}'Unknown 31',\n {0x80000000}'Unknown 32'\n ])); (**)\n\n wbMainRecordHeader := wbStruct('Record Header', [\n wbString('Signature', 4, cpCritical),\n wbInteger('Data Size', itU32, nil, cpIgnore),\n wbRecordFlags,\n wbFormID('FormID', cpFormID),\n wbByteArray('Version Control Info 1', 4, cpIgnore),\n wbInteger('Form Version', itU16, nil, cpIgnore),\n wbByteArray('Version Control Info 2', 2, cpIgnore)\n ]);\n\n wbSizeOfMainRecordStruct := 24;\n\n wbIgnoreRecords.Add(XXXX);\n\n wbXRGD := wbByteArray(XRGD, 'Ragdoll Data');\n wbXRGB := wbByteArray(XRGB, 'Ragdoll Biped Data');\n\n wbMusicEnum := wbEnum(['Default', 'Public', 'Dungeon']);\n wbSoundLevelEnum := wbEnum([\n 'Loud',\n 'Normal',\n 'Silent'\n ]);\n\n wbWeaponAnimTypeEnum := wbEnum([\n {00} 'Hand to Hand',\n {01} 'Melee (1 Hand)',\n {02} 'Melee (2 Hand)',\n {03} 'Pistol - Balistic (1 Hand)',\n {04} 'Pistol - Energy (1 Hand)',\n {05} 'Rifle - Balistic (2 Hand)',\n {06} 'Rifle - Automatic (2 Hand)',\n {07} 'Rifle - Energy (2 Hand)',\n {08} 'Handle (2 Hand)',\n {09} 'Launcher (2 Hand)',\n {10} 'Grenade Throw (1 Hand)',\n {11} 'Land Mine (1 Hand)',\n {12} 'Mine Drop (1 Hand)'\n ]);\n\n wbReloadAnimEnum := wbEnum([\n 'ReloadA',\n 'ReloadB',\n 'ReloadC',\n 'ReloadD',\n 'ReloadE',\n 'ReloadF',\n 'ReloadG',\n 'ReloadH',\n 'ReloadI',\n 'ReloadJ',\n 'ReloadK'\n ],[255, 'None']);\n\n wbEDID := wbString(EDID, 'Editor ID', 0, cpNormal); // not cpBenign according to Arthmoor\n wbEDIDReq := wbString(EDID, 'Editor ID', 0, cpNormal, True); // not cpBenign according to Arthmoor\n wbFULL := wbString(FULL, 'Name', 0, cpTranslate);\n wbFULLActor := wbString(FULL, 'Name', 0, cpTranslate, False, wbActorTemplateUseBaseData);\n wbFULLReq := wbString(FULL, 'Name', 0, cpNormal, True);\n wbDESC := wbString(DESC, 'Description', 0, cpTranslate);\n wbDESCReq := wbString(DESC, 'Description', 0, cpTranslate, True);\n wbXSCL := wbFloat(XSCL, 'Scale');\n wbOBND := wbStruct(OBND, 'Object Bounds', [\n wbInteger('X1', itS16),\n wbInteger('Y1', itS16),\n wbInteger('Z1', itS16),\n wbInteger('X2', itS16),\n wbInteger('Y2', itS16),\n wbInteger('Z2', itS16)\n ]);\n wbOBNDReq := wbStruct(OBND, 'Object Bounds', [\n wbInteger('X1', itS16),\n wbInteger('Y1', itS16),\n wbInteger('Z1', itS16),\n wbInteger('X2', itS16),\n wbInteger('Y2', itS16),\n wbInteger('Z2', itS16)\n ], cpNormal, True);\n wbREPL := wbFormIDCkNoReach(REPL, 'Repair List', [FLST]);\n wbEITM := wbFormIDCk(EITM, 'Object Effect', [ENCH, SPEL]);\n wbBIPL := wbFormIDCk(BIPL, 'Biped Model List', [FLST]);\n wbCOED := wbStructExSK(COED, [2], [0, 1], 'Extra Data', [\n {00} wbFormIDCkNoReach('Owner', [NPC_, FACT, NULL]),\n {04} wbUnion('Global Variable / Required Rank', wbCOEDOwnerDecider, [\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCk('Global Variable', [GLOB, NULL]),\n wbInteger('Required Rank', itU32)\n ]),\n {08} wbFloat('Item Condition')\n ]);\n\n wbYNAM := wbFormIDCk(YNAM, 'Sound - Pick Up', [SOUN]);\n wbZNAM := wbFormIDCk(ZNAM, 'Sound - Drop', [SOUN]);\n\n wbPosRot :=\n wbStruct('Position/Rotation', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ]);\n\n wbDATAPosRot :=\n wbStruct(DATA, 'Position/Rotation', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ], cpNormal, True);\n\n wbMODS :=\n wbArrayS(MODS, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n wbMO2S :=\n wbArrayS(MO2S, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n wbMO3S :=\n wbArrayS(MO3S, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n wbMO4S :=\n wbArrayS(MO4S, 'Alternate Textures',\n wbStructSK([0, 2], 'Alternate Texture', [\n wbLenString('3D Name'),\n wbFormIDCk('New Texture', [TXST]),\n wbInteger('3D Index', itS32)\n ]),\n -1);\n\n wbMODD :=\n wbInteger(MODD, 'FaceGen Model Flags', itU8, wbFlags([\n 'Head',\n 'Torso',\n 'Right Hand',\n 'Left Hand'\n ]));\n wbMOSD :=\n wbInteger(MOSD, 'FaceGen Model Flags', itU8, wbFlags([\n 'Head',\n 'Torso',\n 'Right Hand',\n 'Left Hand'\n ]));\n\n wbMODL :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODB, 'Unknown', 4, cpIgnore),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n// wbArray(MODT, 'Texture Files Hashes',\n// wbByteArray('Unknown', 24, cpBenign),\n// wbArray('Hashes', wbInteger('Hash', itU64, wbMODTCallback), 3),\n// 0, nil, nil, cpBenign),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, nil, True);\n\n wbMODLActor :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODB, 'Unknown', 4, cpIgnore),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n// wbArray(MODT, 'Texture Files Hashes',\n// wbByteArray('Unknown', 24, cpBenign),\n// wbArray('Hashes', wbInteger('Hash', itU64, wbMODTCallback), 3),\n// 0, nil, nil, cpBenign),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, wbActorTemplateUseModelAnimation, True);\n\n wbMODLReq :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODB, 'Unknown', 4, cpIgnore),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n// wbArray(MODT, 'Texture Files',\n// wbByteArray('Unknown', 24, cpBenign),\n// wbArray('Hashes', wbInteger('Hash', itU64, wbMODTCallback), 3),\n// 0, nil, nil, cpBenign),\n wbMODS,\n wbMODD\n ], [], cpNormal, True, nil, True);\n\n\n wbDEST := wbRStruct('Destructable', [\n wbStruct(DEST, 'Header', [\n wbInteger('Health', itS32),\n wbInteger('Count', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'VATS Targetable'\n ], True)),\n wbByteArray('Unused', 2)\n ]),\n wbRArray('Stages',\n wbRStruct('Stage', [\n wbStruct(DSTD, 'Destruction Stage Data', [\n wbInteger('Health %', itU8),\n wbInteger('Index', itU8),\n wbInteger('Damage Stage', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Cap Damage',\n 'Disable',\n 'Destroy'\n ])),\n wbInteger('Self Damage per Second', itS32),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Debris', [DEBR, NULL]),\n wbInteger('Debris Count', itS32)\n ], cpNormal, True),\n wbRStructSK([0], 'Model', [\n wbString(DMDL, 'Model Filename'),\n wbByteArray(DMDT, 'Texture Files Hashes', 0, cpIgnore)\n// wbArray(DMDT, 'Unknown',\n// wbByteArray('Unknown', 24, cpBenign),\n// 0, nil, nil, cpBenign)\n ], []),\n wbEmpty(DSTF, 'End Marker', cpNormal, True)\n ], [])\n )\n ], []);\n\n wbDESTActor := wbRStruct('Destructable', [\n wbStruct(DEST, 'Header', [\n wbInteger('Health', itS32),\n wbInteger('Count', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'VATS Targetable'\n ])),\n wbByteArray('Unused', 2)\n ]),\n wbRArray('Stages',\n wbRStruct('Stage', [\n wbStruct(DSTD, 'Destruction Stage Data', [\n wbInteger('Health %', itU8),\n wbInteger('Index', itU8),\n wbInteger('Damage Stage', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Cap Damage',\n 'Disable',\n 'Destroy'\n ])),\n wbInteger('Self Damage per Second', itS32),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Debris', [DEBR, NULL]),\n wbInteger('Debris Count', itS32)\n ], cpNormal, True),\n wbRStructSK([0], 'Model', [\n wbString(DMDL, 'Model Filename'),\n wbByteArray(DMDT, 'Texture Files Hashes', 0, cpIgnore)\n// wbArray(DMDT, 'Unknown',\n// wbByteArray('Unknown', 24, cpBenign),\n// 0, nil, nil, cpBenign)\n ], []),\n wbEmpty(DSTF, 'End Marker', cpNormal, True)\n ], [])\n )\n ], [], cpNormal, False, wbActorTemplateUseModelAnimation);\n\n wbSCRI := wbFormIDCk(SCRI, 'Script', [SCPT]);\n wbSCRIActor := wbFormIDCk(SCRI, 'Script', [SCPT], False, cpNormal, False, wbActorTemplateUseScript);\n wbENAM := wbFormIDCk(ENAM, 'Object Effect', [ENCH]);\n\n wbXLOD := wbArray(XLOD, 'Distant LOD Data', wbFloat('Unknown'), 3);\n\n wbXESP := wbStruct(XESP, 'Enable Parent', [\n wbFormIDCk('Reference', [PLYR, REFR, ACRE, ACHR, PGRE, PMIS, PBEA]),\n wbInteger('Flags', itU8, wbFlags([\n 'Set Enable State to Opposite of Parent',\n 'Pop In'\n ])),\n wbByteArray('Unused', 3)\n ]);\n\n wbSCHRReq := wbStruct(SCHR, 'Basic Script Data', [\n wbByteArray('Unused', 4),\n wbInteger('RefCount', itU32),\n wbInteger('CompiledSize', itU32),\n wbInteger('VariableCount', itU32),\n wbInteger('Type', itU16, wbEnum([\n 'Object',\n 'Quest'\n ], [\n $100, 'Effect'\n ])),\n wbInteger('Flags', itU16, wbFlags([\n 'Enabled'\n ]), cpNormal, False, nil, nil, 1)\n ], cpNormal, True);\n\n wbSCROs :=\n wbRArray('References',\n wbRUnion('', [\n wbFormID(SCRO, 'Global Reference'),\n// wbFormIDCk(SCRO, 'Global Reference',\n// [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, IMAD,\n// BOOK, KEYM, ALCH, LIGH, QUST, PLYR, PACK, LVLI, ECZN, EXPL, FLST, IDLM, PMIS,\n// FACT, ACHR, REFR, ACRE, GLOB, DIAL, CELL, SOUN, MGEF, WTHR, CLAS, EFSH, RACE,\n// LVLC, CSTY, WRLD, SCPT, IMGS, MESG, MSTT, MUSC, NOTE, PERK, PGRE, PROJ, LVLN,\n// WATR, ENCH, TREE, TERM, HAIR, EYES, ADDN, NULL]),\n wbInteger(SCRV, 'Local Variable', itU32)\n ], [])\n );\n\n wbSLSD := wbStructSK(SLSD, [0], 'Local Variable Data', [\n wbInteger('Index', itU32),\n wbByteArray('Unused', 12),\n wbInteger('Flags', itU8, wbFlags(['IsLongOrShort']), cpCritical),\n wbByteArray('Unused', 7)\n ]);\n\n wbEmbeddedScript := wbRStruct('Embedded Script', [\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Embedded Script', 0, cpNormal{, True}),\n wbStringScript(SCTX, 'Embedded Script Source', 0, cpNormal{, True}),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ], [], cpNormal, False, nil, False, wbEmbeddedScriptAfterLoad);\n\n wbEmbeddedScriptPerk := wbRStruct('Embedded Script', [\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Embedded Script', 0, cpNormal, True),\n wbStringScript(SCTX, 'Embedded Script Source', 0, cpNormal, True),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ], [], cpNormal, False, wbEPF2DontShow, False, wbEmbeddedScriptAfterLoad);\n\n wbEmbeddedScriptReq := wbRStruct('Embedded Script', [\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Embedded Script', 0, cpNormal{, True}),\n wbStringScript(SCTX, 'Embedded Script Source', 0, cpNormal{, True}),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ], [], cpNormal, True, nil, False, wbEmbeddedScriptAfterLoad);\n\n\n wbXLCM := wbInteger(XLCM, 'Level Modifier', itS32);\n\n wbRecord(ACHR, 'Placed NPC', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [NPC_], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n {--- Ragdoll ---}\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Merchant Container ----}\n wbFormIDCk(XMRC, 'Merchant Container', [REFR], True),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbXOWN := wbFormIDCkNoReach(XOWN, 'Owner', [FACT, ACHR, CREA, NPC_]); // Ghouls can own too aparently !\n wbXGLB := wbFormIDCk(XGLB, 'Global variable', [GLOB]);\n\n wbRecord(ACRE, 'Placed Creature', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [CREA], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Merchant Container ----}\n wbFormIDCk(XMRC, 'Merchant Container', [REFR], True),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(ACTI, 'Activator', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbSCRI,\n wbDEST,\n wbFormIDCk(SNAM, 'Sound - Looping', [SOUN]),\n wbFormIDCk(VNAM, 'Sound - Activation', [SOUN]),\n wbFormIDCk(RNAM, 'Radio Station', [TACT]),\n wbFormIDCk(WNAM, 'Water Type', [WATR])\n ]);\n\n wbICON := wbRStruct('Icon', [\n wbString(ICON, 'Large Icon filename'),\n wbString(MICO, 'Small Icon filename')\n ], []);\n\n wbICONReq := wbRStruct('Icon', [\n wbString(ICON, 'Large Icon filename'),\n wbString(MICO, 'Small Icon filename')\n ], [], cpNormal, True);\n\n wbVatsValueFunctionEnum :=\n wbEnum([\n 'Weapon Is',\n 'Weapon In List',\n 'Target Is',\n 'Target In List',\n 'Target Distance',\n 'Target Part',\n 'VATS Action',\n 'Is Success',\n 'Is Critical',\n 'Critical Effect Is',\n 'Critical Effect In List',\n 'Is Fatal',\n 'Explode Part',\n 'Dismember Part',\n 'Cripple Part',\n 'Weapon Type Is',\n 'Is Stranger',\n 'Is Paralyzing Palm'\n ]);\n\n wbActorValueEnum :=\n wbEnum([\n {00} 'Aggresion',\n {01} 'Confidence',\n {02} 'Energy',\n {03} 'Responsibility',\n {04} 'Mood',\n {05} 'Strength',\n {06} 'Perception',\n {07} 'Endurance',\n {08} 'Charisma',\n {09} 'Intelligence',\n {10} 'Agility',\n {11} 'Luck',\n {12} 'Action Points',\n {13} 'Carry Weight',\n {14} 'Critical Chance',\n {15} 'Heal Rate',\n {16} 'Health',\n {17} 'Melee Damage',\n {18} 'Damage Resistance',\n {19} 'Poison Resistance',\n {20} 'Rad Resistance',\n {21} 'Speed Multiplier',\n {22} 'Fatigue',\n {23} 'Karma',\n {24} 'XP',\n {25} 'Perception Condition',\n {26} 'Endurance Condition',\n {27} 'Left Attack Condition',\n {28} 'Right Attack Condition',\n {29} 'Left Mobility Condition',\n {30} 'Right Mobility Condition',\n {31} 'Brain Condition',\n {32} 'Barter',\n {33} 'Big Guns',\n {34} 'Energy Weapons',\n {35} 'Explosives',\n {36} 'Lockpick',\n {37} 'Medicine',\n {38} 'Melee Weapons',\n {39} 'Repair',\n {40} 'Science',\n {41} 'Small Guns',\n {42} 'Sneak',\n {43} 'Speech',\n {44} 'Throwing (unused)',\n {45} 'Unarmed',\n {46} 'Inventory Weight',\n {47} 'Paralysis',\n {48} 'Invisibility',\n {49} 'Chameleon',\n {50} 'Night Eye',\n {51} 'Detect Life Range',\n {52} 'Fire Resistance',\n {53} 'Water Breathing',\n {54} 'Rad Level',\n {55} 'Bloody Mess',\n {56} 'Unarmed Damage',\n {57} 'Assistance',\n {58} 'Electric Resistance',\n {59} 'Frost Resistance',\n {60} 'Energy Resistance',\n {61} 'EMP Resistance',\n {62} 'Variable01',\n {63} 'Variable02',\n {64} 'Variable03',\n {65} 'Variable04',\n {66} 'Variable05',\n {67} 'Variable06',\n {68} 'Variable07',\n {79} 'Variable08',\n {70} 'Variable09',\n {71} 'Variable10',\n {72} 'Ignore Negative Effects'\n ], [\n -1, 'None'\n ]);\n\n wbSkillEnum :=\n wbEnum([\n 'Barter',\n 'Big Guns',\n 'Energy Weapons',\n 'Explosives',\n 'Lockpick',\n 'Medicine',\n 'Melee Weapons',\n 'Repair',\n 'Science',\n 'Small Guns',\n 'Sneak',\n 'Speech',\n 'Throwing (unused)',\n 'Unarmed'\n ], [\n -1, 'None'\n ]);\n\n wbCrimeTypeEnum :=\n wbEnum([\n 'Steal',\n 'Pickpocket',\n 'Trespass',\n 'Attack',\n 'Murder'\n ], [\n -1, 'None'\n ]);\n\n wbActorValue := wbInteger('Actor Value', itS32, wbActorValueEnum);\n\n wbEquipTypeEnum :=\n wbEnum([\n {00} 'Big Guns',\n {01} 'Energy Weapons',\n {02} 'Small Guns',\n {03} 'Melee Weapons',\n {04} 'Unarmed Weapon',\n {05} 'Thrown Weapons',\n {06} 'Mine',\n {07} 'Body Wear',\n {08} 'Head Wear',\n {09} 'Hand Wear',\n {10} 'Chems',\n {11} 'Stimpack',\n {12} 'Food',\n {13} 'Alcohol'\n ], [\n -1, 'None'\n ]);\n\n wbETYP := wbInteger(ETYP, 'Equiptment Type', itS32, wbEquipTypeEnum);\n wbETYPReq := wbInteger(ETYP, 'Equiptment Type', itS32, wbEquipTypeEnum, cpNormal, True);\n\n wbFormTypeEnum :=\n wbEnum([], [\n $04, 'Texture Set',\n $05, 'Menu Icon',\n $06, 'Global',\n $07, 'Class',\n $08, 'Faction',\n $09, 'Head Part',\n $0A, 'Hair',\n $0B, 'Eyes',\n $0C, 'Race',\n $0D, 'Sound',\n $0E, 'Acoustic Space',\n $0F, 'Skill',\n $10, 'Base Effect',\n $11, 'Script',\n $12, 'Landscape Texture',\n $13, 'Object Effect',\n $14, 'Actor Effect',\n $15, 'Activator',\n $16, 'Talking Activator',\n $17, 'Terminal',\n $18, 'Armor',\n $19, 'Book',\n $1A, 'Clothing',\n $1B, 'Container',\n $1C, 'Door',\n $1D, 'Ingredient',\n $1E, 'Light',\n $1F, 'Misc',\n $20, 'Static',\n $21, 'Static Collection',\n $22, 'Movable Static',\n $23, 'Placeable Water',\n $24, 'Grass',\n $25, 'Tree',\n $26, 'Flora',\n $27, 'Furniture',\n $28, 'Weapon',\n $29, 'Ammo',\n $2A, 'NPC',\n $2B, 'Creature',\n $2C, 'Leveled Creature',\n $2D, 'Leveled NPC',\n $2E, 'Key',\n $2F, 'Ingestible',\n $30, 'Idle Marker',\n $31, 'Note',\n $32, 'Constructible Object',\n $33, 'Projectile',\n $34, 'Leveled Item',\n $35, 'Weather',\n $36, 'Climate',\n $37, 'Region',\n $39, 'Cell',\n $3A, 'Placed Object',\n $3B, 'Placed Character',\n $3C, 'Placed Creature',\n $3E, 'Placed Grenade',\n $41, 'Worldspace',\n $42, 'Landscape',\n $43, 'Navigation Mesh',\n $45, 'Dialog Topic',\n $46, 'Dialog Response',\n $47, 'Quest',\n $48, 'Idle Animation',\n $49, 'Package',\n $4A, 'Combat Style',\n $4B, 'Load Screen',\n $4C, 'Leveled Spell',\n $4D, 'Animated Object',\n $4E, 'Water',\n $4F, 'Effect Shader',\n $51, 'Explosion',\n $52, 'Debris',\n $53, 'Image Space',\n $54, 'Image Space Modifier',\n $55, 'FormID List',\n $56, 'Perk',\n $57, 'Body Part Data',\n $58, 'Addon Node',\n $59, 'Actor Value Info',\n $5A, 'Radiation Stage',\n $5B, 'Camera Shot',\n $5C, 'Camera Path',\n $5D, 'Voice Type',\n $5E, 'Impact Data',\n $5F, 'Impact DataSet',\n $60, 'Armor Addon',\n $61, 'Encounter Zone',\n $62, 'Message',\n $63, 'Ragdoll',\n $64, 'Default Object Manager',\n $65, 'Lighting Template',\n $66, 'Music Type'\n ]);\n\n wbMenuModeEnum :=\n wbEnum([],[\n 1, 'Type: Character Interface',\n 2, 'Type: Other',\n 3, 'Type: Console',\n 1001, 'Specific: Message',\n 1002, 'Specific: Inventory',\n 1003, 'Specific: Stats',\n 1004, 'Specific: HUDMainMenu',\n 1007, 'Specific: Loading',\n 1008, 'Specific: Container',\n 1009, 'Specific: Dialog',\n 1012, 'Specific: Sleep/Wait',\n 1013, 'Specific: Pause',\n 1014, 'Specific: LockPick',\n 1016, 'Specific: Quantity',\n 1027, 'Specific: Level Up',\n 1035, 'Specific: Pipboy Repair',\n 1036, 'Specific: Race / Sex',\n 1047, 'Specific: Credits',\n 1048, 'Specific: CharGen',\n 1051, 'Specific: TextEdit',\n 1053, 'Specific: Barter',\n 1054, 'Specific: Surgery',\n 1055, 'Specific: Hacking',\n 1056, 'Specific: VATS',\n 1057, 'Specific: Computers',\n 1058, 'Specific: Vendor Repair',\n 1059, 'Specific: Tutorial',\n 1060, 'Specific: You''re SPECIAL book'\n ]);\nend;\n\nprocedure DefineFO3b;\nbegin\n wbMiscStatEnum :=\n wbEnum([\n 'Quests Completed',\n 'Locations Discovered',\n 'People Killed',\n 'Creatures Killed',\n 'Locks Picked',\n 'Computers Hacked',\n 'Stimpaks Taken',\n 'Rad-X Taken',\n 'RadAway Taken',\n 'Chems Taken',\n 'Times Addicted',\n 'Mines Disarmed',\n 'Speech Successes',\n 'Pockets Picked',\n 'Pants Exploded',\n 'Books Read',\n 'Bobbleheads Found',\n 'Weapons Created',\n 'People Mezzed',\n 'Captives Rescued',\n 'Sandman Kills',\n 'Paralyzing Punches',\n 'Robots Disabled',\n 'Contracts Completed',\n 'Corpses Eaten',\n 'Mysterious Stranger Visits'\n ]);\n\n wbAlignmentEnum :=\n wbEnum([\n 'Good',\n 'Neutral',\n 'Evil',\n 'Very Good',\n 'Very Evil'\n ]);\n\n wbAxisEnum :=\n wbEnum([], [\n 88, 'X',\n 89, 'Y',\n 90, 'Z'\n ]);\n\n wbCriticalStageEnum :=\n wbEnum([\n 'None',\n 'Goo Start',\n 'Goo End',\n 'Disintegrate Start',\n 'Disintegrate End'\n ]);\n\n wbSexEnum :=\n wbEnum(['Male','Female']);\n\n wbCreatureTypeEnum :=\n wbEnum([\n 'Animal',\n 'Mutated Animal',\n 'Mutated Insect',\n 'Abomination',\n 'Super Mutant',\n 'Feral Ghoul',\n 'Robot',\n 'Giant'\n ]);\n\n wbPlayerActionEnum :=\n wbEnum([\n '',\n 'Swinging Melee Weapon',\n 'Throwing Grenade',\n 'Fire Weapon',\n 'Lay Mine',\n 'Z Key Object',\n 'Jumping',\n 'Knocking over Objects',\n 'Stand on Table/Chair',\n 'Iron Sites',\n 'Destroying Object'\n ]);\n\n wbBodyLocationEnum :=\n wbEnum([\n 'Torso',\n 'Head 1',\n 'Head 2',\n 'Left Arm 1',\n 'Left Arm 2',\n 'Right Arm 1',\n 'Right Arm 2',\n 'Left Leg 1',\n 'Left Leg 2',\n 'Left Leg 3',\n 'Right Leg 1',\n 'Right Leg 2',\n 'Right Leg 3',\n 'Brain'\n ], [\n -1, 'None'\n ]);\n\n\n wbEFID := wbFormIDCk(EFID, 'Base Effect', [MGEF]);\n\n wbEFIT :=\n wbStructSK(EFIT, [3, 4], '', [\n wbInteger('Magnitude', itU32),\n wbInteger('Area', itU32),\n wbInteger('Duration', itU32),\n wbInteger('Type', itU32, wbEnum(['Self', 'Touch', 'Target'])),\n wbActorValue\n ], cpNormal, True, nil, -1, wbEFITAfterLoad);\n\n wbCTDA :=\n wbStruct(CTDA, 'Condition', [\n wbInteger('Type', itU8, wbCtdaTypeToStr, wbCtdaTypeToInt, cpNormal, False, nil, wbCtdaTypeAfterSet),\n wbByteArray('Unused', 3),\n wbUnion('Comparison Value', wbCTDACompValueDecider, [\n wbFloat('Comparison Value - Float'),\n wbFormIDCk('Comparison Value - Global', [GLOB])\n ]),\n wbInteger('Function', itU32, wbCTDAFunctionToStr, wbCTDAFunctionToInt), // Limited to itu16\n wbUnion('Parameter #1', wbCTDAParam1Decider, [\n {00} wbByteArray('Unknown', 4),\n {01} wbByteArray('None', 4, cpIgnore),\n {02} wbInteger('Integer', itS32),\n {03} wbInteger('Variable Name (INVALID)', itS32),\n {04} wbInteger('Sex', itU32, wbSexEnum),\n {05} wbInteger('Actor Value', itS32, wbActorValueEnum),\n {06} wbInteger('Crime Type', itU32, wbCrimeTypeEnum),\n {07} wbInteger('Axis', itU32, wbAxisEnum),\n {08} wbInteger('Quest Stage (INVALID)', itS32),\n {09} wbInteger('Misc Stat', itU32, wbMiscStatEnum),\n {10} wbInteger('Alignment', itU32, wbAlignmentEnum),\n {11} wbInteger('Equip Type', itU32, wbEquipTypeEnum),\n {12} wbInteger('Form Type', itU32, wbFormTypeEnum),\n {13} wbInteger('Critical Stage', itU32, wbCriticalStageEnum),\n {14} wbFormIDCkNoReach('Object Reference', [PLYR, REFR, ACHR, ACRE, PGRE, PMIS, PBEA, TRGT], True),\n {16} wbFormIDCkNoReach('Inventory Object', [ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, FLST]),\n {17} wbFormIDCkNoReach('Actor', [PLYR, ACHR, ACRE, TRGT], True),\n {18} wbFormIDCkNoReach('Voice Type', [VTYP]),\n {19} wbFormIDCkNoReach('Idle', [IDLE]),\n {20} wbFormIDCkNoReach('Form List', [FLST]),\n {21} wbFormIDCkNoReach('Note', [NOTE]),\n {22} wbFormIDCkNoReach('Quest', [QUST]),\n {23} wbFormIDCkNoReach('Faction', [FACT]),\n {24} wbFormIDCkNoReach('Weapon', [WEAP]),\n {25} wbFormIDCkNoReach('Cell', [CELL]),\n {26} wbFormIDCkNoReach('Class', [CLAS]),\n {27} wbFormIDCkNoReach('Race', [RACE]),\n {28} wbFormIDCkNoReach('Actor Base', [NPC_, CREA, ACTI, TACT]),\n {29} wbFormIDCkNoReach('Global', [GLOB]),\n {30} wbFormIDCkNoReach('Weather', [WTHR]),\n {31} wbFormIDCkNoReach('Package', [PACK]),\n {32} wbFormIDCkNoReach('Encounter Zone', [ECZN]),\n {33} wbFormIDCkNoReach('Perk', [PERK]),\n {34} wbFormIDCkNoReach('Owner', [FACT, NPC_]),\n {35} wbFormIDCkNoReach('Furniture', [FURN, FLST]),\n {36} wbFormIDCkNoReach('Effect Item', [SPEL, ENCH, ALCH, INGR]),\n {37} wbFormIDCkNoReach('Base Effect', [MGEF]),\n {38} wbFormIDCkNoReach('Worldspace', [WRLD]),\n {39} wbInteger('VATS Value Function', itU32, wbVATSValueFunctionEnum),\n {40} wbInteger('VATS Value Param (INVALID)', itU32),\n {41} wbInteger('Creature Type', itU32, wbCreatureTypeEnum),\n {42} wbInteger('Menu Mode', itU32, wbMenuModeEnum),\n {43} wbInteger('Player Action', itU32, wbPlayerActionEnum),\n {44} wbInteger('Body Location', itS32, wbBodyLocationEnum),\n {45} wbFormIDCkNoReach('Referenceable Object', [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, FLST, LVLC, LVLN],\n [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, LVLC, LVLN])\n ]),\n wbUnion('Parameter #2', wbCTDAParam2Decider, [\n {00} wbByteArray('Unknown', 4),\n {01} wbByteArray('None', 4, cpIgnore),\n {02} wbInteger('Integer', itS32),\n {03} wbInteger('Variable Name', itS32, wbCTDAParam2VariableNameToStr, wbCTDAParam2VariableNameToInt),\n {04} wbInteger('Sex', itU32, wbSexEnum),\n {05} wbInteger('Actor Value', itS32, wbActorValueEnum),\n {06} wbInteger('Crime Type', itU32, wbCrimeTypeEnum),\n {07} wbInteger('Axis', itU32, wbAxisEnum),\n {08} wbInteger('Quest Stage', itS32, wbCTDAParam2QuestStageToStr, wbCTDAParam2QuestStageToInt),\n {09} wbInteger('Misc Stat', itU32, wbMiscStatEnum),\n {10} wbInteger('Alignment', itU32, wbAlignmentEnum),\n {11} wbInteger('Equip Type', itU32, wbEquipTypeEnum),\n {12} wbInteger('Form Type', itU32, wbFormTypeEnum),\n {13} wbInteger('Critical Stage', itU32, wbCriticalStageEnum),\n {14} wbFormIDCkNoReach('Object Reference', [PLYR, REFR, PMIS, PBEA, ACHR, ACRE, PGRE, TRGT], True),\n {16} wbFormIDCkNoReach('Inventory Object', [ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, FLST]),\n {17} wbFormIDCkNoReach('Actor', [PLYR, ACHR, ACRE, TRGT], True),\n {18} wbFormIDCkNoReach('Voice Type', [VTYP]),\n {19} wbFormIDCkNoReach('Idle', [IDLE]),\n {20} wbFormIDCkNoReach('Form List', [FLST]),\n {21} wbFormIDCkNoReach('Note', [NOTE]),\n {22} wbFormIDCkNoReach('Quest', [QUST]),\n {23} wbFormIDCkNoReach('Faction', [FACT]),\n {24} wbFormIDCkNoReach('Weapon', [WEAP]),\n {25} wbFormIDCkNoReach('Cell', [CELL]),\n {26} wbFormIDCkNoReach('Class', [CLAS]),\n {27} wbFormIDCkNoReach('Race', [RACE]),\n {28} wbFormIDCkNoReach('Actor Base', [NPC_, CREA, ACTI, TACT]),\n {29} wbFormIDCkNoReach('Global', [GLOB]),\n {30} wbFormIDCkNoReach('Weather', [WTHR]),\n {31} wbFormIDCkNoReach('Package', [PACK]),\n {32} wbFormIDCkNoReach('Encounter Zone', [ECZN]),\n {33} wbFormIDCkNoReach('Perk', [PERK]),\n {34} wbFormIDCkNoReach('Owner', [FACT, NPC_]),\n {35} wbFormIDCkNoReach('Furniture', [FURN, FLST]),\n {36} wbFormIDCkNoReach('Effect Item', [SPEL, ENCH, ALCH, INGR]),\n {37} wbFormIDCkNoReach('Base Effect', [MGEF]),\n {38} wbFormIDCkNoReach('Worldspace', [WRLD]),\n {39} wbInteger('VATS Value Function (INVALID)', itU32),\n {40} wbUnion('VATS Value Param', wbCTDAParam2VATSValueParam, [\n wbFormIDCkNoReach('Weapon', [WEAP]),\n wbFormIDCkNoReach('Weapon List', [FLST], [WEAP]),\n wbFormIDCkNoReach('Target', [NPC_, CREA]),\n wbFormIDCkNoReach('Target List', [FLST], [NPC_, CREA]),\n wbByteArray('Unused', 4, cpIgnore),\n wbInteger('Target Part', itS32, wbActorValueEnum),\n wbInteger('VATS Action', itU32, wbEnum([\n 'Unarmed Attack',\n 'One Hand Melee Attack',\n 'Two Hand Melee Attack',\n 'Fire Pistol',\n 'Fire Rifle',\n 'Fire Handle Weapon',\n 'Fire Launcher',\n 'Throw Grenade',\n 'Place Mine',\n 'Reload',\n 'Crouch',\n 'Stand',\n 'Switch Weapon',\n 'Toggle Weapon Drawn',\n 'Heal',\n 'Player Death'\n ])),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Critical Effect', [SPEL]),\n wbFormIDCkNoReach('Critical Effect List', [FLST], [SPEL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbInteger('Weapon Type', itU32, wbWeaponAnimTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n {41} wbInteger('Creature Type', itU32, wbCreatureTypeEnum),\n {42} wbInteger('Menu Mode', itU32, wbMenuModeEnum),\n {43} wbInteger('Player Action', itU32, wbPlayerActionEnum),\n {44} wbInteger('Body Location', itS32, wbBodyLocationEnum),\n {45} wbFormIDCkNoReach('Referenceable Object', [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, FLST, LVLC, LVLN],\n [CREA, NPC_, PROJ, TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, LVLC, LVLN])\n ]),\n wbInteger('Run On', itU32, wbEnum([\n 'Subject',\n 'Target',\n 'Reference',\n 'Combat Target',\n 'Linked Reference'\n ]), cpNormal, False, nil, wbCTDARunOnAfterSet),\n wbUnion('Reference', wbCTDAReferenceDecider, [\n wbInteger('Unused', itU32, nil, cpIgnore),\n wbFormIDCkNoReach('Reference', [PLYR, ACHR, ACRE, REFR, PMIS, PBEA, PGRE], True)\n ])\n ], cpNormal, False, nil, 6, wbCTDAAfterLoad);\n wbCTDAs := wbRArray('Conditions', wbCTDA);\n wbCTDAsReq := wbRArray('Conditions', wbCTDA, cpNormal, True);\n\n wbEffects :=\n wbRStructs('Effects','Effect', [\n wbEFID,\n wbEFIT,\n wbCTDAs\n ], []);\n\n wbEffectsReq :=\n wbRStructs('Effects','Effect', [\n wbEFID,\n wbEFIT,\n wbCTDAs\n ], [], cpNormal, True);\n\n\n wbRecord(ALCH, 'Ingestible', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLReq,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbETYPReq,\n wbFloat(DATA, 'Weight', cpNormal, True),\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Value', itS32),\n wbInteger('Flags?', itU8, wbFlags([\n 'No Auto-Calc (Unused)',\n 'Food Item',\n 'Medicine'\n ])),\n wbByteArray('Unused', 3),\n wbFormIDCk('Withdrawal Effect', [SPEL, NULL]),\n wbFloat('Addiction Chance'),\n wbFormIDCk('Sound - Consume', [SOUN])\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(AMMO, 'Ammunition', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLReq,\n wbMODL,\n wbICON,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbFloat('Speed'),\n wbInteger('Flags', itU8, wbFlags([\n 'Ignores Normal Weapon Resistance',\n 'Non-Playable'\n ])),\n wbByteArray('Unused', 3),\n wbInteger('Value', itS32),\n wbInteger('Clip Rounds', itU8)\n ], cpNormal, True),\n wbString(ONAM, 'Short Name')\n ]);\n\n wbRecord(ANIO, 'Animated Object', [\n wbEDIDReq,\n wbMODLReq,\n wbFormIDCk(DATA, 'Animation', [IDLE], False, cpNormal, True)\n ]);\n\n wbBMDT := wbStruct(BMDT, 'Biped Data', [\n wbInteger('Biped Flags', itU32, wbFlags([\n {0x00000001} 'Head',\n {0x00000002} 'Hair',\n {0x00000004} 'Upper Body',\n {0x00000008} 'Left Hand',\n {0x00000010} 'Right Hand',\n {0x00000020} 'Weapon',\n {0x00000040} 'PipBoy',\n {0x00000080} 'Backpack',\n {0x00000100} 'Necklace',\n {0x00000200} 'Headband',\n {0x00000400} 'Hat',\n {0x00000800} 'Eye Glasses',\n {0x00001000} 'Nose Ring',\n {0x00002000} 'Earrings',\n {0x00004000} 'Mask',\n {0x00008000} 'Choker',\n {0x00010000} 'Mouth Object',\n {0x00020000} 'Body AddOn 1',\n {0x00040000} 'Body AddOn 2',\n {0x00080000} 'Body AddOn 3'\n ])),\n wbInteger('General Flags', itU8, wbFlags([\n {0x0001} '',\n {0x0002} '',\n {0x0004} '',\n {0x0008} '',\n {0x0010} '',\n {0x0020} 'Power Armor',\n {0x0040} 'Non-Playable',\n {0x0080} 'Heavy'\n ], True)),\n wbByteArray('Unused', 3)\n ], cpNormal, True);\n\n wbRecord(ARMO, 'Armor', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbSCRI,\n wbEITM,\n wbBMDT,\n wbRStruct('Male biped model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Male world model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO2S\n ], []),\n wbString(ICON, 'Male icon filename'),\n wbString(MICO, 'Male mico filename'),\n wbRStruct('Female biped model', [\n wbString(MOD3, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO3S,\n wbMOSD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Female world model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO4S\n ], []),\n wbString(ICO2, 'Female icon filename'),\n wbString(MIC2, 'Female mico filename'),\n wbString(BMCT, 'Ragdoll Constraint Template'),\n wbDEST,\n wbREPL,\n wbBIPL,\n wbETYPReq,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itS32),\n wbInteger('Max Condition', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n wbInteger('AR', itS16, wbDiv(100)),\n wbInteger('Flags', itU16, wbFlags([\n 'Modulates Voice'\n ]))\n ], cpNormal, True)\n ]);\n\n wbRecord(ARMA, 'Armor Addon', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbBMDT,\n wbRStruct('Male biped model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore),\n wbMODS,\n wbMODD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Male world model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO2S\n ], []),\n wbString(ICON, 'Male icon filename'),\n wbString(MICO, 'Male mico filename'),\n wbRStruct('Female biped model', [\n wbString(MOD3, 'Model Filename', 0, cpNormal, True),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO3S,\n wbMOSD\n ], [], cpNormal, False, nil, True),\n wbRStruct('Female world model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO4S\n ], []),\n wbString(ICO2, 'Female icon filename'),\n wbString(MIC2, 'Female mico filename'),\n wbETYPReq,\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itS32),\n wbInteger('Max Condition', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n wbInteger('AR', itS16, wbDiv(100)),\n wbInteger('Flags', itU16, wbFlags([\n 'Modulates Voice'\n ]))\n ], cpNormal, True)\n ]);\n\n wbRecord(BOOK, 'Book', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDESCReq,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, 'Data', [\n wbInteger('Flags', itU8, wbFlags([\n '',\n 'Can''t be Taken'\n ])),\n wbInteger('Skill', itS8, wbSkillEnum),\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ]);\n\n wbSPLO := wbFormIDCk(SPLO, 'Actor Effect', [SPEL]);\n wbSPLOs := wbRArrayS('Actor Effects', wbSPLO, cpNormal, False, nil, nil, wbActorTemplateUseActorEffectList);\n\n wbRecord(CELL, 'Cell', [\n wbEDID,\n wbFULL,\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n {0x01} 'Is Interior Cell',\n {0x02} 'Has water',\n {0x04} 'Invert Fast Travel behavior',\n {0x08} 'No LOD Water',\n {0x10} '',\n {0x20} 'Public place',\n {0x40} 'Hand changed',\n {0x80} 'Behave like exterior'\n ]), cpNormal, True),\n wbStruct(XCLC, 'Grid', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32),\n wbInteger('Force Hide Land', itU32, wbFlags([\n 'Quad 1',\n 'Quad 2',\n 'Quad 3',\n 'Quad 4'\n ], True))\n ], cpNormal, False, nil, 2),\n wbStruct(XCLL, 'Lighting', [\n wbStruct('Ambient Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Directional Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Fog Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Fog Near'),\n wbFloat('Fog Far'),\n wbInteger('Directional Rotation XY', itS32),\n wbInteger('Directional Rotation Z', itS32),\n wbFloat('Directional Fade'),\n wbFloat('Fog Clip Dist'),\n wbFloat('Fog Power')\n ], cpNormal, False, nil, 7),\n wbArray(IMPF, 'Footstep Materials', wbString('Unknown', 30), [\n 'ConcSolid',\n 'ConcBroken',\n 'MetalSolid',\n 'MetalHollow',\n 'MetalSheet',\n 'Wood',\n 'Sand',\n 'Dirt',\n 'Grass',\n 'Water'\n ]),\n wbRStruct('Light Template', [\n wbFormIDCk(LTMP, 'Template', [LGTM, NULL]),\n wbInteger(LNAM, 'Inherit', itU32, wbFlags([\n {0x00000001}'Ambient Color',\n {0x00000002}'Directional Color',\n {0x00000004}'Fog Color',\n {0x00000008}'Fog Near',\n {0x00000010}'Fog Far',\n {0x00000020}'Directional Rotation',\n {0x00000040}'Directional Fade',\n {0x00000080}'Clip Distance',\n {0x00000100}'Fog Power'\n ]), cpNormal, True)\n ], [], cpNormal, True ),\n wbFloat(XCLW, 'Water Height'),\n wbString(XNAM, 'Water Noise Texture'),\n wbArrayS(XCLR, 'Regions', wbFormIDCk('Region', [REGN])),\n wbFormIDCk(XCIM, 'Image Space', [IMGS]),\n wbByteArray(XCET, 'Unknown', 1, cpIgnore),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbFormIDCk(XCCM, 'Climate', [CLMT]),\n wbFormIDCk(XCWT, 'Water', [WATR]),\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n wbFormIDCk(XCAS, 'Acoustic Space', [ASPC]),\n wbByteArray(XCMT, 'Unused', 1, cpIgnore),\n wbFormIDCk(XCMO, 'Music Type', [MUSC])\n ], True, wbCellAddInfo, cpNormal, False, wbCELLAfterLoad);\n\n wbServiceFlags :=\n wbFlags([\n {0x00000001} 'Weapons',\n {0x00000002} 'Armor',\n {0x00000004} 'Alcohol',\n {0x00000008} 'Books',\n {0x00000010} 'Food',\n {0x00000020} 'Chems',\n {0x00000040} 'Stimpacks',\n {0x00000080} 'Lights?',\n {0x00000100} '',\n {0x00000200} '',\n {0x00000400} 'Miscellaneous',\n {0x00000800} '',\n {0x00001000} '',\n {0x00002000} 'Potions?',\n {0x00004000} 'Training',\n {0x00008000} '',\n {0x00010000} 'Recharge',\n {0x00020000} 'Repair'\n ]);\n\n wbSpecializationEnum := wbEnum(['Combat', 'Magic', 'Stealth']);\n\n wbRecord(CLAS, 'Class', [\n wbEDIDReq,\n wbFULLReq,\n wbDESCReq,\n wbICON,\n wbStruct(DATA, '', [\n wbArray('Tag Skills', wbInteger('Tag Skill', itS32, wbActorValueEnum), 4),\n wbInteger('Flags', itU32, wbFlags(['Playable', 'Guard'], True)),\n wbInteger('Buys/Sells and Services', itU32, wbServiceFlags),\n wbInteger('Teaches', itS8, wbSkillEnum),\n wbInteger('Maximum training level', itU8),\n wbByteArray('Unused', 2)\n ], cpNormal, True),\n wbArray(ATTR, 'Attributes', wbInteger('Attribute', itU8), [\n 'Strength',\n 'Perception',\n 'Endurance',\n 'Charisma',\n 'Intelligence',\n 'Agility',\n 'Luck'\n ], cpNormal, True)\n ]);\nend;\n\nprocedure DefineFO3c;\nbegin\n wbRecord(CLMT, 'Climate', [\n wbEDIDReq,\n wbArrayS(WLST, 'Weather Types', wbStructSK([0], 'Weather Type', [\n wbFormIDCk('Weather', [WTHR, NULL]),\n wbInteger('Chance', itS32),\n wbFormIDCk('Global', [GLOB, NULL])\n ])),\n wbString(FNAM, 'Sun Texture'),\n wbString(GNAM, 'Sun Glare Texture'),\n wbMODL,\n wbStruct(TNAM, 'Timing', [\n wbStruct('Sunrise', [\n wbInteger('Begin', itU8, wbClmtTime),\n wbInteger('End', itU8, wbClmtTime)\n ]),\n wbStruct('Sunset', [\n wbInteger('Begin', itU8, wbClmtTime),\n wbInteger('End', itU8, wbClmtTime)\n ]),\n wbInteger('Volatility', itU8),\n wbInteger('Moons / Phase Length', itU8, wbClmtMoonsPhaseLength)\n ], cpNormal, True)\n ]);\n\n wbCNTO :=\n wbRStructExSK([0], [1], 'Item', [\n wbStructExSK(CNTO, [0], [1], 'Item', [\n wbFormIDCk('Item', [ARMO, AMMO, MISC, WEAP, BOOK, LVLI, KEYM, ALCH, NOTE, MSTT{?}, STAT{?}]),\n wbInteger('Count', itS32)\n ]),\n wbCOED\n ], []);\n\n wbCNTOs := wbRArrayS('Items', wbCNTO);\n\n wbRecord(CONT, 'Container', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbSCRI,\n wbCNTOs,\n wbDEST,\n wbStruct(DATA, '', [\n wbInteger('Flags', itU8, wbFlags(['', 'Respawns'])),\n wbFloat('Weight')\n ], cpNormal, True),\n wbFormIDCk(SNAM, 'Sound - Open', [SOUN]),\n wbFormIDCk(QNAM, 'Sound - Close', [SOUN])\n ], True);\n\n wbCSDT := wbRStructSK([0], 'Sound Type', [\n wbInteger(CSDT, 'Type', itU32,wbEnum([\n {0x00} 'Left Foot',\n {0x01} 'Right Foot',\n {0x02} 'Left Back Foot',\n {0x03} 'Right Back Foot',\n {0x04} 'Idle',\n {0x05} 'Aware',\n {0x06} 'Attack',\n {0x07} 'Hit',\n {0x08} 'Death',\n {0x09} 'Weapon',\n {0x0A} 'Movement',\n {0x0B} 'Conscious'\n ])),\n wbRArrayS('Sounds', wbRStructSK([0], 'Sound', [\n wbFormIDCk(CSDI, 'Sound', [SOUN], False, cpNormal, True),\n wbInteger(CSDC, 'Sound Chance', itU8, nil, cpNormal, True)\n ], []), cpNormal, True)\n ], []);\n\n wbCSDTs := wbRArrayS('Sound Types', wbCSDT, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation);\n\n wbAgressionEnum := wbEnum([\n 'Unaggressive',\n 'Aggressive',\n 'Very Aggressive',\n 'Frenzied'\n ]);\n\n wbConfidenceEnum := wbEnum([\n 'Cowardly',\n 'Cautious',\n 'Average',\n 'Brave',\n 'Foolhardy'\n ]);\n\n wbMoodEnum := wbEnum([\n 'Neutral',\n 'Afraid',\n 'Annoyed',\n 'Cocky',\n 'Drugged',\n 'Pleasant',\n 'Angry',\n 'Sad'\n ]);\n\n wbAssistanceEnum := wbEnum([\n 'Helps Nobody',\n 'Helps Allies',\n 'Helps Friends and Allies'\n ]);\n\n wbAggroRadiusFlags := wbFlags([\n 'Aggro Radius Behavior'\n ]);\n\n wbAIDT :=\n wbStruct(AIDT, 'AI Data', [\n {00} wbInteger('Aggression', itU8, wbAgressionEnum),\n {01} wbInteger('Confidence', itU8, wbConfidenceEnum),\n {02} wbInteger('Energy Level', itU8),\n {03} wbInteger('Responsibility', itU8),\n {04} wbInteger('Mood', itU8, wbMoodEnum),\n wbByteArray('Unused', 3),\n {08} wbInteger('Buys/Sells and Services', itU32, wbServiceFlags),\n {0C} wbInteger('Teaches', itS8, wbSkillEnum),\n {0D} wbInteger('Maximum training level', itU8),\n {0E} wbInteger('Assistance', itS8, wbAssistanceEnum),\n {0F} wbInteger('Aggro Radius Behavior', itU8, wbAggroRadiusFlags),\n {10} wbInteger('Aggro Radius', itS32)\n ], cpNormal, True, wbActorTemplateUseAIData);\n\n wbAttackAnimationEnum :=\n wbEnum([\n ], [\n 26, 'AttackLeft',\n 27, 'AttackLeftUp',\n 28, 'AttackLeftDown',\n 29, 'AttackLeftIS',\n 30, 'AttackLeftISUp',\n 31, 'AttackLeftISDown',\n 32, 'AttackRight',\n 33, 'AttackRightUp',\n 34, 'AttackRightDown',\n 35, 'AttackRightIS',\n 36, 'AttackRightISUp',\n 37, 'AttackRightISDown',\n 38, 'Attack3',\n 39, 'Attack3Up',\n 40, 'Attack3Down',\n 41, 'Attack3IS',\n 42, 'Attack3ISUp',\n 43, 'Attack3ISDown',\n 44, 'Attack4',\n 45, 'Attack4Up',\n 46, 'Attack4Down',\n 47, 'Attack4IS',\n 48, 'Attack4ISUp',\n 49, 'Attack4ISDown',\n 50, 'Attack5',\n 51, 'Attack5Up',\n 52, 'Attack5Down',\n 53, 'Attack5IS',\n 54, 'Attack5ISUp',\n 55, 'Attack5ISDown',\n 56, 'Attack6',\n 57, 'Attack6Up',\n 58, 'Attack6Down',\n 59, 'Attack6IS',\n 60, 'Attack6ISUp',\n 61, 'Attack6ISDown',\n 62, 'Attack7',\n 63, 'Attack7Up',\n 64, 'Attack7Down',\n 65, 'Attack7IS',\n 66, 'Attack7ISUp',\n 67, 'Attack7ISDown',\n 68, 'Attack8',\n 69, 'Attack8Up',\n 70, 'Attack8Down',\n 71, 'Attack8IS',\n 72, 'Attack8ISUp',\n 73, 'Attack8ISDown',\n 74, 'AttackLoop',\n 75, 'AttackLoopUp',\n 76, 'AttackLoopDown',\n 77, 'AttackLoopIS',\n 78, 'AttackLoopISUp',\n 79, 'AttackLoopISDown',\n 80, 'AttackSpin',\n 81, 'AttackSpinUp',\n 82, 'AttackSpinDown',\n 83, 'AttackSpinIS',\n 84, 'AttackSpinISUp',\n 85, 'AttackSpinISDown',\n 86, 'AttackSpin2',\n 87, 'AttackSpin2Up',\n 88, 'AttackSpin2Down',\n 89, 'AttackSpin2IS',\n 90, 'AttackSpin2ISUp',\n 91, 'AttackSpin2ISDown',\n 92, 'AttackPower',\n 93, 'AttackForwardPower',\n 94, 'AttackBackPower',\n 95, 'AttackLeftPower',\n 96, 'AttackRightPower',\n 97, 'PlaceMine',\n 98, 'PlaceMineUp',\n 99, 'PlaceMineDown',\n 100, 'PlaceMineIS',\n 101, 'PlaceMineISUp',\n 102, 'PlaceMineISDown',\n 103, 'PlaceMine2',\n 104, 'PlaceMine2Up',\n 105, 'PlaceMine2Down',\n 106, 'PlaceMine2IS',\n 107, 'PlaceMine2ISUp',\n 108, 'PlaceMine2ISDown',\n 109, 'AttackThrow',\n 110, 'AttackThrowUp',\n 111, 'AttackThrowDown',\n 112, 'AttackThrowIS',\n 113, 'AttackThrowISUp',\n 114, 'AttackThrowISDown',\n 115, 'AttackThrow2',\n 116, 'AttackThrow2Up',\n 117, 'AttackThrow2Down',\n 118, 'AttackThrow2IS',\n 119, 'AttackThrow2ISUp',\n 120, 'AttackThrow2ISDown',\n 121, 'AttackThrow3',\n 122, 'AttackThrow3Up',\n 123, 'AttackThrow3Down',\n 124, 'AttackThrow3IS',\n 125, 'AttackThrow3ISUp',\n 126, 'AttackThrow3ISDown',\n 127, 'AttackThrow4',\n 128, 'AttackThrow4Up',\n 129, 'AttackThrow4Down',\n 130, 'AttackThrow4IS',\n 131, 'AttackThrow4ISUp',\n 132, 'AttackThrow4ISDown',\n 133, 'AttackThrow5',\n 134, 'AttackThrow5Up',\n 135, 'AttackThrow5Down',\n 136, 'AttackThrow5IS',\n 137, 'AttackThrow5ISUp',\n 138, 'AttackThrow5ISDown',\n\n 167, 'PipBoy',\n 178, 'PipBoyChild',\n\n 255, ' ANY'\n ]);\n\n wbImpactMaterialTypeEnum :=\n wbEnum([\n 'Stone',\n 'Dirt',\n 'Grass',\n 'Glass',\n 'Metal',\n 'Wood',\n 'Organic',\n 'Cloth',\n 'Water',\n 'Hollow Metal',\n 'Organic Bug',\n 'Organic Glow'\n ]);\n\n wbTemplateFlags := wbFlags([\n 'Use Traits',\n 'Use Stats',\n 'Use Factions',\n 'Use Actor Effect List',\n 'Use AI Data',\n 'Use AI Packages',\n 'Use Model/Animation',\n 'Use Base Data',\n 'Use Inventory',\n 'Use Script'\n ]);\n\n wbRecord(CREA, 'Creature', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLActor,\n wbMODLActor,\n wbSPLOs,\n wbFormIDCk(EITM, 'Unarmed Attack Effect', [ENCH, SPEL], False, cpNormal, False, wbActorTemplateUseActorEffectList),\n wbInteger(EAMT, 'Unarmed Attack Animation', itU16, wbAttackAnimationEnum, cpNormal, True, False, wbActorTemplateUseActorEffectList),\n wbArrayS(NIFZ, 'Model List', wbStringLC('Model'), 0, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbByteArray(NIFT, 'Texture Files Hashes', 0, cpIgnore, False, False, wbActorTemplateUseModelAnimation),\n wbStruct(ACBS, 'Configuration', [\n {00} wbInteger('Flags', itU32, wbFlags([\n {0x000001} 'Biped',\n {0x000002} 'Essential',\n {0x000004} 'Weapon & Shield?',\n {0x000008} 'Respawn',\n {0x000010} 'Swims',\n {0x000020} 'Flies',\n {0x000040} 'Walks',\n {0x000080} 'PC Level Mult',\n {0x000100} 'Unknown 8',\n {0x000200} 'No Low Level Processing',\n {0x000400} '',\n {0x000800} 'No Blood Spray',\n {0x001000} 'No Blood Decal',\n {0x002000} '',\n {0x004000} '',\n {0x008000} 'No Head',\n {0x010000} 'No Right Arm',\n {0x020000} 'No Left Arm',\n {0x040000} 'No Combat in Water',\n {0x080000} 'No Shadow',\n {0x100000} 'No VATS Melee',\n {0x00200000} 'Allow PC Dialogue',\n {0x00400000} 'Can''t Open Doors',\n {0x00800000} 'Immobile',\n {0x01000000} 'Tilt Front/Back',\n {0x02000000} 'Tilt Left/Right',\n {0x03000000} 'No Knockdowns',\n {0x08000000} 'Not Pushable',\n {0x10000000} 'Allow Pickpocket',\n {0x20000000} 'Is Ghost',\n {0x40000000} 'No Rotating To Head-track',\n {0x80000000} 'Invulnerable'\n ], [\n {0x000001 Biped} wbActorTemplateUseModelAnimation,\n {0x000002 Essential} wbActorTemplateUseBaseData,\n {0x000004 Weapon & Shield} nil,\n {0x000008 Respawn} wbActorTemplateUseBaseData,\n {0x000010 Swims} wbActorTemplateUseModelAnimation,\n {0x000020 Flies} wbActorTemplateUseModelAnimation,\n {0x000040 Walks} wbActorTemplateUseModelAnimation,\n {0x000080 PC Level Mult} wbActorTemplateUseStats,\n {0x000100 Unknown 8} nil,\n {0x000200 No Low Level Processing} wbActorTemplateUseBaseData,\n {0x000400 } nil,\n {0x000800 No Blood Spray} wbActorTemplateUseModelAnimation,\n {0x001000 No Blood Decal} wbActorTemplateUseModelAnimation,\n {0x002000 } nil,\n {0x004000 } nil,\n {0x008000 No Head} wbActorTemplateUseModelAnimation,\n {0x010000 No Right Arm} wbActorTemplateUseModelAnimation,\n {0x020000 No Left Arm} wbActorTemplateUseModelAnimation,\n {0x040000 No Combat in Water} wbActorTemplateUseModelAnimation,\n {0x080000 No Shadow} wbActorTemplateUseModelAnimation,\n {0x100000 No VATS Melee} nil,\n {0x00200000 Allow PC Dialogue} wbActorTemplateUseBaseData,\n {0x00400000 Can''t Open Doors} wbActorTemplateUseBaseData,\n {0x00800000 Immobile} wbActorTemplateUseModelAnimation,\n {0x01000000 Tilt Front/Back} wbActorTemplateUseModelAnimation,\n {0x02000000 Tilt Left/Right} wbActorTemplateUseModelAnimation,\n {0x03000000 No Knockdowns} nil,\n {0x08000000 Not Pushable} wbActorTemplateUseModelAnimation,\n {0x10000000 Allow Pickpocket} wbActorTemplateUseBaseData,\n {0x20000000 Is Ghost} nil,\n {0x40000000 No Rotating To Head-track} wbActorTemplateUseModelAnimation,\n {0x80000000 Invulnerable} nil\n ])),\n {04} wbInteger('Fatigue', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {06} wbInteger('Barter gold', itU16, nil, cpNormal, False, wbActorTemplateUseAIData),\n {08} wbUnion('Level', wbCreaLevelDecider, [\n wbInteger('Level', itS16, nil, cpNormal, False, wbActorTemplateUseStats),\n wbInteger('Level Mult', itS16, wbDiv(1000), cpNormal, False, wbActorTemplateUseStats)\n ], cpNormal, False, wbActorTemplateUseStats),\n {10} wbInteger('Calc min', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {12} wbInteger('Calc max', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {14} wbInteger('Speed Multiplier', itU16, nil, cpNormal, False, wbActorTemplateUseStats),\n {16} wbFloat('Karma (Alignment)', cpNormal, False, 1, -1, wbActorTemplateUseTraits),\n {20} wbInteger('Disposition Base', itS16, nil, cpNormal, False, wbActorTemplateUseTraits),\n {22} wbInteger('Template Flags', itU16, wbTemplateFlags)\n ], cpNormal, True),\n wbRArrayS('Factions',\n wbStructSK(SNAM, [0], 'Faction', [\n wbFormIDCk('Faction', [FACT]),\n wbInteger('Rank', itU8),\n wbByteArray('Unused', 3)\n ]),\n cpNormal, False, nil, nil, wbActorTemplateUseFactions),\n wbFormIDCk(INAM, 'Death item', [LVLI], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(VTCK, 'Voice', [VTYP], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(TPLT, 'Template', [CREA, LVLC]),\n wbDESTActor,\n wbSCRIActor,\n wbRArrayS('Items', wbCNTO, cpNormal, False, nil, nil, wbActorTemplateUseInventory),\n wbAIDT,\n wbRArray('Packages', wbFormIDCk(PKID, 'Package', [PACK]), cpNormal, False, nil, nil, wbActorTemplateUseAIPackages),\n wbArrayS(KFFZ, 'Animations', wbStringLC('Animation'), 0, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbStruct(DATA, '', [\n {00} wbInteger('Type', itU8, wbCreatureTypeEnum, cpNormal, False, wbActorTemplateUseTraits),\n {01} wbInteger('Combat Skill', itU8, nil, cpNormal, False, wbActorTemplateUseStats),\n {02} wbInteger('Magic Skill', itU8, nil, cpNormal, False, wbActorTemplateUseStats),\n {03} wbInteger('Stealth Skill', itU8, nil, cpNormal, False, wbActorTemplateUseStats),\n {04} wbInteger('Health', itS16, nil, cpNormal, False, wbActorTemplateUseStats),\n {06} wbByteArray('Unused', 2),\n {08} wbInteger('Damage', itS16, nil, cpNormal, False, wbActorTemplateUseStats),\n {10} wbArray('Attributes', wbInteger('Attribute', itU8), [\n 'Strength',\n 'Perception',\n 'Endurance',\n 'Charisma',\n 'Intelligence',\n 'Agility',\n 'Luck'\n ], cpNormal, False, wbActorTemplateUseStats)\n ], cpNormal, True),\n wbInteger(RNAM, 'Attack reach', itU8, nil, cpNormal, True, False, wbActorTemplateUseTraits),\n wbFormIDCk(ZNAM, 'Combat Style', [CSTY], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(PNAM, 'Body Part Data', [BPTD], False, cpNormal, True, wbActorTemplateUseModelAnimation),\n wbFloat(TNAM, 'Turning Speed', cpNormal, True, 1, -1, wbActorTemplateUseStats),\n wbFloat(BNAM, 'Base Scale', cpNormal, True, 1, -1, wbActorTemplateUseStats),\n wbFloat(WNAM, 'Foot Weight', cpNormal, True, 1, -1, wbActorTemplateUseStats),\n wbInteger(NAM4, 'Impact Material Type', itU32, wbImpactMaterialTypeEnum, cpNormal, True, False, wbActorTemplateUseModelAnimation),\n wbInteger(NAM5, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True, False, wbActorTemplateUseModelAnimation),\n wbFormIDCk(CSCR, 'Inherits Sounds from', [CREA], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbCSDTs,\n wbFormIDCk(CNAM, 'Impact Dataset', [IPDS], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbFormIDCk(LNAM, 'Melee Weapon List', [FLST], False, cpNormal, False, wbActorTemplateUseTraits)\n ], True);\n\nend;\n\nprocedure DefineFO3d;\nbegin\n wbRecord(CSTY, 'Combat Style', [\n wbEDIDReq,\n wbStruct(CSTD, 'Advanced - Standard', [\n {000}wbInteger('Maneuver Decision - Dodge % Chance', itU8),\n {001}wbInteger('Maneuver Decision - Left/Right % Chance', itU8),\n {002}wbByteArray('Unused', 2),\n {004}wbFloat('Maneuver Decision - Dodge L/R Timer (min)'),\n {008}wbFloat('Maneuver Decision - Dodge L/R Timer (max)'),\n {012}wbFloat('Maneuver Decision - Dodge Forward Timer (min)'),\n {016}wbFloat('Maneuver Decision - Dodge Forward Timer (max)'),\n {020}wbFloat('Maneuver Decision - Dodge Back Timer Min'),\n {024}wbFloat('Maneuver Decision - Dodge Back Timer Max'),\n {028}wbFloat('Maneuver Decision - Idle Timer min'),\n {032}wbFloat('Maneuver Decision - Idle Timer max'),\n {036}wbInteger('Melee Decision - Block % Chance', itU8),\n {037}wbInteger('Melee Decision - Attack % Chance', itU8),\n {038}wbByteArray('Unused', 2),\n {040}wbFloat('Melee Decision - Recoil/Stagger Bonus to Attack'),\n {044}wbFloat('Melee Decision - Unconscious Bonus to Attack'),\n {048}wbFloat('Melee Decision - Hand-To-Hand Bonus to Attack'),\n {052}wbInteger('Melee Decision - Power Attacks - Power Attack % Chance', itU8),\n {053}wbByteArray('Unused', 3),\n {056}wbFloat('Melee Decision - Power Attacks - Recoil/Stagger Bonus to Power'),\n {060}wbFloat('Melee Decision - Power Attacks - Unconscious Bonus to Power Attack'),\n {064}wbInteger('Melee Decision - Power Attacks - Normal', itU8),\n {065}wbInteger('Melee Decision - Power Attacks - Forward', itU8),\n {066}wbInteger('Melee Decision - Power Attacks - Back', itU8),\n {067}wbInteger('Melee Decision - Power Attacks - Left', itU8),\n {068}wbInteger('Melee Decision - Power Attacks - Right', itU8),\n {069}wbByteArray('Unused', 3),\n {072}wbFloat('Melee Decision - Hold Timer (min)'),\n {076}wbFloat('Melee Decision - Hold Timer (max)'),\n {080}wbInteger('Flags', itU16, wbFlags([\n 'Choose Attack using % Chance',\n 'Melee Alert OK',\n 'Flee Based on Personal Survival',\n '',\n 'Ignore Threats',\n 'Ignore Damaging Self',\n 'Ignore Damaging Group',\n 'Ignore Damaging Spectators',\n 'Cannot Use Stealthboy'\n ])),\n {082}wbByteArray('Unused', 2),\n {085}wbInteger('Maneuver Decision - Acrobatic Dodge % Chance', itU8),\n {085}wbInteger('Melee Decision - Power Attacks - Rushing Attack % Chance', itU8),\n {086}wbByteArray('Unused', 2),\n {088}wbFloat('Melee Decision - Power Attacks - Rushing Attack Distance Mult')\n ], cpNormal, True),\n wbStruct(CSAD, 'Advanced - Advanced', [\n wbFloat('Dodge Fatigue Mod Mult'),\n wbFloat('Dodge Fatigue Mod Base'),\n wbFloat('Encumb. Speed Mod Base'),\n wbFloat('Encumb. Speed Mod Mult'),\n wbFloat('Dodge While Under Attack Mult'),\n wbFloat('Dodge Not Under Attack Mult'),\n wbFloat('Dodge Back While Under Attack Mult'),\n wbFloat('Dodge Back Not Under Attack Mult'),\n wbFloat('Dodge Forward While Attacking Mult'),\n wbFloat('Dodge Forward Not Attacking Mult'),\n wbFloat('Block Skill Modifier Mult'),\n wbFloat('Block Skill Modifier Base'),\n wbFloat('Block While Under Attack Mult'),\n wbFloat('Block Not Under Attack Mult'),\n wbFloat('Attack Skill Modifier Mult'),\n wbFloat('Attack Skill Modifier Base'),\n wbFloat('Attack While Under Attack Mult'),\n wbFloat('Attack Not Under Attack Mult'),\n wbFloat('Attack During Block Mult'),\n wbFloat('Power Att. Fatigue Mod Base'),\n wbFloat('Power Att. Fatigue Mod Mult')\n ], cpNormal, True),\n wbStruct(CSSD, 'Simple', [\n {00} wbFloat('Cover Search Radius'),\n {04} wbFloat('Take Cover Chance'),\n {08} wbFloat('Wait Timer (min)'),\n {12} wbFloat('Wait Timer (max)'),\n {16} wbFloat('Wait to Fire Timer (min)'),\n {20} wbFloat('Wait to Fire Timer (max)'),\n {24} wbFloat('Fire Timer (min)'),\n {28} wbFloat('Fire Timer (max)'),\n {32} wbFloat('Ranged Weapon Range Mult (min)'),\n {36} wbByteArray('Unused', 4),\n {40} wbInteger('Weapon Restrictions', itU32, wbEnum([\n 'None',\n 'Melee Only',\n 'Ranged Only'\n ])),\n {44} wbFloat('Ranged Weapon Range Mult (max)'),\n {48} wbFloat('Max Targeting FOV'),\n {52} wbFloat('Combat Radius'),\n {56} wbFloat('Semi-Auto Firing Delay Mult (min)'),\n {60} wbFloat('Semi-Auto Firing Delay Mult (max)')\n ], cpNormal, True)\n ]);\n\n wbRecord(DIAL, 'Dialog Topic', [\n wbEDIDReq,\n wbRArrayS('Quests', wbFormIDCkNoReach(QSTI, 'Quest', [QUST], False, cpBenign)),\n wbRArrayS('Quests?', wbFormIDCkNoReach(QSTR, 'Quest?', [QUST], False, cpBenign)),\n wbFULL,\n wbFloat(PNAM, 'Priority', cpNormal, True, 1, -1, nil, nil, 50.0),\n wbStruct(DATA, '', [\n wbInteger('Type', itU8, wbEnum([\n {0} 'Topic',\n {1} 'Conversation',\n {2} 'Combat',\n {3} 'Persuasion',\n {4} 'Detection',\n {5} 'Service',\n {6} 'Miscellaneous',\n {7} 'Radio'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Rumors',\n 'Top-level'\n ]))\n ], cpNormal, True, nil, 1)\n ], True);\n\n wbRecord(DOOR, 'Door', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbSCRI,\n wbDEST,\n wbFormIDCk(SNAM, 'Sound - Open', [SOUN]),\n wbFormIDCk(ANAM, 'Sound - Close', [SOUN]),\n wbFormIDCk(BNAM, 'Sound - Looping', [SOUN]),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n '',\n 'Automatic Door',\n 'Hidden',\n 'Minimal Use',\n 'Sliding Door'\n ]), cpNormal, True)\n ]);\n\n wbBlendModeEnum := wbEnum([\n '',\n 'Zero',\n 'One',\n 'Source Color',\n 'Source Inverse Color',\n 'Source Alpha',\n 'Source Inverted Alpha',\n 'Dest Alpha',\n 'Dest Inverted Alpha',\n 'Dest Color',\n 'Dest Inverse Color',\n 'Source Alpha SAT'\n ]);\n\n wbBlendOpEnum := wbEnum([\n '',\n 'Add',\n 'Subtract',\n 'Reverse Subtract',\n 'Minimum',\n 'Maximum'\n ]);\n wbZTestFuncEnum := wbEnum([\n '',\n '',\n '',\n 'Equal To',\n 'Normal',\n 'Greater Than',\n '',\n 'Greater Than or Equal Than',\n 'Always Show'\n ]);\n\n wbRecord(EFSH, 'Effect Shader', [\n wbEDID,\n wbString(ICON, 'Fill Texture'),\n wbString(ICO2, 'Particle Shader Texture'),\n wbString(NAM7, 'Holes Texture'),\n wbStruct(DATA, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0} 'No Membrane Shader',\n {1} '',\n {2} '',\n {3} 'No Particle Shader',\n {4} 'Edge Effect - Inverse',\n {5} 'Membrane Shader - Affect Skin Only'\n ])),\n wbByteArray('Unused', 3),\n wbInteger('Membrane Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Membrane Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Membrane Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbStruct('Fill/Texture Effect - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Fill/Texture Effect - Alpha Fade In Time'),\n wbFloat('Fill/Texture Effect - Full Alpha Time'),\n wbFloat('Fill/Texture Effect - Alpha Fade Out Time'),\n wbFloat('Fill/Texture Effect - Presistent Alpha Ratio'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Amplitude'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Frequency'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (U)'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (V)'),\n wbFloat('Edge Effect - Fall Off'),\n wbStruct('Edge Effect - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Edge Effect - Alpha Fade In Time'),\n wbFloat('Edge Effect - Full Alpha Time'),\n wbFloat('Edge Effect - Alpha Fade Out Time'),\n wbFloat('Edge Effect - Persistent Alpha Ratio'),\n wbFloat('Edge Effect - Alpha Pulse Amplitude'),\n wbFloat('Edge Effect - Alpha Pusle Frequence'),\n wbFloat('Fill/Texture Effect - Full Alpha Ratio'),\n wbFloat('Edge Effect - Full Alpha Ratio'),\n wbInteger('Membrane Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Particle Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Particle Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Particle Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbInteger('Particle Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbFloat('Particle Shader - Particle Birth Ramp Up Time'),\n wbFloat('Particle Shader - Full Particle Birth Time'),\n wbFloat('Particle Shader - Particle Birth Ramp Down Time'),\n wbFloat('Particle Shader - Full Particle Birth Ratio'),\n wbFloat('Particle Shader - Persistant Particle Birth Ratio'),\n wbFloat('Particle Shader - Particle Lifetime'),\n wbFloat('Particle Shader - Particle Lifetime +/-'),\n wbFloat('Particle Shader - Initial Speed Along Normal'),\n wbFloat('Particle Shader - Acceleration Along Normal'),\n wbFloat('Particle Shader - Initial Velocity #1'),\n wbFloat('Particle Shader - Initial Velocity #2'),\n wbFloat('Particle Shader - Initial Velocity #3'),\n wbFloat('Particle Shader - Acceleration #1'),\n wbFloat('Particle Shader - Acceleration #2'),\n wbFloat('Particle Shader - Acceleration #3'),\n wbFloat('Particle Shader - Scale Key 1'),\n wbFloat('Particle Shader - Scale Key 2'),\n wbFloat('Particle Shader - Scale Key 1 Time'),\n wbFloat('Particle Shader - Scale Key 2 Time'),\n wbStruct('Color Key 1 - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Color Key 2 - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Color Key 3 - Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Color Key 1 - Color Alpha'),\n wbFloat('Color Key 2 - Color Alpha'),\n wbFloat('Color Key 3 - Color Alpha'),\n wbFloat('Color Key 1 - Color Key Time'),\n wbFloat('Color Key 2 - Color Key Time'),\n wbFloat('Color Key 3 - Color Key Time'),\n wbFloat('Particle Shader - Initial Speed Along Normal +/-'),\n wbFloat('Particle Shader - Initial Rotation (deg)'),\n wbFloat('Particle Shader - Initial Rotation (deg) +/-'),\n wbFloat('Particle Shader - Rotation Speed (deg/sec)'),\n wbFloat('Particle Shader - Rotation Speed (deg/sec) +/-'),\n wbFormIDCk('Addon Models', [DEBR, NULL]),\n wbFloat('Holes - Start Time'),\n wbFloat('Holes - End Time'),\n wbFloat('Holes - Start Val'),\n wbFloat('Holes - End Val'),\n wbFloat('Edge Width (alpha units)'),\n wbStruct('Edge Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Explosion Wind Speed'),\n wbInteger('Texture Count U', itU32),\n wbInteger('Texture Count V', itU32),\n wbFloat('Addon Models - Fade In Time'),\n wbFloat('Addon Models - Fade Out Time'),\n wbFloat('Addon Models - Scale Start'),\n wbFloat('Addon Models - Scale End'),\n wbFloat('Addon Models - Scale In Time'),\n wbFloat('Addon Models - Scale Out Time')\n ], cpNormal, True, nil, 57)\n ], False, nil, cpNormal, False, wbEFSHAfterLoad);\n\n wbRecord(ENCH, 'Object Effect', [\n wbEDIDReq,\n wbFULL,\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Type', itU32, wbEnum([\n {0} '',\n {1} '',\n {2} 'Weapon',\n {3} 'Apparel'\n ])),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbInteger('Flags', itU8, wbFlags([\n 'No Auto-Calc',\n '',\n 'Hide Effect'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(EYES, 'Eyes', [\n wbEDIDReq,\n wbFULLReq,\n wbString(ICON, 'Texture', 0{, cpNormal, True??}),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Playable',\n 'Not Male',\n 'Not Female'\n ]), cpNormal, True)\n ]);\n\n wbXNAM :=\n wbStructSK(XNAM, [0], 'Relation', [\n wbFormIDCkNoReach('Faction', [FACT, RACE]),\n wbInteger('Modifier', itS32),\n wbInteger('Group Combat Reaction', itU32, wbEnum([\n 'Neutral',\n 'Enemy',\n 'Ally',\n 'Friend'\n ]))\n ]);\n\n wbXNAMs := wbRArrayS('Relations', wbXNAM);\n\n wbRecord(FACT, 'Faction', [\n wbEDIDReq,\n wbFULL,\n wbXNAMs,\n wbStruct(DATA, '', [\n wbInteger('Flags 1', itU8, wbFlags([\n 'Hidden from PC',\n 'Evil',\n 'Special Combat'\n ])),\n wbInteger('Flags 2', itU8, wbFlags([\n 'Track Crime',\n 'Allow Sell'\n ])),\n wbByteArray('Unused', 2)\n ], cpNormal, True, nil, 1),\n wbFloat(CNAM, 'Unused'),\n wbRStructsSK('Ranks', 'Rank', [0], [\n wbInteger(RNAM, 'Rank#', itS32),\n wbString(MNAM, 'Male', 0, cpTranslate),\n wbString(FNAM, 'Female', 0, cpTranslate),\n wbString(INAM, 'Insignia (Unused)')\n ], [])\n ], False, nil, cpNormal, False, wbFACTAfterLoad);\n\n wbRecord(FURN, 'Furniture', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbSCRI,\n wbDEST,\n wbByteArray(MNAM, 'Marker Flags', 0, cpNormal, True)\n ]);\n\n wbRecord(GLOB, 'Global', [\n wbEDIDReq,\n wbInteger(FNAM, 'Type', itU8, wbGLOBFNAM, nil, cpNormal, True),\n wbFloat(FLTV, 'Value', cpNormal, True)\n ]);\n\n\n wbRecord(GMST, 'Game Setting', [\n wbString(EDID, 'Editor ID', 0, cpCritical, True, nil, wbGMSTEDIDAfterSet),\n wbUnion(DATA, 'Value', wbGMSTUnionDecider, [\n wbString('', 0, cpTranslate),\n wbInteger('', itS32),\n wbFloat('')\n ], cpNormal, True)\n ]);\n\n wbDODT := wbStruct(DODT, 'Decal Data', [\n wbFloat('Min Width'),\n wbFloat('Max Width'),\n wbFloat('Min Height'),\n wbFloat('Max Height'),\n wbFloat('Depth'),\n wbFloat('Shininess'),\n wbStruct('Parallax', [\n wbFloat('Scale'),\n wbInteger('Passes', itU8)\n ]),\n wbInteger('Flags', itU8, wbFlags([\n 'Parallax',\n 'Alpha - Blending',\n 'Alpha - Testing'\n ], True)),\n wbByteArray('Unused', 2),\n wbStruct('Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]);\n\n wbRecord(TXST, 'Texture Set', [\n wbEDIDReq,\n wbOBNDReq,\n wbRStruct('Textures (RGB/A)', [\n wbString(TX00,'Base Image / Transparency'),\n wbString(TX01,'Normal Map / Specular'),\n wbString(TX02,'Environment Map Mask / ?'),\n wbString(TX03,'Glow Map / Unused'),\n wbString(TX04,'Parallax Map / Unused'),\n wbString(TX05,'Environment Map / Unused')\n ], []),\n wbDODT,\n wbInteger(DNAM, 'Flags', itU16, wbFlags([\n 'No Specular Map'\n ]), cpNormal, True)\n ]);\n\n wbRecord(MICN, 'Menu Icon', [\n wbEDIDReq,\n wbICONReq\n ]);\n\n wbRecord(HDPT, 'Head Part', [\n wbEDIDReq,\n wbFULLReq,\n wbMODL,\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Playable'\n ]), cpNormal, True),\n wbRArrayS('Extra Parts',\n wbFormIDCk(HNAM, 'Part', [HDPT])\n )\n ]);\n\n wbRecord(ASPC, 'Acoustic Space', [\n wbEDIDReq,\n wbOBNDReq,\n wbFormIDCk(SNAM, 'Sound - Looping', [SOUN]),\n wbFormIDCk(RDAT, 'Use Sound from Region (Interiors Only)', [REGN]),\n wbInteger(ANAM, 'Environment Type', itU32, wbEnum([\n 'None',\n 'Default',\n 'Generic',\n 'Padded Cell',\n 'Room',\n 'Bathroom',\n 'Livingroom',\n 'Stone Room',\n 'Auditorium',\n 'Concerthall',\n 'Cave',\n 'Arena',\n 'Hangar',\n 'Carpeted Hallway',\n 'Hallway',\n 'Stone Corridor',\n 'Alley',\n 'Forest',\n 'City',\n 'Mountains',\n 'Quarry',\n 'Plain',\n 'Parkinglot',\n 'Sewerpipe',\n 'Underwater',\n 'Small Room',\n 'Medium Room',\n 'Large Room',\n 'Medium Hall',\n 'Large Hall',\n 'Plate'\n ]), cpNormal, True)\n ]);\n\n wbRecord(TACT, 'Talking Activator', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbSCRI,\n wbDEST,\n wbFormIDCk(SNAM, 'Sound', [SOUN]),\n wbFormIDCk(VNAM, 'Voice Type', [VTYP])\n ]);\n\n wbRecord(SCPT, 'Script', [\n wbEDIDReq,\n wbSCHRReq,\n wbByteArray(SCDA, 'Compiled Script'),\n wbStringScript(SCTX, 'Script Source', 0, cpNormal{, True}),\n wbRArrayS('Local Variables', wbRStructSK([0], 'Local Variable', [\n wbSLSD,\n wbString(SCVR, 'Name', 0, cpCritical, True)\n ], [])),\n wbSCROs\n ]);\n\n wbRecord(TERM, 'Terminal', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbSCRI,\n wbDEST,\n wbDESCReq,\n wbFormIDCk(SNAM, 'Sound - Looping', [SOUN]),\n wbFormIDCk(PNAM, 'Password Note', [NOTE]),\n wbStruct(DNAM, '', [\n wbInteger('Base Hacking Difficulty', itU8, wbEnum([\n 'Very Easy',\n 'Easy',\n 'Average',\n 'Hard',\n 'Very Hard',\n 'Requires Key'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Leveled',\n 'Unlocked',\n 'Alternate Colors',\n 'Hide Welcome Text when displaying Image'\n ])),\n wbInteger('ServerType', itU8, wbEnum([\n '-Server 1-',\n '-Server 2-',\n '-Server 3-',\n '-Server 4-',\n '-Server 5-',\n '-Server 6-',\n '-Server 7-',\n '-Server 8-',\n '-Server 9-',\n '-Server 10-'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbRArray('Menu Items',\n wbRStruct('Menu Item', [\n wbString(ITXT, 'Item Text'),\n wbString(RNAM, 'Result Text', 0, cpNormal, True),\n wbInteger(ANAM, 'Flags', itU8, wbFlags([\n 'Add Note',\n 'Force Redraw'\n ]), cpNormal, True),\n wbFormIDCk(INAM, 'Display Note', [NOTE]),\n wbFormIDCk(TNAM, 'Sub Menu', [TERM]),\n wbEmbeddedScriptReq,\n wbCTDAs\n ], [])\n )\n ]);\n\n wbRecord(SCOL, 'Static Collection', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbRStructsSK('Parts', 'Part', [0], [\n wbFormIDCk(ONAM, 'Static', [STAT]),\n wbArrayS(DATA, 'Placements', wbStruct('Placement', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ]),\n wbFloat('Scale')\n ]), 0, cpNormal, True)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(MSTT, 'Moveable Static', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbDEST,\n wbByteArray(DATA, 'Unknown', 1, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN])\n ]);\n\n wbRecord(PWAT, 'Placeable Water', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbStruct(DNAM, '', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001}'Reflects',\n {0x00000002}'Reflects - Actors',\n {0x00000004}'Reflects - Land',\n {0x00000008}'Reflects - LOD Land',\n {0x00000010}'Reflects - LOD Buildings',\n {0x00000020}'Reflects - Trees',\n {0x00000040}'Reflects - Sky',\n {0x00000080}'Reflects - Dynamic Objects',\n {0x00000100}'Reflects - Dead Bodies',\n {0x00000200}'Refracts',\n {0x00000400}'Refracts - Actors',\n {0x00000800}'Refracts - Land',\n {0x00001000}'',\n {0x00002000}'',\n {0x00004000}'',\n {0x00008000}'',\n {0x00010000}'Refracts - Dynamic Objects',\n {0x00020000}'Refracts - Dead Bodies',\n {0x00040000}'Silhouette Reflections',\n {0x00080000}'',\n {0x00100000}'',\n {0x00200000}'',\n {0x00400000}'',\n {0x00800000}'',\n {0x01000000}'',\n {0x02000000}'',\n {0x03000000}'',\n {0x08000000}'',\n {0x10000000}'Depth',\n {0x20000000}'Object Texture Coordinates',\n {0x40000000}'',\n {0x80000000}'No Underwater Fog'\n ])),\n wbFormIDCk('Water', [WATR])\n ], cpNormal, True)\n ]);\n\n wbRecord(IDLM, 'Idle Marker', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(IDLF, 'Flags', itU8, wbFlags([\n 'Run in Sequence',\n '',\n 'Do Once'\n ]), cpNormal, True),\n wbStruct(IDLC, '', [\n wbInteger('Animation Count', itU8),\n wbByteArray('Unused', 3)\n ], cpNormal, True, nil, 1),\n wbFloat(IDLT, 'Idle Timer Setting', cpNormal, True),\n wbArray(IDLA, 'Animations', wbFormIDCk('Animation', [IDLE, NULL]), 0, nil, wbIDLAsAfterSet, cpNormal, True) // NULL looks valid if IDLS\\Animation Count is 0\n ], False, nil, cpNormal, False, nil, wbAnimationsAfterSet);\n\n wbRecord(NOTE, 'Note', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbYNAM,\n wbZNAM,\n wbInteger(DATA, 'Type', itU8, wbEnum([\n 'Sound',\n 'Text',\n 'Image',\n 'Voice'\n ]), cpNormal, True),\n wbRArrayS('Quests',\n wbFormIDCkNoReach(ONAM, 'Quest', [QUST])\n ),\n wbString(XNAM, 'Texture'),\n wbUnion(TNAM, 'Text / Topic', wbNOTETNAMDecide, [\n wbString('Text'),\n wbFormIDCk('Topic', [DIAL])\n ]),\n wbUnion(SNAM, 'Sound / NPC', wbNOTESNAMDecide, [\n wbFormIDCk('Sound', [SOUN]),\n wbFormIDCk('NPC', [NPC_])\n ])\n ]);\n\nend;\n\nprocedure DefineFO3e;\nbegin\n wbRecord(PROJ, 'Projectile', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODLReq,\n wbDEST,\n wbStruct(DATA, 'Data', [\n {00} wbInteger('Flags', itU16, wbFlags([\n 'Hitscan',\n 'Explosion',\n 'Alt. Trigger',\n 'Muzzle Flash',\n '',\n 'Can Be Disabled',\n 'Can Be Picked Up',\n 'Supersonic',\n 'Pins Limbs',\n 'Pass Through Small Transparent'\n ])),\n {00} wbInteger('Type', itU16, wbEnum([\n {00} '',\n {01} 'Missile',\n {02} 'Lobber',\n {03} '',\n {04} 'Beam',\n {05} '',\n {06} '',\n {07} '',\n {08} 'Flame'\n ])),\n {04} wbFloat('Gravity'),\n {08} wbFloat('Speed'),\n {12} wbFloat('Range'),\n {16} wbFormIDCk('Light', [LIGH, NULL]),\n {20} wbFormIDCk('Muzzle Flash - Light', [LIGH, NULL]),\n {24} wbFloat('Tracer Chance'),\n {28} wbFloat('Explosion - Alt. Trigger - Proximity'),\n {32} wbFloat('Explosion - Alt. Trigger - Timer'),\n {36} wbFormIDCk('Explosion', [EXPL, NULL]),\n {40} wbFormIDCk('Sound', [SOUN, NULL]),\n {44} wbFloat('Muzzle Flash - Duration'),\n {48} wbFloat('Fade Duration'),\n {52} wbFloat('Impact Force'),\n {56} wbFormIDCk('Sound - Countdown', [SOUN, NULL]),\n {60} wbFormIDCk('Sound - Disable', [SOUN, NULL]),\n {64} wbFormIDCk('Default Weapon Source', [WEAP, NULL])\n ], cpNormal, True),\n wbRStructSK([0], 'Muzzle Flash Model', [\n wbString(NAM1, 'Model Filename'),\n wbByteArray(NAM2, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, True),\n wbInteger(VNAM, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ]);\n\n wbRecord(NAVI, 'Navigation Mesh Info Map', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbRArray('Navigation Map Infos',\n wbStruct(NVMI, 'Navigation Map Info', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbFormIDCk('Location', [CELL, WRLD]),\n wbStruct('Grid', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbUnknown\n{ wbUnion('Data', wbNAVINVMIDecider, [\n wbStruct('Data', [\n wbUnknown\n ]),\n wbStruct('Data', [\n wbArray('Unknown', wbFloat('Unknown'), 3),\n wbByteArray('Unknown', 4)\n ]),\n wbStruct('Data', [\n wbArray('Unknown', wbArray('Unknown', wbFloat('Unknown'), 3), 3),\n wbInteger('Count 1', itU16),\n wbInteger('Count 2', itU16),\n wbArray('Unknown', wbArray('Unknown', wbFloat('Unknown'), 3), [], wbNAVINAVMGetCount1),\n wbUnknown\n ]),\n wbStruct('Data', [\n wbUnknown\n ])\n ])}\n ])\n ),\n wbRArray('Unknown',\n wbStruct(NVCI, 'Unknown', [\n wbFormIDCk('Unknown', [NAVM]),\n wbArray('Unknown', wbFormIDCk('Unknown', [NAVM]), -1),\n wbArray('Unknown', wbFormIDCk('Unknown', [NAVM]), -1),\n wbArray('Doors', wbFormIDCk('Door', [REFR]), -1)\n ])\n )\n ]);\n\n if wbSimpleRecords then begin\n\n wbRecord(NAVM, 'Navigation Mesh', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbStruct(DATA, '', [\n wbFormIDCk('Cell', [CELL]),\n wbInteger('Vertex Count', itU32),\n wbInteger('Triangle Count', itU32),\n wbInteger('External Connections Count', itU32),\n wbInteger('NVCA Count', itU32),\n wbInteger('Doors Count', itU32)\n ]),\n wbByteArray(NVVX, 'Vertices'),\n wbByteArray(NVTR, 'Triangles'),\n wbByteArray(NVCA, 'Unknown'),\n wbArray(NVDP, 'Doors', wbStruct('Door', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Triangle', itU16),\n wbByteArray('Unused', 2)\n ])),\n wbByteArray(NVGD, 'Unknown'),\n wbArray(NVEX, 'External Connections', wbStruct('Connection', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Navigation Mesh', [NAVM], False, cpNormal),\n wbInteger('Triangle', itU16, nil, cpNormal)\n ]))\n ], False, wbNAVMAddInfo);\n\n end else begin\n\n wbRecord(NAVM, 'Navigation Mesh', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbStruct(DATA, '', [\n wbFormIDCk('Cell', [CELL]),\n wbInteger('Vertex Count', itU32),\n wbInteger('Triangle Count', itU32),\n wbInteger('External Connections Count', itU32),\n wbInteger('NVCA Count', itU32),\n wbInteger('Doors Count', itU32) // as of version = 5 (earliest NavMesh version I saw (Fallout3 1.7) is already 11)\n ]),\n wbArray(NVVX, 'Vertices', wbStruct('Vertex', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ])),\n wbArray(NVTR, 'Triangles', wbStruct('Triangle', [\n wbArray('Vertices', wbInteger('Vertex', itS16), 3),\n wbArray('Edges', wbInteger('Triangle', itS16, wbNVTREdgeToStr, wbNVTREdgeToInt), [\n '0 <-> 1',\n '1 <-> 2',\n '2 <-> 0'\n ]),\n wbInteger('Flags', itU32, wbFlags([\n 'Triangle #0 Is External',\n 'Triangle #1 Is External',\n 'Triangle #2 Is External',\n 'Unknown 4',\n 'Unknown 5',\n 'Unknown 6',\n 'Unknown 7',\n 'Unknown 8',\n 'Unknown 9',\n 'Unknown 10',\n 'Unknown 11',\n 'Unknown 12',\n 'Unknown 13',\n 'Unknown 14',\n 'Unknown 15',\n 'Unknown 16',\n 'Unknown 17',\n 'Unknown 18',\n 'Unknown 19',\n 'Unknown 20',\n 'Unknown 21',\n 'Unknown 22',\n 'Unknown 23',\n 'Unknown 24',\n 'Unknown 25',\n 'Unknown 26',\n 'Unknown 27',\n 'Unknown 28',\n 'Unknown 29',\n 'Unknown 30',\n 'Unknown 31',\n 'Unknown 32'\n ]))\n ])),\n wbArray(NVCA, 'Unknown', wbInteger('Unknown', itS16)),\n wbArray(NVDP, 'Doors', wbStruct('Door', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Triangle', itU16),\n wbByteArray('Unused', 2)\n ])),\n wbStruct(NVGD, 'Unknown', [\n wbByteArray('Unknown', 4),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbArray('Unknown', wbArray('Unknown', wbInteger('Unknown', itU16), -2))\n ]),\n wbArray(NVEX, 'External Connections', wbStruct('Connection', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Navigation Mesh', [NAVM], False, cpNormal),\n wbInteger('Triangle', itU16, nil, cpNormal)\n ]))\n ], False, wbNAVMAddInfo);\n\n end;\n\n wbRecord(PGRE, 'Placed Grenade', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [PROJ], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(PMIS, 'Placed Missile', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [PROJ], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(PBEA, 'Placed Beam', [\n wbEDID,\n wbFormIDCk(NAME, 'Base', [PROJ], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo);\n\n wbRecord(EXPL, 'Explosion', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbEITM,\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD]),\n wbStruct(DATA, 'Data', [\n {00} wbFloat('Force'),\n {04} wbFloat('Damage'),\n {08} wbFloat('Radius'),\n {12} wbFormIDCk('Light', [LIGH, NULL]),\n {16} wbFormIDCk('Sound 1', [SOUN, NULL]),\n {20} wbInteger('Flags', itU32, wbFlags([\n {0x00000001}'Unknown 1',\n {0x00000002}'Always Uses World Orientation',\n {0x00000004}'Knock Down - Always',\n {0x00000008}'Knock Down - By Formula',\n {0x00000010}'Ignore LOS Check',\n {0x00000020}'Push Explosion Source Ref Only',\n {0x00000040}'Ignore Image Space Swap'\n ])),\n {24} wbFloat('IS Radius'),\n {28} wbFormIDCk('Impact DataSet', [IPDS, NULL]),\n {32} wbFormIDCk('Sound 2', [SOUN, NULL]),\n wbStruct('Radiation', [\n {36} wbFloat('Level'),\n {40} wbFloat('Dissipation Time'),\n {44} wbFloat('Radius')\n ]),\n {48} wbInteger('Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ], cpNormal, True),\n wbFormIDCk(INAM, 'Placed Impact Object', [TREE, SOUN, ACTI, DOOR, STAT, FURN,\n CONT, ARMO, AMMO, LVLN, LVLC, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS,\n ASPC, IDLM, ARMA, MSTT, NOTE, PWAT, SCOL, TACT, TERM, TXST])\n ]);\n\n wbRecord(DEBR, 'Debris', [\n wbEDIDReq,\n wbRStructs('Models', 'Model', [\n wbStruct(DATA, 'Data', [\n wbInteger('Percentage', itU8),\n wbString('Model Filename'),\n wbInteger('Flags', itU8, wbFlags([\n 'Has Collission Data'\n ]))\n ], cpNormal, True),\n wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(IMGS, 'Image Space', [\n wbEDIDReq,\n wbStruct(DNAM, '', [\n wbStruct('HDR', [\n {00} wbFloat('Eye Adapt Speed'),\n {04} wbFloat('Blur Radius'),\n {08} wbFloat('Blur Passes'),\n {12} wbFloat('Emissive Mult'),\n {16} wbFloat('Target LUM'),\n {20} wbFloat('Upper LUM Clamp'),\n {24} wbFloat('Bright Scale'),\n {28} wbFloat('Bright Clamp'),\n {32} wbFloat('LUM Ramp No Tex'),\n {36} wbFloat('LUM Ramp Min'),\n {40} wbFloat('LUM Ramp Max'),\n {44} wbFloat('Sunlight Dimmer'),\n {48} wbFloat('Grass Dimmer'),\n {52} wbFloat('Tree Dimmer'),\n {56} wbUnion('Skin Dimmer', wbIMGSSkinDimmerDecider, [\n wbFloat('Skin Dimmer'),\n wbEmpty('Skin Dimmer', cpIgnore)\n ])\n ], cpNormal, False, nil, 14),\n wbStruct('Bloom', [\n {60} wbFloat('Blur Radius'),\n {64} wbFloat('Alpha Mult Interior'),\n {68} wbFloat('Alpha Mult Exterior')\n ]),\n wbStruct('Get Hit', [\n {72} wbFloat('Blur Radius'),\n {76} wbFloat('Blur Damping Constant'),\n {80} wbFloat('Damping Constant')\n ]),\n wbStruct('Night Eye', [\n wbStruct('Tint Color', [\n {84} wbFloat('Red', cpNormal, False, 255, 0),\n {88} wbFloat('Green', cpNormal, False, 255, 0),\n {92} wbFloat('Blue', cpNormal, False, 255, 0)\n ]),\n {96} wbFloat('Brightness')\n ]),\n wbStruct('Cinematic', [\n {100} wbFloat('Saturation'),\n wbStruct('Contrast', [\n {104} wbFloat('Avg Lum Value'),\n {108} wbFloat('Value')\n ]),\n {112} wbFloat('Cinematic - Brightness - Value'),\n wbStruct('Tint', [\n wbStruct('Color', [\n {116} wbFloat('Red', cpNormal, False, 255, 0),\n {120} wbFloat('Green', cpNormal, False, 255, 0),\n {124} wbFloat('Blue', cpNormal, False, 255, 0)\n ]),\n {128} wbFloat('Value')\n ])\n ]),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbByteArray('Unused', 4),\n wbInteger('Flags', itU8, wbFlags([\n 'Saturation',\n 'Contrast',\n 'Tint',\n 'Brightness'\n ], True)),\n wbByteArray('Unused', 3)\n ], cpNormal, True, nil, 5)\n ]);\n\n wbTimeInterpolator := wbStruct('Data', [\n wbFloat('Time'),\n wbFloat('Value')\n ]);\n\n wbColorInterpolator := wbStruct('Data', [\n wbFloat('Time'),\n wbFloat('Red', cpNormal, False, 255, 0),\n wbFloat('Green', cpNormal, False, 255, 0),\n wbFloat('Blue', cpNormal, False, 255, 0),\n wbFloat('Alpha', cpNormal, False, 255, 0)\n ]);\n\n wbRecord(IMAD, 'Image Space Adapter', [\n wbEDID,\n wbStruct(DNAM, 'Data Count', [\n wbInteger('Flags', itU32, wbFlags(['Animatable'])),\n wbFloat('Duration'),\n wbStruct('HDR', [\n wbInteger('Eye Adapt Speed Mult', itU32),\n wbInteger('Eye Adapt Speed Add', itU32),\n wbInteger('Bloom Blur Radius Mult', itU32),\n wbInteger('Bloom Blur Radius Add', itU32),\n wbInteger('Bloom Threshold Mult', itU32),\n wbInteger('Bloom Threshold Add', itU32),\n wbInteger('Bloom Scale Mult', itU32),\n wbInteger('Bloom Scale Add', itU32),\n wbInteger('Target Lum Min Mult', itU32),\n wbInteger('Target Lum Min Add', itU32),\n wbInteger('Target Lum Max Mult', itU32),\n wbInteger('Target Lum Max Add', itU32),\n wbInteger('Sunlight Scale Mult', itU32),\n wbInteger('Sunlight Scale Add', itU32),\n wbInteger('Sky Scale Mult', itU32),\n wbInteger('Sky Scale Add', itU32)\n ]),\n wbInteger('Unknown08 Mult', itU32),\n wbInteger('Unknown48 Add', itU32),\n wbInteger('Unknown09 Mult', itU32),\n wbInteger('Unknown49 Add', itU32),\n wbInteger('Unknown0A Mult', itU32),\n wbInteger('Unknown4A Add', itU32),\n wbInteger('Unknown0B Mult', itU32),\n wbInteger('Unknown4B Add', itU32),\n wbInteger('Unknown0C Mult', itU32),\n wbInteger('Unknown4C Add', itU32),\n wbInteger('Unknown0D Mult', itU32),\n wbInteger('Unknown4D Add', itU32),\n wbInteger('Unknown0E Mult', itU32),\n wbInteger('Unknown4E Add', itU32),\n wbInteger('Unknown0F Mult', itU32),\n wbInteger('Unknown4F Add', itU32),\n wbInteger('Unknown10 Mult', itU32),\n wbInteger('Unknown50 Add', itU32),\n wbStruct('Cinematic', [\n wbInteger('Saturation Mult', itU32),\n wbInteger('Saturation Add', itU32),\n wbInteger('Brightness Mult', itU32),\n wbInteger('Brightness Add', itU32),\n wbInteger('Contrast Mult', itU32),\n wbInteger('Contrast Add', itU32)\n ]),\n wbInteger('Unknown14 Mult', itU32),\n wbInteger('Unknown54 Add', itU32),\n wbInteger('Tint Color', itU32),\n wbInteger('Blur Radius', itU32),\n wbInteger('Double Vision Strength', itU32),\n wbInteger('Radial Blur Strength', itU32),\n wbInteger('Radial Blur Ramp Up', itU32),\n wbInteger('Radial Blur Start', itU32),\n wbInteger('Radial Blur Flags', itU32, wbFlags(['Use Target'])),\n wbFloat('Radial Blur Center X'),\n wbFloat('Radial Blur Center Y'),\n wbInteger('DoF Strength', itU32),\n wbInteger('DoF Distance', itU32),\n wbInteger('DoF Range', itU32),\n wbInteger('DoF Flags', itU32, wbFlags(['Use Target'])),\n wbInteger('Radial Blur Ramp Down', itU32),\n wbInteger('Radial Blur Down Start', itU32),\n wbInteger('Fade Color', itU32),\n wbInteger('Motion Blur Strength', itU32)\n ], cpNormal, True, nil, 26),\n wbArray(BNAM, 'Blur Radius', wbTimeInterpolator),\n wbArray(VNAM, 'Double Vision Strength', wbTimeInterpolator),\n wbArray(TNAM, 'Tint Color', wbColorInterpolator),\n wbArray(NAM3, 'Fade Color', wbColorInterpolator),\n wbArray(RNAM, 'Radial Blur Strength', wbTimeInterpolator),\n wbArray(SNAM, 'Radial Blur Ramp Up', wbTimeInterpolator),\n wbArray(UNAM, 'Radial Blur Start', wbTimeInterpolator),\n wbArray(NAM1, 'Radial Blur Ramp Down', wbTimeInterpolator),\n wbArray(NAM2, 'Radial Blur Down Start', wbTimeInterpolator),\n wbArray(WNAM, 'DoF Strength', wbTimeInterpolator),\n wbArray(XNAM, 'DoF Distance', wbTimeInterpolator),\n wbArray(YNAM, 'DoF Range', wbTimeInterpolator),\n wbArray(NAM4, 'Motion Blur Strength', wbTimeInterpolator),\n wbRStruct('HDR', [\n wbArray(_00_IAD, 'Eye Adapt Speed Mult', wbTimeInterpolator),\n wbArray(_40_IAD, 'Eye Adapt Speed Add', wbTimeInterpolator),\n wbArray(_01_IAD, 'Bloom Blur Radius Mult', wbTimeInterpolator),\n wbArray(_41_IAD, 'Bloom Blur Radius Add', wbTimeInterpolator),\n wbArray(_02_IAD, 'Bloom Threshold Mult', wbTimeInterpolator),\n wbArray(_42_IAD, 'Bloom Threshold Add', wbTimeInterpolator),\n wbArray(_03_IAD, 'Bloom Scale Mult', wbTimeInterpolator),\n wbArray(_43_IAD, 'Bloom Scale Add', wbTimeInterpolator),\n wbArray(_04_IAD, 'Target Lum Min Mult', wbTimeInterpolator),\n wbArray(_44_IAD, 'Target Lum Min Add', wbTimeInterpolator),\n wbArray(_05_IAD, 'Target Lum Max Mult', wbTimeInterpolator),\n wbArray(_45_IAD, 'Target Lum Max Add', wbTimeInterpolator),\n wbArray(_06_IAD, 'Sunlight Scale Mult', wbTimeInterpolator),\n wbArray(_46_IAD, 'Sunlight Scale Add', wbTimeInterpolator),\n wbArray(_07_IAD, 'Sky Scale Mult', wbTimeInterpolator),\n wbArray(_47_IAD, 'Sky Scale Add', wbTimeInterpolator)\n ], []),\n wbUnknown(_08_IAD),\n wbUnknown(_48_IAD),\n wbUnknown(_09_IAD),\n wbUnknown(_49_IAD),\n wbUnknown(_0A_IAD),\n wbUnknown(_4A_IAD),\n wbUnknown(_0B_IAD),\n wbUnknown(_4B_IAD),\n wbUnknown(_0C_IAD),\n wbUnknown(_4C_IAD),\n wbUnknown(_0D_IAD),\n wbUnknown(_4D_IAD),\n wbUnknown(_0E_IAD),\n wbUnknown(_4E_IAD),\n wbUnknown(_0F_IAD),\n wbUnknown(_4F_IAD),\n wbUnknown(_10_IAD),\n wbUnknown(_50_IAD),\n wbRStruct('Cinematic', [\n wbArray(_11_IAD, 'Saturation Mult', wbTimeInterpolator),\n wbArray(_51_IAD, 'Saturation Add', wbTimeInterpolator),\n wbArray(_12_IAD, 'Brightness Mult', wbTimeInterpolator),\n wbArray(_52_IAD, 'Brightness Add', wbTimeInterpolator),\n wbArray(_13_IAD, 'Contrast Mult', wbTimeInterpolator),\n wbArray(_53_IAD, 'Contrast Add', wbTimeInterpolator)\n ], []),\n wbUnknown(_14_IAD),\n wbUnknown(_54_IAD)\n ]);\n\n wbRecord(FLST, 'FormID List', [\n wbString(EDID, 'Editor ID', 0, cpBenign, True, nil, wbFLSTEDIDAfterSet),\n wbRArrayS('FormIDs', wbFormID(LNAM, 'FormID'), cpNormal, False, nil, nil, nil, wbFLSTLNAMIsSorted)\n ]);\n\n wbRecord(PERK, 'Perk', [\n wbEDIDReq,\n wbFULL,\n wbDESCReq,\n wbICON,\n wbCTDAs,\n wbStruct(DATA, 'Data', [\n wbInteger('Trait', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Min Level', itU8),\n wbInteger('Ranks', itU8),\n wbInteger('Playable', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Hidden', itU8, wbEnum(['No', 'Yes']))\n ], cpNormal, True, nil, 4),\n wbRStructsSK('Effects', 'Effect', [0, 1], [\n wbStructSK(PRKE, [1, 2, 0], 'Header', [\n wbInteger('Type', itU8, wbEnum([\n 'Quest + Stage',\n 'Ability',\n 'Entry Point'\n ]), cpNormal, False, nil, wbPERKPRKETypeAfterSet),\n wbInteger('Rank', itU8),\n wbInteger('Priority', itU8)\n ]),\n wbUnion(DATA, 'Effect Data', wbPerkDATADecider, [\n wbStructSK([0, 1], 'Quest + Stage', [\n wbFormIDCk('Quest', [QUST]),\n wbInteger('Quest Stage', itU8, wbPerkDATAQuestStageToStr, wbCTDAParam2QuestStageToInt),\n wbByteArray('Unused', 3)\n ]),\n wbFormIDCk('Ability', [SPEL]),\n wbStructSK([0, 1], 'Entry Point', [\n wbInteger('Entry Point', itU8, wbEnum([\n {00} 'Calculate Weapon Damage',\n {01} 'Calculate My Critical Hit Chance',\n {02} 'Calculate My Critical Hit Damage',\n {03} 'Calculate Weapon Attack AP Cost',\n {04} 'Calculate Mine Explode Chance',\n {05} 'Adjust Range Penalty',\n {06} 'Adjust Limb Damage',\n {07} 'Calculate Weapon Range',\n {08} 'Calculate To Hit Chance',\n {09} 'Adjust Experience Points',\n {10} 'Adjust Gained Skill Points',\n {11} 'Adjust Book Skill Points',\n {12} 'Modify Recovered Health',\n {13} 'Calculate Inventory AP Cost',\n {14} 'Get Disposition',\n {15} 'Get Should Attack',\n {16} 'Get Should Assist',\n {17} 'Calculate Buy Price',\n {18} 'Get Bad Karma',\n {19} 'Get Good Karma',\n {20} 'Ignore Locked Terminal',\n {21} 'Add Leveled List On Death',\n {22} 'Get Max Carry Weight',\n {23} 'Modify Addiction Chance',\n {24} 'Modify Addiction Duration',\n {25} 'Modify Positive Chem Duration',\n {26} 'Adjust Drinking Radiation',\n {27} 'Activate',\n {28} 'Mysterious Stranger',\n {29} 'Has Paralyzing Palm',\n {30} 'Hacking Science Bonus',\n {31} 'Ignore Running During Detection',\n {32} 'Ignore Broken Lock',\n {33} 'Has Concentrated Fire',\n {34} 'Calculate Gun Spread',\n {35} 'Player Kill AP Reward',\n {36} 'Modify Enemy Critical Hit Chance'\n ]), cpNormal, True, nil, wbPERKEntryPointAfterSet),\n wbInteger('Function', itU8, wbPerkDATAFunctionToStr, wbPerkDATAFunctionToInt, cpNormal, False, nil, wbPerkDATAFunctionAfterSet),\n wbInteger('Perk Condition Tab Count', itU8, nil, cpIgnore)\n ])\n ], cpNormal, True),\n wbRStructsSK('Perk Conditions', 'Perk Condition', [0], [\n wbInteger(PRKC, 'Run On', itS8, wbPRKCToStr, wbPRKCToInt),\n wbCTDAsReq\n ], [], cpNormal, False, nil, nil, wbPERKPRKCDontShow),\n wbRStruct('Entry Point Function Parameters', [\n wbInteger(EPFT, 'Type', itU8, wbPerkEPFTToStr, wbPerkEPFTToInt, cpIgnore, False, nil, wbPerkEPFTAfterSet),\n wbUnion(EPFD, 'Data', wbEPFDDecider, [\n wbByteArray('Unknown'),\n wbFloat('Float'),\n wbStruct('Float, Float', [\n wbFloat('Float 1'),\n wbFloat('Float 2')\n ]),\n wbFormIDCk('Leveled Item', [LVLI]),\n wbEmpty('None (Script)'),\n wbStruct('Actor Value, Float', [\n wbInteger('Actor Value', itU32, wbEPFDActorValueToStr, wbEPFDActorValueToInt),\n wbFloat('Float')\n ])\n ], cpNormal, False, wbEPFDDontShow),\n wbString(EPF2, 'Button Label', 0, cpNormal, False, wbEPF2DontShow),\n wbInteger(EPF3, 'Script Flags', itU16, wbFlags([\n 'Run Immediately'\n ]), cpNormal, False, False, wbEPF2DontShow),\n wbEmbeddedScriptPerk\n ], [], cpNormal, False, wbPERKPRKCDontShow),\n wbEmpty(PRKF, 'End Marker', cpIgnore, True)\n ], [])\n ]);\n\n wbBPNDStruct := wbStruct(BPND, '', [\n {00} wbFloat('Damage Mult'),\n {04} wbInteger('Flags', itU8, wbFlags([\n 'Severable',\n 'IK Data',\n 'IK Data - Biped Data',\n 'Explodable',\n 'IK Data - Is Head',\n 'IK Data - Headtracking',\n 'To Hit Chance - Absolute'\n ])),\n {05} wbInteger('Part Type', itU8, wbEnum([\n 'Torso',\n 'Head 1',\n 'Head 2',\n 'Left Arm 1',\n 'Left Arm 2',\n 'Right Arm 1',\n 'Right Arm 2',\n 'Left Leg 1',\n 'Left Leg 2',\n 'Left Leg 3',\n 'Right Leg 1',\n 'Right Leg 2',\n 'Right Leg 3',\n 'Brain',\n 'Weapon'\n ])),\n {06} wbInteger('Health Percent', itU8),\n {07} wbInteger('Actor Value', itS8, wbActorValueEnum),\n {08} wbInteger('To Hit Chance', itU8),\n {09} wbInteger('Explodable - Explosion Chance %', itU8),\n {10} wbInteger('Explodable - Debris Count', itU16),\n {12} wbFormIDCk('Explodable - Debris', [DEBR, NULL]),\n {16} wbFormIDCk('Explodable - Explosion', [EXPL, NULL]),\n {20} wbFloat('Tracking Max Angle'),\n {24} wbFloat('Explodable - Debris Scale'),\n {28} wbInteger('Severable - Debris Count', itS32),\n {32} wbFormIDCk('Severable - Debris', [DEBR, NULL]),\n {36} wbFormIDCk('Severable - Explosion', [EXPL, NULL]),\n {40} wbFloat('Severable - Debris Scale'),\n wbStruct('Gore Effects Positioning', [\n wbStruct('Translate', [\n {44} wbFloat('X'),\n {48} wbFloat('Y'),\n {52} wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n {56} wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n {60} wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n {64} wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ]),\n {68} wbFormIDCk('Severable - Impact DataSet', [IPDS, NULL]),\n {72} wbFormIDCk('Explodable - Impact DataSet', [IPDS, NULL]),\n {28} wbInteger('Severable - Decal Count', itU8),\n {28} wbInteger('Explodable - Decal Count', itU8),\n {76} wbByteArray('Unused', 2),\n {80} wbFloat('Limb Replacement Scale')\n ], cpNormal, True);\n\n wbRecord(BPTD, 'Body Part Data', [\n wbEDIDReq,\n wbMODLReq,\n wbRStructS('Body Parts', 'Body Part', [\n wbString(BPTN, 'Part Name', 0, cpNormal, True),\n wbString(BPNN, 'Part Node', 0, cpNormal, True),\n wbString(BPNT, 'VATS Target', 0, cpNormal, True),\n wbString(BPNI, 'IK Data - Start Node', 0, cpNormal, True),\n wbBPNDStruct,\n wbString(NAM1, 'Limb Replacement Model', 0, cpNormal, True),\n wbString(NAM4, 'Gore Effects - Target Bone', 0, cpNormal, True),\n wbByteArray(NAM5, 'Texture Files Hashes', 0, cpIgnore)\n ], [], cpNormal, True),\n wbFormIDCk(RAGA, 'Ragdoll', [RGDL])\n ]);\n\n wbRecord(ADDN, 'Addon Node', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbInteger(DATA, 'Node Index', itS32, nil, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN]),\n wbStruct(DNAM, 'Data', [\n wbInteger('Master Particle System Cap', itU16),\n wbByteArray('Unknown', 2)\n ], cpNormal, True)\n ]);\n\n wbRecord(AVIF, 'ActorValue Information', [\n wbEDIDReq,\n wbFULL,\n wbDESCReq,\n wbICON,\n wbString(ANAM, 'Short Name')\n ]);\n\n wbRecord(RADS, 'Radiation Stage', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbInteger('Trigger Threshold', itU32),\n wbFormIDCk('Actor Effect', [SPEL])\n ], cpNormal, True)\n ]);\n\n wbRecord(CAMS, 'Camera Shot', [\n wbEDIDReq,\n wbMODL,\n wbStruct(DATA, 'Data', [\n {00} wbInteger('Action', itU32, wbEnum([\n 'Shoot',\n 'Fly',\n 'Hit',\n 'Zoom'\n ])),\n {04} wbInteger('Location', itU32, wbEnum([\n 'Attacker',\n 'Projectile',\n 'Target'\n ])),\n {08} wbInteger('Target', itU32, wbEnum([\n 'Attacker',\n 'Projectile',\n 'Target'\n ])),\n {12} wbInteger('Flags', itU32, wbFlags([\n 'Position Follows Location',\n 'Rotation Follows Target',\n 'Don''t Follow Bone',\n 'First Person Camera',\n 'No Tracer',\n 'Start At Time Zero'\n ])),\n wbStruct('Time Multipliers', [\n {16} wbFloat('Player'),\n {20} wbFloat('Target'),\n {24} wbFloat('Global')\n ]),\n {28} wbFloat('Max Time'),\n {32} wbFloat('Min Time'),\n {36} wbFloat('Target % Between Actors')\n ], cpNormal, True, nil, 7),\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD])\n ]);\n\n wbRecord(CPTH, 'Camera Path', [\n wbEDIDReq,\n wbCTDAs,\n wbArray(ANAM, 'Related Camera Paths', wbFormIDCk('Related Camera Path', [CPTH, NULL]), ['Parent', 'Previous Sibling'], cpNormal, True),\n wbInteger(DATA, 'Camera Zoom', itU8, wbEnum([\n 'Default',\n 'Disable',\n 'Shot List'\n ]), cpNormal, True),\n wbRArray('Camera Shots', wbFormIDCk(SNAM, 'Camera Shot', [CAMS]))\n ]);\n\n wbRecord(VTYP, 'Voice Type', [\n wbEDIDReq,\n wbInteger(DNAM, 'Flags', itU8, wbFlags([\n 'Allow Default Dialog',\n 'Female'\n ]), cpNormal, True)\n ]);\n\n wbRecord(IPCT, 'Impact', [\n wbEDIDReq,\n wbMODL,\n wbStruct(DATA, '', [\n wbFloat('Effect - Duration'),\n wbInteger('Effect - Orientation', itU32, wbEnum([\n 'Surface Normal',\n 'Projectile Vector',\n 'Projectile Reflection'\n ])),\n wbFloat('Angle Threshold'),\n wbFloat('Placement Radius'),\n wbInteger('Sound Level', itU32, wbSoundLevelEnum),\n wbInteger('Flags', itU32, wbFlags([\n 'No Decal Data'\n ]))\n ], cpNormal, True),\n wbDODT,\n wbFormIDCk(DNAM, 'Texture Set', [TXST]),\n wbFormIDCk(SNAM, 'Sound 1', [SOUN]),\n wbFormIDCk(NAM1, 'Sound 2', [SOUN])\n ]);\n\n wbRecord(IPDS, 'Impact DataSet', [\n wbEDIDReq,\n wbStruct(DATA, 'Impacts', [\n wbFormIDCk('Stone', [IPCT, NULL]),\n wbFormIDCk('Dirt', [IPCT, NULL]),\n wbFormIDCk('Grass', [IPCT, NULL]),\n wbFormIDCk('Glass', [IPCT, NULL]),\n wbFormIDCk('Metal', [IPCT, NULL]),\n wbFormIDCk('Wood', [IPCT, NULL]),\n wbFormIDCk('Organic', [IPCT, NULL]),\n wbFormIDCk('Cloth', [IPCT, NULL]),\n wbFormIDCk('Water', [IPCT, NULL]),\n wbFormIDCk('Hollow Metal', [IPCT, NULL]),\n wbFormIDCk('Organic Bug', [IPCT, NULL]),\n wbFormIDCk('Organic Glow', [IPCT, NULL])\n ], cpNormal, True, nil, 9)\n ]);\n\n wbRecord(ECZN, 'Encounter Zone', [\n wbEDIDReq,\n wbStruct(DATA, '', [\n wbFormIDCkNoReach('Owner', [NPC_, FACT, NULL]),\n wbInteger('Rank', itS8),\n wbInteger('Minimum Level', itS8),\n wbInteger('Flags', itU8, wbFlags([\n 'Never Resets',\n 'Match PC Below Minimum Level'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True)\n ]);\n\n wbRecord(MESG, 'Message', [\n wbEDIDReq,\n wbDESCReq,\n wbFULL,\n wbFormIDCk(INAM, 'Icon', [MICN, NULL], False, cpNormal, True),\n wbByteArray(NAM0, 'Unused', 0, cpIgnore),\n wbByteArray(NAM1, 'Unused', 0, cpIgnore),\n wbByteArray(NAM2, 'Unused', 0, cpIgnore),\n wbByteArray(NAM3, 'Unused', 0, cpIgnore),\n wbByteArray(NAM4, 'Unused', 0, cpIgnore),\n wbByteArray(NAM5, 'Unused', 0, cpIgnore),\n wbByteArray(NAM6, 'Unused', 0, cpIgnore),\n wbByteArray(NAM7, 'Unused', 0, cpIgnore),\n wbByteArray(NAM8, 'Unused', 0, cpIgnore),\n wbByteArray(NAM9, 'Unused', 0, cpIgnore),\n wbInteger(DNAM, 'Flags', itU32, wbFlags([\n 'Message Box',\n 'Auto Display'\n ]), cpNormal, True, False, nil, wbMESGDNAMAfterSet),\n wbInteger(TNAM, 'Display Time', itU32, nil, cpNormal, False, False, wbMESGTNAMDontShow),\n wbRStructs('Menu Buttons', 'Menu Button', [\n wbString(ITXT, 'Button Text'),\n wbCTDAs\n ], [])\n ], False, nil, cpNormal, False, wbMESGAfterLoad);\n\n wbRecord(RGDL, 'Ragdoll', [\n wbEDIDReq,\n wbInteger(NVER, 'Version', itU32, nil, cpNormal, True),\n wbStruct(DATA, 'General Data', [\n wbInteger('Dynamic Bone Count', itU32),\n wbByteArray('Unused', 4),\n wbStruct('Enabled', [\n wbInteger('Feedback', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Foot IK (broken, don''t use)', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Look IK (broken, don''t use)', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Grab IK (broken, don''t use)', itU8, wbEnum(['No', 'Yes'])),\n wbInteger('Pose Matching', itU8, wbEnum(['No', 'Yes']))\n ]),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbFormIDCk(XNAM, 'Actor Base', [CREA, NPC_], False, cpNormal, True),\n wbFormIDCk(TNAM, 'Body Part Data', [BPTD], False, cpNormal, True),\n wbStruct(RAFD, 'Feedback Data', [\n {00} wbFloat('Dynamic/Keyframe Blend Amount'),\n {04} wbFloat('Hierarchy Gain'),\n {08} wbFloat('Position Gain'),\n {12} wbFloat('Velocity Gain'),\n {16} wbFloat('Acceleration Gain'),\n {20} wbFloat('Snap Gain'),\n {24} wbFloat('Velocity Damping'),\n wbStruct('Snap Max Settings', [\n {28} wbFloat('Linear Velocity'),\n {32} wbFloat('Angular Velocity'),\n {36} wbFloat('Linear Distance'),\n {40} wbFloat('Angular Distance')\n ]),\n wbStruct('Position Max Velocity', [\n {44} wbFloat('Linear'),\n {48} wbFloat('Angular')\n ]),\n wbStruct('Position Max Velocity', [\n {52} wbInteger('Projectile', itS32, wbDiv(1000)),\n {56} wbInteger('Melee', itS32, wbDiv(1000))\n ])\n ], cpNormal, False),\n wbArray(RAFB, 'Feedback Dynamic Bones', wbInteger('Bone', itU16), 0, nil, nil, cpNormal, False),\n wbStruct(RAPS, 'Pose Matching Data', [\n {00} wbArray('Match Bones', wbInteger('Bone', itU16, wbHideFFFF), 3),\n {06} wbInteger('Flags', itU8, wbFlags([\n 'Disable On Move'\n ])),\n {07} wbByteArray('Unused', 1),\n {08} wbFloat('Motors Strength'),\n {12} wbFloat('Pose Activation Delay Time'),\n {16} wbFloat('Match Error Allowance'),\n {20} wbFloat('Displacement To Disable')\n ], cpNormal, True),\n wbString(ANAM, 'Death Pose')\n ]);\n\n wbRecord(DOBJ, 'Default Object Manager', [\n wbEDIDReq,\n wbArray(DATA, 'Default Objects', wbFormID('Default Object'), [\n 'Stimpack',\n 'SuperStimpack',\n 'RadX',\n 'RadAway',\n 'Morphine',\n 'Perk Paralysis',\n 'Player Faction',\n 'Mysterious Stranger NPC',\n 'Mysterious Stranger Faction',\n 'Default Music',\n 'Battle Music',\n 'Death Music',\n 'Success Music',\n 'Level Up Music',\n 'Player Voice (Male)',\n 'Player Voice (Male Child)',\n 'Player Voice (Female)',\n 'Player Voice (Female Child)',\n 'Eat Package Default Food',\n 'Every Actor Ability',\n 'Drug Wears Off Image Space'\n ], cpNormal, True)\n ]);\n\n wbRecord(LGTM, 'Lighting Template', [\n wbEDIDReq,\n wbStruct(DATA, 'Lighting', [\n wbStruct('Ambient Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Directional Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Fog Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbFloat('Fog Near'),\n wbFloat('Fog Far'),\n wbInteger('Directional Rotation XY', itS32),\n wbInteger('Directional Rotation Z', itS32),\n wbFloat('Directional Fade'),\n wbFloat('Fog Clip Dist'),\n wbFloat('Fog Power')\n ], cpNormal, True)\n ]);\n\n wbRecord(MUSC, 'Music Type', [\n wbEDIDReq,\n wbString(FNAM, 'Filename')\n ]);\n\n wbRecord(GRAS, 'Grass', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbStruct(DATA, '', [\n wbInteger('Density', itU8),\n wbInteger('Min Slope', itU8),\n wbInteger('Max Slope', itU8),\n wbByteArray('Unused', 1),\n wbInteger('Unit from water amount', itU16),\n wbByteArray('Unused', 2),\n wbInteger('Unit from water type', itU32, wbEnum([\n 'Above - At Least',\n 'Above - At Most',\n 'Below - At Least',\n 'Below - At Most',\n 'Either - At Least',\n 'Either - At Most',\n 'Either - At Most Above',\n 'Either - At Most Below'\n ])),\n wbFloat('Position Range'),\n wbFloat('Height Range'),\n wbFloat('Color Range'),\n wbFloat('Wave Period'),\n wbInteger('Flags', itU8, wbFlags([\n 'Vertex Lighting',\n 'Uniform Scaling',\n 'Fit to Slope'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, True)\n ]);\n\n wbRecord(HAIR, 'Hair', [\n wbEDIDReq,\n wbFULLReq,\n wbMODLReq,\n wbString(ICON, 'Texture', 0, cpNormal, True),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n 'Playable',\n 'Not Male',\n 'Not Female',\n 'Fixed'\n ]), cpNormal, True)\n ]);\n\n wbRecord(IDLE, 'Idle Animation', [\n wbEDID,\n wbMODLReq,\n wbCTDAs,\n wbArray(ANAM, 'Related Idle Animations', wbFormIDCk('Related Idle Animation', [IDLE, NULL]), ['Parent', 'Previous Sibling'], cpNormal, True),\n wbStruct(DATA, '', [\n wbInteger('Animation Group Section', itU8, wbIdleAnam),\n wbStruct('Looping', [\n wbInteger('Min', itU8),\n wbInteger('Max', itU8)\n ]),\n wbByteArray('Unused', 1),\n wbInteger('Replay Delay', itS16),\n wbInteger('Flags', itU8, wbFlags([\n 'No attacking'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True, nil, 4)\n ]);\n\n wbRecord(INFO, 'Dialog response', [\n wbStruct(DATA, '', [\n wbInteger('Type', itU8, wbEnum([\n {0} 'Topic',\n {1} 'Conversation',\n {2} 'Combat',\n {3} 'Persuasion',\n {4} 'Detection',\n {5} 'Service',\n {6} 'Miscellaneous',\n {7} 'Radio'\n ])),\n wbInteger('Next Speaker', itU8, wbEnum([\n {0} 'Target',\n {1} 'Self',\n {2} 'Either'\n ])),\n wbInteger('Flags 1', itU8, wbFlags([\n {0x01} 'Goodbye',\n {0x02} 'Random',\n {0x04} 'Say Once',\n {0x08} 'Run Immediately',\n {0x10} 'Info Refusal',\n {0x20} 'Random End',\n {0x40} 'Run for Rumors',\n {0x80} 'Speech Challenge'\n ])),\n wbInteger('Flags 2', itU8, wbFlags([\n {0x01} 'Say Once a Day',\n {0x02} 'Always Darken'\n ]))\n ], cpNormal, True, nil, 3),\n wbFormIDCkNoReach(QSTI, 'Quest', [QUST], False, cpNormal, True),\n wbFormIDCk(TPIC, 'Topic', [DIAL]),\n wbFormIDCkNoReach(PNAM, 'Previous INFO', [INFO, NULL]),\n wbRArray('Add Topics', wbFormIDCk(NAME, 'Topic', [DIAL])),\n wbRArray('Responses',\n wbRStruct('Response', [\n wbStruct(TRDT, 'Response Data', [\n wbInteger('Emotion Type', itU32, wbEnum([\n {0} 'Neutral',\n {1} 'Anger',\n {2} 'Disgust',\n {3} 'Fear',\n {4} 'Sad',\n {5} 'Happy',\n {6} 'Surprise',\n {7} 'Pained'\n ])),\n wbInteger('Emotion Value', itS32),\n wbByteArray('Unused', 4),\n wbInteger('Response number', itU8),\n wbByteArray('Unused', 3),\n wbFormIDCk('Sound', [SOUN, NULL]),\n wbInteger('Flags', itU8, wbFlags([\n 'Use Emotion Animation'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, False, nil, 5),\n wbStringKC(NAM1, 'Response Text', 0, cpTranslate, True),\n wbString(NAM2, 'Script Notes', 0, cpTranslate, True),\n wbString(NAM3, 'Edits'),\n wbFormIDCk(SNAM, 'Speaker Animation', [IDLE]),\n wbFormIDCk(LNAM, 'Listener Animation', [IDLE])\n ], [])\n ),\n wbCTDAs,\n wbRArray('Choices', wbFormIDCk(TCLT, 'Choice', [DIAL])),\n wbRArray('Link From', wbFormIDCk(TCLF, 'Topic', [DIAL])),\n wbRStruct('Script (Begin)', [\n wbEmbeddedScriptReq\n ], [], cpNormal, True),\n wbRStruct('Script (End)', [\n wbEmpty(NEXT, 'Marker'),\n wbEmbeddedScriptReq\n ], [], cpNormal, True),\n wbFormIDCk(SNDD, 'Unused', [SOUN]),\n wbString(RNAM, 'Prompt'),\n wbFormIDCk(ANAM, 'Speaker', [CREA, NPC_]),\n wbFormIDCk(KNAM, 'ActorValue/Perk', [AVIF, PERK]),\n wbInteger(DNAM, 'Speech Challenge', itU32, wbEnum([\n '---',\n 'Very Easy',\n 'Easy',\n 'Average',\n 'Hard',\n 'Very Hard'\n ]))\n ], False, wbINFOAddInfo, cpNormal, False, wbINFOAfterLoad);\n\n wbRecord(INGR, 'Ingredient', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbETYPReq,\n wbFloat(DATA, 'Weight', cpNormal, True),\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Value', itS32),\n wbInteger('Flags', itU8, wbFlags(['No auto-calculation', 'Food item'])),\n wbByteArray('Unused', 3)\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(KEYM, 'Key', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLReq,\n wbMODL,\n wbICONReq,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ]);\n\n wbQuadrantEnum := wbEnum([\n {0} 'Bottom Left',\n {1} 'Bottom Right',\n {2} 'Top Left',\n {3} 'Top Right'\n ]);\n\n if wbSimpleRecords then begin\n\n wbRecord(LAND, 'Landscape', [\n wbByteArray(DATA, 'Unknown'),\n wbByteArray(VNML, 'Vertex Normals'),\n wbByteArray(VHGT, 'Vertext Height Map'),\n wbByteArray(VCLR, 'Vertex Colours'),\n\n wbRArrayS('Layers', wbRUnion('Layer', [\n wbRStructSK([0],'Base Layer', [\n wbStructSK(BTXT, [1, 3], 'Base Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ])\n ], []),\n wbRStructSK([0],'Alpha Layer', [\n wbStructSK(ATXT, [1, 3], 'Alpha Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ]),\n wbByteArray(VTXT, 'Alpha Layer Data')\n ], [])\n ], [])),\n\n wbArray(VTEX, 'Textures', wbFormIDCk('Texture', [LTEX, NULL]))\n ]);\n\n end else begin\n\n wbRecord(LAND, 'Landscape', [\n wbByteArray(DATA, 'Unknown'),\n wbArray(VNML, 'Vertex Normals', wbStruct('Row', [\n wbArray('Columns', wbStruct('Column', [\n wbInteger('X', itU8),\n wbInteger('Y', itU8),\n wbInteger('Z', itU8)\n ]), 33)\n ]), 33),\n wbStruct(VHGT, 'Vertext Height Map', [\n wbFloat('Offset'),\n wbArray('Rows', wbStruct('Row', [\n wbArray('Columns', wbInteger('Column', itU8), 33)\n ]), 33),\n wbByteArray('Unused', 3)\n ]),\n wbArray(VCLR, 'Vertex Colours', wbStruct('Row', [\n wbArray('Columns', wbStruct('Column', [\n wbInteger('X', itU8),\n wbInteger('Y', itU8),\n wbInteger('Z', itU8)\n ]), 33)\n ]), 33),\n\n wbRArrayS('Layers', wbRUnion('Layer', [\n wbRStructSK([0],'Base Layer', [\n wbStructSK(BTXT, [1, 3], 'Base Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ])\n ], []),\n wbRStructSK([0],'Alpha Layer', [\n wbStructSK(ATXT, [1, 3], 'Alpha Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unused', 1),\n wbInteger('Layer', itS16)\n ]),\n wbArrayS(VTXT, 'Alpha Layer Data', wbStructSK([0], 'Cell', [\n wbInteger('Position', itU16, wbAtxtPosition),\n wbByteArray('Unused', 2),\n wbFloat('Opacity')\n ]))\n ], [])\n ], [])),\n\n wbArray(VTEX, 'Textures', wbFormIDCk('Texture', [LTEX, NULL]))\n ]);\n\n end;\n\n wbRecord(LIGH, 'Light', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODL,\n wbSCRI,\n wbDEST,\n wbFULL,\n wbICON,\n wbStruct(DATA, '', [\n wbInteger('Time', itS32),\n wbInteger('Radius', itU32),\n wbStruct('Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbInteger('Unused', itU8)\n ]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Dynamic',\n {0x00000002} 'Can be Carried',\n {0x00000004} 'Negative',\n {0x00000008} 'Flicker',\n {0x00000010} 'Unused',\n {0x00000020} 'Off By Default',\n {0x00000040} 'Flicker Slow',\n {0x00000080} 'Pulse',\n {0x00000100} 'Pulse Slow',\n {0x00000200} 'Spot Light',\n {0x00000400} 'Spot Shadow'\n ])),\n wbFloat('Falloff Exponent'),\n wbFloat('FOV'),\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbFloat(FNAM, 'Fade value', cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN])\n ], False, nil, cpNormal, False, wbLIGHAfterLoad);\n\n wbRecord(LSCR, 'Load Screen', [\n wbEDIDReq,\n wbICONReq,\n wbDESCReq,\n wbRArrayS('Locations', wbStructSK(LNAM, [0, 1], 'Location', [\n wbFormIDCkNoReach('Cell', [CELL, WRLD]),\n wbByteArray('Unused', 8)\n ]))\n ]);\n\n wbRecord(LTEX, 'Landscape Texture', [\n wbEDIDReq,\n wbICON,\n wbFormIDCk(TNAM, 'Texture', [TXST], False, cpNormal, True),\n wbStruct(HNAM, 'Havok Data', [\n wbInteger('Material Type', itU8, wbEnum([\n {00} 'STONE',\n {01} 'CLOTH',\n {02} 'DIRT',\n {03} 'GLASS',\n {04} 'GRASS',\n {05} 'METAL',\n {06} 'ORGANIC',\n {07} 'SKIN',\n {08} 'WATER',\n {09} 'WOOD',\n {10} 'HEAVY STONE',\n {11} 'HEAVY METAL',\n {12} 'HEAVY WOOD',\n {13} 'CHAIN',\n {14} 'SNOW',\n {15} 'ELEVATOR',\n {16} 'HOLLOW METAL',\n {17} 'SHEET METAL',\n {18} 'SAND',\n {19} 'BRIKEN CONCRETE',\n {20} 'VEHILCE BODY',\n {21} 'VEHILCE PART SOLID',\n {22} 'VEHILCE PART HOLLOW',\n {23} 'BARREL',\n {24} 'BOTTLE',\n {25} 'SODA CAN',\n {26} 'PISTOL',\n {27} 'RIFLE',\n {28} 'SHOPPING CART',\n {29} 'LUNCHBOX',\n {30} 'BABY RATTLE',\n {31} 'RUBER BALL'\n ])),\n wbInteger('Friction', itU8),\n wbInteger('Restitution', itU8)\n ], cpNormal, True),\n wbInteger(SNAM, 'Texture Specular Exponent', itU8, nil, cpNormal, True),\n wbRArrayS('Grasses', wbFormIDCk(GNAM, 'Grass', [GRAS]))\n ]);\n\n wbRecord(LVLC, 'Leveled Creature', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(LVLD, 'Chance none', itU8, nil, cpNormal, True),\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count'\n ]), cpNormal, True),\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itS16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Reference', [CREA, LVLC]),\n wbInteger('Count', itS16),\n wbByteArray('Unused', 2)\n ]),\n wbCOED\n ], []),\n cpNormal, True),\n wbMODL\n ]);\n\n wbRecord(LVLN, 'Leveled NPC', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(LVLD, 'Chance none', itU8, nil, cpNormal, True),\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count'\n ]), cpNormal, True),\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itS16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Reference', [NPC_, LVLN]),\n wbInteger('Count', itS16),\n wbByteArray('Unused', 2)\n ]),\n wbCOED\n ], []),\n cpNormal, True),\n wbMODL\n ]);\n\n wbRecord(LVLI, 'Leveled Item', [\n wbEDIDReq,\n wbOBNDReq,\n wbInteger(LVLD, 'Chance none', itU8, nil, cpNormal, True),\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count',\n {0x04} 'Use All'\n ]), cpNormal, True),\n wbFormIDCk(LVLG, 'Global', [GLOB]),\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itS16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Reference', [ARMO, AMMO, MISC, WEAP, BOOK, LVLI, KEYM, ALCH, NOTE]),\n wbInteger('Count', itS16),\n wbByteArray('Unused', 2)\n ]),\n wbCOED\n ], [])\n )\n ]);\n\n wbArchtypeEnum := wbEnum([\n {00} 'Value Modifier',\n {01} 'Script',\n {02} 'Dispel',\n {03} 'Cure Disease',\n {04} '',\n {05} '',\n {06} '',\n {07} '',\n {08} '',\n {09} '',\n {10} '',\n {11} 'Invisibility',\n {12} 'Chameleon',\n {13} 'Light',\n {14} '',\n {15} '',\n {16} 'Lock',\n {17} 'Open',\n {18} 'Bound Item',\n {19} 'Summon Creature',\n {20} '',\n {21} '',\n {22} '',\n {23} '',\n {24} 'Paralysis',\n {25} '',\n {26} '',\n {27} '',\n {28} '',\n {29} '',\n {30} 'Cure Paralysis',\n {31} 'Cure Addiction',\n {32} 'Cure Poison',\n {33} 'Concussion',\n {34} 'Value And Parts'\n ]);\n\n wbRecord(MGEF, 'Base Effect', [\n wbEDIDReq,\n wbFULL,\n wbDESCReq,\n wbICON,\n wbMODL,\n wbStruct(DATA, 'Data', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Hostile',\n {0x00000002} 'Recover',\n {0x00000004} 'Detrimental',\n {0x00000008} '',\n {0x00000010} 'Self',\n {0x00000020} 'Touch',\n {0x00000040} 'Target',\n {0x00000080} 'No Duration',\n {0x00000100} 'No Magnitude',\n {0x00000200} 'No Area',\n {0x00000400} 'FX Persist',\n {0x00000800} '',\n {0x00001000} 'Gory Visuals',\n {0x00002000} 'Display Name Only',\n {0x00004000} '',\n {0x00008000} 'Radio Broadcast ??',\n {0x00010000} '',\n {0x00020000} '',\n {0x00040000} '',\n {0x00080000} 'Use skill',\n {0x00100000} 'Use attribute',\n {0x00200000} '',\n {0x00400000} '',\n {0x00800000} '',\n {0x01000000} 'Painless',\n {0x02000000} 'Spray projectile type (or Fog if Bolt is specified as well)',\n {0x04000000} 'Bolt projectile type (or Fog if Spray is specified as well)',\n {0x08000000} 'No Hit Effect',\n {0x10000000} 'No Death Dispel',\n {0x20000000} '????'\n ])),\n {04} wbFloat('Base cost (Unused)'),\n {08} wbUnion('Assoc. Item', wbMGEFFAssocItemDecider, [\n wbFormID('Unused', cpIgnore),\n wbFormID('Assoc. Item'),\n wbFormIDCk('Assoc. Script', [SCPT, NULL]), //Script\n wbFormIDCk('Assoc. Item', [WEAP, ARMO, NULL]), //Bound Item\n wbFormIDCk('Assoc. Creature', [CREA]) //Summon Creature\n ], cpNormal, false, nil, wbMGEFFAssocItemAfterSet),\n {12} wbInteger('Magic School (Unused)', itS32, wbEnum([\n ], [\n -1, 'None'\n ])),\n {16} wbInteger('Resistance Type', itS32, wbActorValueEnum),\n {20} wbInteger('Counter effect count', itU16),\n {22} wbByteArray('Unused', 2),\n {24} wbFormIDCk('Light', [LIGH, NULL]),\n {28} wbFloat('Projectile speed'),\n {32} wbFormIDCk('Effect Shader', [EFSH, NULL]),\n {36} wbFormIDCk('Object Display Shader', [EFSH, NULL]),\n {40} wbFormIDCk('Effect sound', [NULL, SOUN]),\n {44} wbFormIDCk('Bolt sound', [NULL, SOUN]),\n {48} wbFormIDCk('Hit sound', [NULL, SOUN]),\n {52} wbFormIDCk('Area sound', [NULL, SOUN]),\n {56} wbFloat('Constant Effect enchantment factor (Unused)'),\n {60} wbFloat('Constant Effect barter factor (Unused)'),\n {64} wbInteger('Archtype', itU32, wbArchtypeEnum, cpNormal, False, nil, wbMGEFArchtypeAfterSet),\n {68} wbActorValue\n ], cpNormal, True),\n wbRArrayS('Counter Effects', wbFormIDCk(ESCE, 'Effect', [MGEF]), cpNormal, False, nil, wbCounterEffectsAfterSet)\n ], False, nil, cpNormal, False, wbMGEFAfterLoad, wbMGEFAfterSet);\n\n wbRecord(MISC, 'Misc. Item', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ]);\n\n wbRecord(COBJ, 'Constructible Object', [\n wbEDID,\n wbOBND,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ]);\n\n wbFaceGen := wbRStruct('FaceGen Data', [\n wbByteArray(FGGS, 'FaceGen Geometry-Symmetric', 0, cpNormal, True),\n wbByteArray(FGGA, 'FaceGen Geometry-Asymmetric', 0, cpNormal, True),\n wbByteArray(FGTS, 'FaceGen Texture-Symmetric', 0, cpNormal, True)\n ], [], cpNormal, True);\n\n wbFaceGenNPC := wbRStruct('FaceGen Data', [\n wbByteArray(FGGS, 'FaceGen Geometry-Symmetric', 0, cpNormal, True),\n wbByteArray(FGGA, 'FaceGen Geometry-Asymmetric', 0, cpNormal, True),\n wbByteArray(FGTS, 'FaceGen Texture-Symmetric', 0, cpNormal, True)\n ], [], cpNormal, True, wbActorTemplateUseModelAnimation);\n\n\n wbRecord(NPC_, 'Non-Player Character', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULLActor,\n wbMODLActor,\n wbStruct(ACBS, 'Configuration', [\n {00} wbInteger('Flags', itU32, wbFlags([\n {0x000001} 'Female',\n {0x000002} 'Essential',\n {0x000004} 'Is CharGen Face Preset',\n {0x000008} 'Respawn',\n {0x000010} 'Auto-calc stats',\n {0x000020} '',\n {0x000040} '',\n {0x000080} 'PC Level Mult',\n {0x000100} 'Use Template',\n {0x000200} 'No Low Level Processing',\n {0x000400} '',\n {0x000800} 'No Blood Spray',\n {0x001000} 'No Blood Decal',\n {0x002000} '',\n {0x004000} '',\n {0x008000} '',\n {0x010000} '',\n {0x020000} '',\n {0x040000} '',\n {0x080000} '',\n {0x100000} 'No VATS Melee',\n {0x00200000} '',\n {0x00400000} 'Can be all races',\n {0x00800000} '',\n {0x01000000} '',\n {0x02000000} '',\n {0x03000000} 'No Knockdowns',\n {0x08000000} 'Not Pushable',\n {0x10000000} '', {28}\n {0x20000000} '',\n {0x40000000} 'No Rotating To Head-track',\n {0x80000000} ''\n ], [\n {0x000001 Female} wbActorTemplateUseTraits,\n {0x000002 Essential} wbActorTemplateUseBaseData,\n {0x000004 Is CharGen Face Preset} nil,\n {0x000008 Respawn} wbActorTemplateUseBaseData,\n {0x000010 Auto-calc stats} wbActorTemplateUseStats,\n {0x000020 } nil,\n {0x000040 } nil,\n {0x000080 PC Level Mult} wbActorTemplateUseStats,\n {0x000100 Use Template} nil,\n {0x000200 No Low Level Processing} wbActorTemplateUseBaseData,\n {0x000400 } nil,\n {0x000800 No Blood Spray} wbActorTemplateUseModelAnimation,\n {0x001000 No Blood Decal} wbActorTemplateUseModelAnimation,\n {0x002000 } nil,\n {0x004000 } nil,\n {0x008000 } nil,\n {0x010000 } nil,\n {0x020000 } nil,\n {0x040000 } nil,\n {0x080000 } nil,\n {0x100000 No VATS Melee} nil,\n {0x00200000 } nil,\n {0x00400000 Can be all races} nil,\n {0x00800000 } nil,\n {0x01000000 } nil,\n {0x02000000 } nil,\n {0x03000000 No Knockdowns} nil,\n {0x08000000 Not Pushable} wbActorTemplateUseModelAnimation,\n {0x10000000 } nil,\n {0x20000000 } nil,\n {0x40000000 No Rotating To Head-track} wbActorTemplateUseModelAnimation,\n {0x80000000 } nil\n ])),\n {04} wbInteger('Fatigue', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {06} wbInteger('Barter gold', itU16, nil, cpNormal, False, wbActorTemplateUseAIData),\n {08} wbUnion('Level', wbCreaLevelDecider, [\n wbInteger('Level', itS16, nil, cpNormal, True, wbActorTemplateUseStats),\n wbInteger('Level Mult', itS16, wbDiv(1000), cpNormal, True, wbActorTemplateUseStats)\n ], cpNormal, True, wbActorTemplateUseStats),\n {10} wbInteger('Calc min', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {12} wbInteger('Calc max', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {14} wbInteger('Speed Multiplier', itU16, nil, cpNormal, True, wbActorTemplateUseStats),\n {16} wbFloat('Karma (Alignment)', cpNormal, False, 1, -1, wbActorTemplateUseTraits),\n {20} wbInteger('Disposition Base', itS16, nil, cpNormal, False, wbActorTemplateUseTraits),\n {22} wbInteger('Template Flags', itU16, wbTemplateFlags)\n ], cpNormal, True),\n wbRArrayS('Factions',\n wbStructSK(SNAM, [0], 'Faction', [\n wbFormIDCk('Faction', [FACT]),\n wbInteger('Rank', itU8),\n wbByteArray('Unused', 3)\n ]),\n cpNormal, False, nil, nil, wbActorTemplateUseFactions),\n wbFormIDCk(INAM, 'Death item', [LVLI], False, cpNormal, False, wbActorTemplateUseTraits),\n wbFormIDCk(VTCK, 'Voice', [VTYP], False, cpNormal, True, wbActorTemplateUseTraits),\n wbFormIDCk(TPLT, 'Template', [LVLN, NPC_]),\n wbFormIDCk(RNAM, 'Race', [RACE], False, cpNormal, True, wbActorTemplateUseTraits),\n wbSPLOs,\n wbFormIDCk(EITM, 'Unarmed Attack Effect', [ENCH, SPEL], False, cpNormal, False, wbActorTemplateUseActorEffectList),\n wbInteger(EAMT, 'Unarmed Attack Animation', itU16, wbAttackAnimationEnum, cpNormal, True, False, wbActorTemplateUseActorEffectList),\n wbDESTActor,\n wbSCRIActor,\n wbRArrayS('Items', wbCNTO, cpNormal, False, nil, nil, wbActorTemplateUseInventory),\n wbAIDT,\n wbRArray('Packages', wbFormIDCk(PKID, 'Package', [PACK]), cpNormal, False, nil, nil, wbActorTemplateUseAIPackages),\n wbArrayS(KFFZ, 'Animations', wbStringLC('Animation'), 0, cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbFormIDCk(CNAM, 'Class', [CLAS], False, cpNormal, True, wbActorTemplateUseTraits),\n wbStruct(DATA, '', [\n {00} wbInteger('Base Health', itS32),\n {04} wbArray('Attributes', wbInteger('Attribute', itU8), [\n 'Strength',\n 'Perception',\n 'Endurance',\n 'Charisma',\n 'Intelligence',\n 'Agility',\n 'Luck'\n ], cpNormal, False, wbActorAutoCalcDontShow),\n wbByteArray('Unused'{, 14 - only present in old record versions})\n ], cpNormal, True, wbActorTemplateUseStats),\n wbStruct(DNAM, '', [\n {00} wbArray('Skill Values', wbInteger('Skill', itU8), [\n 'Barter',\n 'Big Guns',\n 'Energy Weapons',\n 'Explosives',\n 'Lockpick',\n 'Medicine',\n 'Melee Weapons',\n 'Repair',\n 'Science',\n 'Small Guns',\n 'Sneak',\n 'Speech',\n 'Throwing (unused)',\n 'Unarmed'\n ]),\n {14} wbArray('Skill Offsets', wbInteger('Skill', itU8), [\n 'Barter',\n 'Big Guns',\n 'Energy Weapons',\n 'Explosives',\n 'Lockpick',\n 'Medicine',\n 'Melee Weapons',\n 'Repair',\n 'Science',\n 'Small Guns',\n 'Sneak',\n 'Speech',\n 'Throwing (unused)',\n 'Unarmed'\n ])\n ], cpNormal, False, wbActorTemplateUseStatsAutoCalc),\n wbRArrayS('Head Parts',\n wbFormIDCk(PNAM, 'Head Part', [HDPT]),\n cpNormal, False, nil, nil, wbActorTemplateUseModelAnimation),\n wbFormIDCk(HNAM, 'Hair', [HAIR], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbFloat(LNAM, 'Hair length', cpNormal, False, 1, -1, wbActorTemplateUseModelAnimation),\n wbFormIDCk(ENAM, 'Eyes', [EYES], False, cpNormal, False, wbActorTemplateUseModelAnimation),\n wbStruct(HCLR, 'Hair color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ], cpNormal, True, wbActorTemplateUseModelAnimation),\n wbFormIDCk(ZNAM, 'Combat Style', [CSTY], False, cpNormal, False, wbActorTemplateUseTraits),\n wbInteger(NAM4, 'Impact Material Type', itU32, wbImpactMaterialTypeEnum, cpNormal, True, False, wbActorTemplateUseModelAnimation),\n wbFaceGenNPC,\n wbInteger(NAM5, 'Unknown', itU16, nil, cpNormal, True, False, nil, nil, 255),\n wbFloat(NAM6, 'Height', cpNormal, True, 1, -1, wbActorTemplateUseTraits),\n wbFloat(NAM7, 'Weight', cpNormal, True, 1, -1, wbActorTemplateUseTraits)\n ], True, nil, cpNormal, False, wbNPCAfterLoad);\n\n wbPKDTFlags := wbFlags([\n {0x00000001} 'Offers Services',\n {0x00000002} 'Must reach location',\n {0x00000004} 'Must complete',\n {0x00000008} 'Lock doors at package start',\n {0x00000010} 'Lock doors at package end',\n {0x00000020} 'Lock doors at location',\n {0x00000040} 'Unlock doors at package start',\n {0x00000080} 'Unlock doors at package end',\n {0x00000100} 'Unlock doors at location',\n {0x00000200} 'Continue if PC near',\n {0x00000400} 'Once per day',\n {0x00000800} '',\n {0x00001000} 'Skip fallout behavior',\n {0x00002000} 'Always run',\n {0x00004000} '',\n {0x00008000} '',\n {0x00010000} '',\n {0x00020000} 'Always sneak',\n {0x00040000} 'Allow swimming',\n {0x00080000} 'Allow falls',\n {0x00100000} 'Head-Tracking off',\n {0x00200000} 'Weapons unequipped',\n {0x00400000} 'Defensive combat',\n {0x00800000} 'Weapon Drawn',\n {0x01000000} 'No idle anims',\n {0x02000000} 'Pretend In Combat',\n {0x04000000} 'Continue During Combat',\n {0x08000000} 'No Combat Alert',\n {0x10000000} 'No Warn/Attack Behaviour',\n {0x20000000} '',\n {0x40000000} '',\n {0x80000000} ''\n ]);\n\n wbPKDTType := wbEnum([\n {0} 'Find',\n {1} 'Follow',\n {2} 'Escort',\n {3} 'Eat',\n {4} 'Sleep',\n {5} 'Wander',\n {6} 'Travel',\n {7} 'Accompany',\n {8} 'Use Item At',\n {9} 'Ambush',\n {10} 'Flee Not Combat',\n {11} '',\n {12} 'Sandbox',\n {13} 'Patrol',\n {14} 'Guard',\n {15} 'Dialogue',\n {16} 'Use Weapon'\n ]);\n\n wbObjectTypeEnum := wbEnum([\n ' NONE',\n 'Activators',\n 'Armor',\n 'Books',\n 'Clothing',\n 'Containers',\n 'Doors',\n 'Ingredients',\n 'Lights',\n 'Misc',\n 'Flora',\n 'Furniture',\n 'Weapons: Any',\n 'Ammo',\n 'NPCs',\n 'Creatures',\n 'Keys',\n 'Alchemy',\n 'Food',\n ' All: Combat Wearable',\n ' All: Wearable',\n 'Weapons: Ranged',\n 'Weapons: Melee',\n 'Weapons: NONE',\n 'Actor Effects: Any',\n 'Actor Effects: Range Target',\n 'Actor Effects: Range Touch',\n 'Actor Effects: Range Self',\n '',\n 'Actors: Any'\n ]);\n\n\n wbPKDTSpecificFlagsUnused := True;\n\n wbRecord(PACK, 'Package', [\n wbEDIDReq,\n wbStruct(PKDT, 'General', [\n wbInteger('General Flags', itU32, wbPKDTFlags),\n wbInteger('Type', itU8, wbPKDTType),\n wbByteArray('Unused', 1),\n wbInteger('Fallout Behavior Flags', itU16, wbFlags([\n {0x00000001}'Hellos To Player',\n {0x00000002}'Random Conversations',\n {0x00000004}'Observe Combat Behavior',\n {0x00000008}'Unknown 4',\n {0x00000010}'Reaction To Player Actions',\n {0x00000020}'Friendly Fire Comments',\n {0x00000040}'Aggro Radius Behavior',\n {0x00000080}'Allow Idle Chatter',\n {0x00000100}'Avoid Radiation'\n ], True)),\n wbUnion('Type Specific Flags', wbPKDTSpecificFlagsDecider, [\n wbEmpty('Type Specific Flags (missing)', cpIgnore, False, nil, True),\n wbInteger('Type Specific Flags - Find', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Find - Allow Buying',\n {0x00000200}'Find - Allow Killing',\n {0x00000400}'Find - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Follow', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Escort', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Escort - Allow Buying',\n {0x00000200}'Escort - Allow Killing',\n {0x00000400}'Escort - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Eat', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Eat - Allow Buying',\n {0x00000200}'Eat - Allow Killing',\n {0x00000400}'Eat - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Sleep', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Wander', itU16, wbFlags([\n {0x00000001}'Wander - No Eating',\n {0x00000002}'Wander - No Sleeping',\n {0x00000004}'Wander - No Conversation',\n {0x00000008}'Wander - No Idle Markers',\n {0x00000010}'Wander - No Furniture',\n {0x00000020}'Wander - No Wandering'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Travel', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Accompany', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Use Item At', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'Use Item At - Sit Down',\n {0x00000004}'',\n {0x00000008}'',\n {0x00000010}'',\n {0x00000020}'',\n {0x00000040}'',\n {0x00000080}'',\n {0x00000100}'Use Item At - Allow Buying',\n {0x00000200}'Use Item At - Allow Killing',\n {0x00000400}'Use Item At - Allow Stealing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Ambush', itU16, wbFlags([\n {0x00000001}'Ambush - Hide While Ambushing'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Flee Not Combat', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - ?', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Sandbox', itU16, wbFlags([\n {0x00000001}'Sandbox - No Eating',\n {0x00000002}'Sandbox - No Sleeping',\n {0x00000004}'Sandbox - No Conversation',\n {0x00000008}'Sandbox - No Idle Markers',\n {0x00000010}'Sandbox - No Furniture',\n {0x00000020}'Sandbox - No Wandering'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Patrol', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Guard', itU16, wbFlags([\n {0x00000001}'',\n {0x00000002}'',\n {0x00000004}'Guard - Remain Near Reference to Guard'\n ], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Dialogue', itU16, wbFlags([], wbPKDTSpecificFlagsUnused)),\n wbInteger('Type Specific Flags - Use Weapon', itU16, wbFlags([], wbPKDTSpecificFlagsUnused))\n ]),\n wbByteArray('Unused', 2)\n ], cpNormal, True, nil, 2),\n wbRStruct('Locations', [\n wbStruct(PLDT, 'Location 1', [\n wbInteger('Type', itS32, wbEnum([ // Byte + filler\n {0} 'Near reference',\n {1} 'In cell',\n {2} 'Near current location',\n {3} 'Near editor location',\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference',\n {7} 'At package location'\n ])),\n wbUnion('Location', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [REFR, PGRE, PMIS, PBEA, ACHR, ACRE, PLYR], True),\n wbFormIDCkNoReach('Cell', [CELL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Radius', itS32)\n ]),\n wbStruct(PLD2, 'Location 2', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Near reference',\n {1} 'In cell',\n {2} 'Near current location',\n {3} 'Near editor location',\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference',\n {7} 'At package location'\n ])),\n wbUnion('Location', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [REFR, PGRE, PMIS, PBEA, ACHR, ACRE, PLYR], True),\n wbFormIDCkNoReach('Cell', [CELL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Radius', itS32)\n ])\n ], []),\n wbStruct(PSDT, 'Schedule', [\n wbInteger('Month', itS8),\n wbInteger('Day of week', itS8, wbEnum([\n 'Sunday',\n 'Monday',\n 'Tuesday',\n 'Wednesday',\n 'Thursday',\n 'Friday',\n 'Saturday',\n 'Weekdays',\n 'Weekends',\n 'Monday, Wednesday, Friday',\n 'Tuesday, Thursday'\n ], [\n -1, 'Any'\n ])),\n wbInteger('Date', itU8),\n wbInteger('Time', itS8),\n wbInteger('Duration', itS32)\n ], cpNormal, True),\n wbStruct(PTDT, 'Target 1', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Specific Reference',\n {1} 'Object ID',\n {2} 'Object Type',\n {3} 'Linked Reference'\n ]), cpNormal, False, nil, nil, 2),\n wbUnion('Target', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [ACHR, ACRE, REFR, PGRE, PMIS, PBEA, PLYR], True),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, LVLN, LVLC, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, FACT, FLST]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Count / Distance', itS32),\n wbFloat('Unknown')\n ], cpNormal, False, nil, 3),\n wbCTDAs,\n wbRStruct('Idle Animations', [\n wbInteger(IDLF, 'Flags', itU8, wbFlags([\n 'Run in Sequence',\n '',\n 'Do Once'\n ]), cpNormal, True),\n wbStruct(IDLC, '', [\n wbInteger( 'Animation Count', itU8),\n wbByteArray('Unused', 3)\n ], cpNormal, True, nil, 1),\n wbFloat(IDLT, 'Idle Timer Setting', cpNormal, True),\n wbArray(IDLA, 'Animations', wbFormIDCk('Animation', [IDLE]), 0, nil, wbIDLAsAfterSet, cpNormal, True),\n wbByteArray(IDLB, 'Unused', 4, cpIgnore)\n ], [], cpNormal, False, nil, False, nil {cannot be totally removed , wbAnimationsAfterSet}),\n wbFormIDCk(CNAM, 'Combat Style', [CSTY]),\n wbEmpty(PKED, 'Eat Marker'),\n wbInteger(PKE2, 'Escort Distance', itU32),\n wbFloat(PKFD, 'Follow - Start Location - Trigger Radius'),\n wbStruct(PKPT, 'Patrol Flags', [\n wbInteger('Repeatable', itU8, wbEnum(['No', 'Yes']), cpNormal, False, nil, nil, 1),\n wbByteArray('Unused', 1)\n ], cpNormal, False, nil, 1),\n wbStruct(PKW3, 'Use Weapon Data', [\n wbInteger('Flags', itU32, wbFlags([\n 'Always Hit',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Do No Damage',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Crouch To Reload',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Hold Fire When Blocked'\n ])),\n wbInteger('Fire Rate', itU8, wbEnum([\n 'Auto Fire',\n 'Volley Fire'\n ])),\n wbInteger('Fire Count', itU8, wbEnum([\n 'Number of Bursts',\n 'Repeat Fire'\n ])),\n wbInteger('Number of Bursts', itU16),\n wbStruct('Shoots Per Volleys', [\n wbInteger('Min', itU16),\n wbInteger('Max', itU16)\n ]),\n wbStruct('Pause Between Volleys', [\n wbFloat('Min'),\n wbFloat('Max')\n ]),\n wbByteArray('Unused', 4)\n ]),\n wbStruct(PTD2, 'Target 2', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Specific reference',\n {1} 'Object ID',\n {2} 'Object Type',\n {3} 'Linked Reference'\n ])),\n wbUnion('Target', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [ACHR, ACRE, REFR, PGRE, PMIS, PBEA, PLYR], True),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, LVLN, LVLC, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH, FACT, FLST]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Count / Distance', itS32),\n wbFloat('Unknown')\n ], cpNormal, False, nil, 3),\n wbEmpty(PUID, 'Use Item Marker'),\n wbEmpty(PKAM, 'Ambush Marker'),\n wbStruct(PKDD, 'Dialogue Data', [\n wbFloat('FOV'),\n wbFormIDCk('Topic', [DIAL, NULL]),\n wbInteger('Flags', itU32, wbFlags([\n 'No Headtracking',\n '',\n '',\n '',\n '',\n '',\n '',\n '',\n 'Don''t Control Target Movement'\n ])),\n wbByteArray('Unused', 4),\n wbInteger('Dialogue Type', itU32, wbEnum([\n 'Conversation',\n 'Say To'\n ])),\n wbByteArray('Unknown', 4)\n ], cpNormal, False, nil, 3),\n wbStruct(PLD2, 'Location 2 (again??)', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Near reference',\n {1} 'In cell',\n {2} 'Near current location',\n {3} 'Near editor location',\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference',\n {7} 'At package location'\n ])),\n wbUnion('Location', wbPxDTLocationDecider, [\n wbFormIDCkNoReach('Reference', [REFR, PGRE, PMIS, PBEA, ACHR, ACRE, PLYR], True),\n wbFormIDCkNoReach('Cell', [CELL]),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCkNoReach('Object ID', [ACTI, DOOR, STAT, FURN, CREA, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, BOOK, KEYM, ALCH, LIGH]),\n wbInteger('Object Type', itU32, wbObjectTypeEnum),\n wbByteArray('Unused', 4, cpIgnore),\n wbByteArray('Unused', 4, cpIgnore)\n ]),\n wbInteger('Radius', itS32)\n ]),\n wbRStruct('OnBegin', [\n wbEmpty(POBA, 'OnBegin Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('OnEnd', [\n wbEmpty(POEA, 'OnEnd Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('OnChange', [\n wbEmpty(POCA, 'OnChange Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], [], cpNormal, True)\n ], False, nil, cpNormal, False, wbPACKAfterLoad);\n\n wbRecord(QUST, 'Quest', [\n wbEDIDReq,\n wbSCRI,\n wbFULL,\n wbICON,\n wbStruct(DATA, 'General', [\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Start game enabled',\n {0x02} '',\n {0x04} 'Allow repeated conversation topics',\n {0x08} 'Allow repeated stages',\n {0x10} 'Unknown 4'\n ])),\n wbInteger('Priority', itU8),\n wbByteArray('Unused', 2),\n wbFloat('Quest Delay')\n ], cpNormal, True, nil, 3),\n wbCTDAs,\n wbRArrayS('Stages', wbRStructSK([0], 'Stage', [\n wbInteger(INDX, 'Stage Index', itS16),\n wbRArray('Log Entries', wbRStruct('Log Entry', [\n wbInteger(QSDT, 'Stage Flags', itU8, wbFlags([\n {0x01} 'Complete Quest',\n {0x02} 'Fail Quest'\n ])),\n wbCTDAs,\n wbString(CNAM, 'Log Entry', 0, cpTranslate),\n wbEmbeddedScriptReq,\n wbFormIDCk(NAM0, 'Next Quest', [QUST])\n ], []))\n ], [])),\n wbRArray('Objectives', wbRStruct('Objective', [\n wbInteger(QOBJ, 'Objective Index', itS32),\n wbString(NNAM, 'Description', 0, cpNormal, True),\n wbRArray('Targets', wbRStruct('Target', [\n wbStruct(QSTA, 'Target', [\n wbFormIDCkNoReach('Target', [REFR, PGRE, PMIS, PBEA, ACRE, ACHR], True),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Compass Marker Ignores Locks'\n ])),\n wbByteArray('Unused', 3)\n ]),\n wbCTDAs\n ], []))\n ], []))\n ]);\n\n wbHeadPartIndexEnum := wbEnum([\n 'Head',\n 'Ears',\n 'Mouth',\n 'Teeth Lower',\n 'Teeth Upper',\n 'Tongue',\n 'Left Eye',\n 'Right Eye'\n ]);\n\n wbBodyPartIndexEnum := wbEnum([\n 'Upper Body',\n 'Left Hand',\n 'Right Hand',\n 'Upper Body Texture'\n ]);\n\n wbRecord(RACE, 'Race', [\n wbEDIDReq,\n wbFULLReq,\n wbDESCReq,\n wbXNAMs,\n wbStruct(DATA, '', [\n wbArrayS('Skill Boosts', wbStructSK([0], 'Skill Boost', [\n wbInteger('Skill', itS8, wbActorValueEnum),\n wbInteger('Boost', itS8)\n ]), 7),\n wbByteArray('Unused', 2),\n wbFloat('Male Height'),\n wbFloat('Female Height'),\n wbFloat('Male Weight'),\n wbFloat('Female Weight'),\n wbInteger('Flags', itU32, wbFlags([\n 'Playable',\n '',\n 'Child'\n ]))\n ], cpNormal, True),\n wbFormIDCk(ONAM, 'Older', [RACE]),\n wbFormIDCk(YNAM, 'Younger', [RACE]),\n wbEmpty(NAM2, 'Unknown Marker', cpNormal, True),\n wbArray(VTCK, 'Voices', wbFormIDCk('Voice', [VTYP]), ['Male', 'Female'], cpNormal, True),\n wbArray(DNAM, 'Default Hair Styles', wbFormIDCk('Default Hair Style', [HAIR, NULL]), ['Male', 'Female'], cpNormal, True),\n wbArray(CNAM, 'Default Hair Colors', wbInteger('Default Hair Color', itU8, wbEnum([\n 'Bleached',\n 'Brown',\n 'Chocolate',\n 'Platinum',\n 'Cornsilk',\n 'Suede',\n 'Pecan',\n 'Auburn',\n 'Ginger',\n 'Honey',\n 'Gold',\n 'Rosewood',\n 'Black',\n 'Chestnut',\n 'Steel',\n 'Champagne'\n ])), ['Male', 'Female'], cpNormal, True),\n wbFloat(PNAM, 'FaceGen - Main clamp', cpNormal, True),\n wbFloat(UNAM, 'FaceGen - Face clamp', cpNormal, True),\n wbByteArray(ATTR, 'Unused', 0, cpNormal, True),\n wbRStruct('Head Data', [\n wbEmpty(NAM0, 'Head Data Marker', cpNormal, True),\n wbRStruct('Male Head Data', [\n wbEmpty(MNAM, 'Male Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbHeadPartIndexEnum),\n wbMODLReq,\n wbICON\n ], [], cpNormal, False, nil, False, nil, wbHeadPartsAfterSet), cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female Head Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbHeadPartIndexEnum),\n wbMODLReq,\n wbICON\n ], [], cpNormal, False, nil, False, nil, wbHeadPartsAfterSet), cpNormal, True)\n ], [], cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Body Data', [\n wbEmpty(NAM1, 'Body Data Marker', cpNormal, True),\n wbRStruct('Male Body Data', [\n wbEmpty(MNAM, 'Male Data Marker'),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbBodyPartIndexEnum),\n wbICON,\n wbMODLReq\n ], []), cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female Body Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbBodyPartIndexEnum),\n wbICON,\n wbMODLReq\n ], []), cpNormal, True)\n ], [], cpNormal, True)\n ], [], cpNormal, True),\n wbArrayS(HNAM, 'Hairs', wbFormIDCk('Hair', [HAIR]), 0, cpNormal, True),\n wbArrayS(ENAM, 'Eyes', wbFormIDCk('Eye', [EYES]), 0, cpNormal, True),\n wbRStruct('FaceGen Data', [\n wbRStruct('Male FaceGen Data', [\n wbEmpty(MNAM, 'Male Data Marker', cpNormal, True),\n wbFaceGen,\n wbUnknown(SNAM, cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female FaceGen Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbFaceGen,\n wbUnknown(SNAM, cpNormal, True)\n ], [], cpNormal, True)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(REFR, 'Placed Object', [\n wbEDID,\n {\n wbStruct(RCLR, 'Linked Reference Color (Old Format?)', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ], cpIgnore),}\n wbByteArray(RCLR, 'Unused', 0, cpIgnore),\n wbFormIDCk(NAME, 'Base', [TREE, SOUN, ACTI, DOOR, STAT, FURN, CONT, ARMO, AMMO, LVLN, LVLC,\n MISC, WEAP, BOOK, KEYM, ALCH, LIGH, GRAS, ASPC, IDLM, ARMA,\n MSTT, NOTE, PWAT, SCOL, TACT, TERM, TXST], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n {--- ?? ---}\n wbXRGD,\n wbXRGB,\n\n {--- Primitive ---}\n wbStruct(XPRM, 'Primitive', [\n wbStruct('Bounds', [\n wbFloat('X', cpNormal, True, 2, 4),\n wbFloat('Y', cpNormal, True, 2, 4),\n wbFloat('Z', cpNormal, True, 2, 4)\n ]),\n wbStruct('Color', [\n {84} wbFloat('Red', cpNormal, False, 255, 0),\n {88} wbFloat('Green', cpNormal, False, 255, 0),\n {92} wbFloat('Blue', cpNormal, False, 255, 0)\n ]),\n wbFloat('Unknown'),\n wbInteger('Type', itU32, wbEnum([\n 'None',\n 'Box',\n 'Sphere',\n 'Portal Box'\n ]))\n ]),\n wbInteger(XTRI, 'Collision Layer', itU32, wbEnum([\n 'Unidentified',\n 'Static',\n 'AnimStatic',\n 'Transparent',\n 'Clutter',\n 'Weapon',\n 'Projectile',\n 'Spell',\n 'Biped',\n 'Trees',\n 'Props',\n 'Water',\n 'Trigger',\n 'Terrain',\n 'Trap',\n 'Non Collidable',\n 'Cloud Trap',\n 'Ground',\n 'Portal',\n 'Debris Small',\n 'Debris Large',\n 'Acustic Space',\n 'Actor Zone',\n 'Projectile Zone',\n 'Gas Trap',\n 'Shell Casing',\n 'Transparent Small',\n 'Invisible Wall',\n 'Transparent Small Anim',\n 'Dead Bip',\n 'Char Controller',\n 'Avoid Box',\n 'Collision Box',\n 'Camera Sphere',\n 'Door Detection',\n 'Camera Pick',\n 'Item Pick',\n 'Line Of Sight',\n 'Path Pick',\n 'Custom Pick 1',\n 'Custom Pick 2',\n 'Spell Explosion',\n 'Dropping Pick'\n ])),\n wbEmpty(XMBP, 'MultiBound Primitive Marker'),\n\n {--- Bound Contents ---}\n\n {--- Bound Data ---}\n wbStruct(XMBO, 'Bound Half Extents', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n\n {--- Teleport ---}\n wbStruct(XTEL, 'Teleport Destination', [\n wbFormIDCk('Door', [REFR], True),\n wbPosRot,\n wbInteger('Flags', itU32, wbFlags([\n 'No Alarm'\n ]))\n ]),\n\n {--- Map Data ---}\n wbRStruct('Map Marker', [\n wbEmpty(XMRK, 'Map Marker Data'),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n {0x01} 'Visible',\n {0x02} 'Can Travel To',\n {0x04} '\"Show All\" Hidden'\n ]), cpNormal, True),\n wbFULLReq,\n wbStruct(TNAM, '', [\n wbInteger('Type', itU8, wbEnum([\n 'None',\n 'City',\n 'Settlement',\n 'Encampment',\n 'Natural Landmark',\n 'Cave',\n 'Factory',\n 'Monument',\n 'Military',\n 'Office',\n 'Town Ruins',\n 'Urban Ruins',\n 'Sewer Ruins',\n 'Metro',\n 'Vault'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True)\n ], []),\n\n wbInteger(XSRF, 'Special Rendering Flags', itU32, wbFlags([\n 'Unknown 0',\n 'Imposter',\n 'Use Full Shader in LOD'\n ])),\n wbByteArray(XSRD, 'Special Rendering Data', 4),\n\n {--- X Target Data ---}\n wbFormIDCk(XTRG, 'Target', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA], True),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbEmbeddedScriptReq,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal, True)\n ], []),\n\n {--- Radio ---}\n wbStruct(XRDO, 'Radio Data', [\n wbFloat('Range Radius'),\n wbInteger('Broadcast Range Type', itU32, wbEnum([\n 'Radius',\n 'Everywhere',\n 'Worldspace and Linked Interiors',\n 'Linked Interiors',\n 'Current Cell Only'\n ])),\n wbFloat('Static Percentage'),\n wbFormIDCkNoReach('Position Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, NULL])\n ]),\n\n {--- Ownership ---}\n wbRStruct('Ownership', [\n wbXOWN,\n wbInteger(XRNK, 'Faction rank', itS32)\n ], [XCMT, XCMO]),\n\n {--- Lock ---}\n wbStruct(XLOC, 'Lock Data', [\n wbInteger('Level', itU8),\n wbByteArray('Unused', 3),\n wbFormIDCkNoReach('Key', [KEYM, NULL]),\n wbInteger('Flags', itU8, wbFlags(['', '', 'Leveled Lock'])),\n wbByteArray('Unused', 3),\n wbByteArray('Unknown', 8)\n ], cpNormal, False, nil, 5),\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbFloat(XHLP, 'Health'),\n wbFloat(XRAD, 'Radiation'),\n wbFloat(XCHG, 'Charge'),\n wbRStruct('Ammo', [\n wbFormIDCk(XAMT, 'Type', [AMMO], False, cpNormal, True),\n wbInteger(XAMC, 'Count', itS32, nil, cpNormal, True)\n ], []),\n\n {--- Reflected By / Refracted By ---}\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ])\n ),\n\n {--- Lit Water ---}\n wbRArrayS('Lit Water',\n wbFormIDCk(XLTW, 'Water', [REFR])\n ),\n\n {--- Decals ---}\n wbRArrayS('Linked Decals',\n wbStructSK(XDCR, [0], 'Decal', [\n wbFormIDCk('Reference', [REFR]),\n wbUnknown\n ])\n ),\n\n {--- Linked Ref ---}\n wbFormIDCk(XLKR, 'Linked Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbStruct(XCLP, 'Linked Reference Color', [\n wbStruct('Link Start Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Link End Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ])\n ]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', [REFR, ACRE, ACHR, PGRE, PMIS, PBEA, PLYR]),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Flags ---}\n wbInteger(XACT, 'Action Flag', itU32, wbFlags([\n 'Use Default',\n 'Activate',\n 'Open',\n 'Open by Default'\n ])),\n wbEmpty(ONAM, 'Open by Default'),\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- Generated Data ---}\n wbStruct(XNDP, 'Navigation Door Link', [\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbInteger('Teleport Marker Triangle', itS16, wbREFRNavmeshTriangleToStr, wbStringToInt),\n wbByteArray('Unused', 2)\n ]),\n\n wbArray(XPOD, 'Portal Data', wbFormIDCk('Room', [REFR, NULL]), 2),\n wbStruct(XPTL, 'Portal Data', [\n wbStruct('Size', [\n wbFloat('Width', cpNormal, False, 2),\n wbFloat('Height', cpNormal, False, 2)\n ]),\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation (Quaternion?)', [\n wbFloat('q1'),\n wbFloat('q2'),\n wbFloat('q3'),\n wbFloat('q4')\n ])\n ]),\n\n wbInteger(XSED, 'SpeedTree Seed', itU8),\n\n wbRStruct('Room Data', [\n wbStruct(XRMR, 'Header', [\n wbInteger('Linked Rooms Count', itU16),\n wbByteArray('Unknown', 2)\n ]),\n wbRArrayS('Linked Rooms',\n wbFormIDCk(XLRM, 'Linked Room', [REFR])\n )\n ], []),\n\n wbStruct(XOCP, 'Occlusion Plane Data', [\n wbStruct('Size', [\n wbFloat('Width', cpNormal, False, 2),\n wbFloat('Height', cpNormal, False, 2)\n ]),\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation (Quaternion?)', [\n wbFloat('q1'),\n wbFloat('q2'),\n wbFloat('q3'),\n wbFloat('q4')\n ])\n ]),\n wbArray(XORD, 'Linked Occlusion Planes', wbFormIDCk('Plane', [REFR, NULL]), [\n 'Right',\n 'Left',\n 'Bottom',\n 'Top'\n ]),\n\n wbXLOD,\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot\n ], True, wbPlacedAddInfo, cpNormal, False, wbREFRAfterLoad);\n\n\n wbRecord(REGN, 'Region', [\n wbEDID,\n wbICON,\n wbStruct(RCLR, 'Map Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ], cpNormal, True),\n wbFormIDCkNoReach(WNAM, 'Worldspace', [WRLD]),\n\n wbRArray('Region Areas', wbRStruct('Region Area', [\n wbInteger(RPLI, 'Edge Fall-off', itU32),\n wbArray(RPLD, 'Region Point List Data', wbStruct('Point', [\n wbFloat('X'),\n wbFloat('Y')\n ]), 0, wbRPLDAfterLoad)\n ], [])),\n\n wbRArrayS('Region Data Entries', wbRStructSK([0], 'Region Data Entry', [\n {always starts with an RDAT}\n wbStructSK(RDAT, [0], 'Data Header', [\n wbInteger('Type', itU32, wbEnum([\n {0}'',\n {1}'',\n {2}'Objects',\n {3}'Weather',\n {4}'Map',\n {5}'Land',\n {6}'Grass',\n {7}'Sound',\n {8}'',\n {9}''\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Override'\n ])),\n wbInteger('Priority', itU8),\n wbByteArray('Unused')\n ], cpNormal, True),\n\n {followed by one of these: }\n\n {--- Objects ---}\n wbArray(RDOT, 'Objects', wbStruct('Object', [\n wbFormIDCk('Object', [TREE, STAT, LTEX]),\n wbInteger('Parent Index', itU16, wbHideFFFF),\n wbByteArray('Unused', 2),\n wbFloat('Density'),\n wbInteger('Clustering', itU8),\n wbInteger('Min Slope', itU8),\n wbInteger('Max Slope', itU8),\n wbInteger('Flags', itU8, wbFlags([\n {0}'Conform to slope',\n {1}'Paint Vertices',\n {2}'Size Variance +/-',\n {3}'X +/-',\n {4}'Y +/-',\n {5}'Z +/-',\n {6}'Tree',\n {7}'Huge Rock'\n ])),\n wbInteger('Radius wrt Parent', itU16),\n wbInteger('Radius', itU16),\n wbFloat('Min Height'),\n wbFloat('Max Height'),\n wbFloat('Sink'),\n wbFloat('Sink Variance'),\n wbFloat('Size Variance'),\n wbStruct('Angle Variance', [\n wbInteger('X', itU16),\n wbInteger('Y', itU16),\n wbInteger('Z', itU16)\n ]),\n wbByteArray('Unused', 2),\n wbByteArray('Unknown', 4)\n ]), 0, nil, nil, cpNormal, False, wbREGNObjectsDontShow),\n\n {--- Map ---}\n wbString(RDMP, 'Map Name', 0, cpTranslate, False, wbREGNMapDontShow),\n\n {--- Grass ---}\n wbArrayS(RDGS, 'Grasses', wbStructSK([0], 'Grass', [\n wbFormIDCk('Grass', [GRAS]),\n wbByteArray('Unknown',4)\n ]), 0, cpNormal, False, nil, nil, wbREGNGrassDontShow),\n\n {--- Sound ---}\n wbInteger(RDMD, 'Music Type', itU32, wbMusicEnum, cpIgnore, False, False, wbNeverShow),\n wbFormIDCk(RDMO, 'Music', [MUSC], False, cpNormal, False, wbREGNSoundDontShow),\n wbArrayS(RDSD, 'Sounds', wbStructSK([0], 'Sound', [\n wbFormIDCk('Sound', [SOUN]),\n wbInteger('Flags', itU32, wbFlags([\n 'Pleasant',\n 'Cloudy',\n 'Rainy',\n 'Snowy'\n ])),\n wbInteger('Chance', itU32, wbScaledInt4ToStr, wbScaledInt4ToInt)\n ]), 0, cpNormal, False, nil, nil, wbREGNSoundDontShow),\n\n {--- Weather ---}\n wbArrayS(RDWT, 'Weather Types', wbStructSK([0], 'Weather Type', [\n wbFormIDCk('Weather', [WTHR]),\n wbInteger('Chance', itU32),\n wbFormIDCk('Global', [GLOB, NULL])\n ]), 0, cpNormal, False, nil, nil, wbREGNWeatherDontShow)\n ], []))\n ], True);\n\n wbRecord(SOUN, 'Sound', [\n wbEDIDReq,\n wbOBNDReq,\n wbString(FNAM, 'Sound Filename'),\n wbRUnion('Sound Data', [\n wbStruct(SNDD, 'Sound Data', [\n wbInteger('Minimum Attentuation Distance', itU8, wbMul(5)),\n wbInteger('Maximum Attentuation Distance', itU8, wbMul(100)),\n wbInteger('Frequency Adjustment %', itS8),\n wbByteArray('Unused', 1),\n wbInteger('Flags', itU32, wbFlags([\n {0x0001} 'Random Frequency Shift',\n {0x0002} 'Play At Random',\n {0x0004} 'Environment Ignored',\n {0x0008} 'Random Location',\n {0x0010} 'Loop',\n {0x0020} 'Menu Sound',\n {0x0040} '2D',\n {0x0080} '360 LFE',\n {0x0100} 'Dialogue Sound',\n {0x0200} 'Envelope Fast',\n {0x0400} 'Envelope Slow',\n {0x0800} '2D Radius',\n {0x1000} 'Mute When Submerged'\n ])),\n wbInteger('Static attentuation cdB', itS16),\n wbInteger('Stop time ', itU8),\n wbInteger('Start time ', itU8),\n wbArray('Attenuation Curve', wbInteger('Point', itS16), 5),\n wbInteger('Reverb Attenuation Control', itS16),\n wbInteger('Priority', itS32),\n wbByteArray('Unknown', 8)\n ], cpNormal, True),\n wbStruct(SNDX, 'Sound Data', [\n wbInteger('Minimum attentuation distance', itU8, wbMul(5)),\n wbInteger('Maximum attentuation distance', itU8, wbMul(100)),\n wbInteger('Frequency adjustment %', itS8),\n wbByteArray('Unused', 1),\n wbInteger('Flags', itU32, wbFlags([\n {0x0001} 'Random Frequency Shift',\n {0x0002} 'Play At Random',\n {0x0004} 'Environment Ignored',\n {0x0008} 'Random Location',\n {0x0010} 'Loop',\n {0x0020} 'Menu Sound',\n {0x0040} '2D',\n {0x0080} '360 LFE',\n {0x0100} 'Dialogue Sound',\n {0x0200} 'Envelope Fast',\n {0x0400} 'Envelope Slow',\n {0x0800} '2D Radius',\n {0x1000} 'Mute When Submerged'\n ])),\n wbInteger('Static attentuation cdB', itS16),\n wbInteger('Stop time ', itU8),\n wbInteger('Start time ', itU8)\n ], cpNormal, True)\n ], [], cpNormal, True),\n wbArray(ANAM, 'Attenuation Curve', wbInteger('Point', itS16), 5, nil, nil, cpNormal, False, wbNeverShow),\n wbInteger(GNAM, 'Reverb Attenuation Control', itS16, nil, cpNormal, False, False, wbNeverShow),\n wbInteger(HNAM, 'Priority', itS32, nil, cpNormal, False, False, wbNeverShow)\n ], False, nil, cpNormal, False, wbSOUNAfterLoad);\n\n wbRecord(SPEL, 'Actor Effect', [\n wbEDIDReq,\n wbFULL,\n wbStruct(SPIT, '', [\n wbInteger('Type', itU32, wbEnum([\n {0} 'Actor Effect',\n {1} 'Disease',\n {2} 'Power',\n {3} 'Lesser Power',\n {4} 'Ability',\n {5} 'Poison',\n {6} '',\n {7} '',\n {8} '',\n {9} '',\n {10} 'Addiction'\n ])),\n wbInteger('Cost (Unused)', itU32),\n wbInteger('Level (Unused)', itU32, wbEnum([\n {0} 'Unused'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n {0x00000001} 'No Auto-Calc',\n {0x00000002} 'Immune to Silence 1?',\n {0x00000004} 'PC Start Effect',\n {0x00000008} 'Immune to Silence 2?',\n {0x00000010} 'Area Effect Ignores LOS',\n {0x00000020} 'Script Effect Always Applies',\n {0x00000040} 'Disable Absorb/Reflect',\n {0x00000080} 'Force Touch Explode'\n ])),\n wbByteArray('Unused', 3)\n ], cpNormal, True),\n wbEffectsReq\n ]);\n\n wbRecord(STAT, 'Static', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODL\n ]);\n\n wbRecord(TES4, 'Main File Header', [\n wbStruct(HEDR, 'Header', [\n wbFloat('Version'),\n wbInteger('Number of Records', itU32),\n wbInteger('Next Object ID', itU32)\n ], cpNormal, True),\n wbByteArray(OFST, 'Unknown', 0, cpIgnore),\n wbByteArray(DELE, 'Unknown', 0, cpIgnore),\n wbString(CNAM, 'Author', 0, cpTranslate, True),\n wbString(SNAM, 'Description', 0, cpTranslate),\n wbRArray('Master Files', wbRStruct('Master File', [\n wbString(MAST, 'Filename', 0, cpNormal, True),\n wbByteArray(DATA, 'Unused', 8, cpIgnore, True)\n ], [ONAM])),\n wbArray(ONAM, 'Overriden Forms', wbFormIDCk('Form', [REFR, ACHR, ACRE, PMIS, PBEA, PGRE, LAND, NAVM]), 0, nil, nil, cpNormal, False, wbTES4ONAMDontShow),\n wbByteArray(SCRN, 'Screenshot')\n ], True, nil, cpNormal, True, wbRemoveOFST);\n\n wbRecord(TREE, 'Tree', [\n wbEDIDReq,\n wbOBNDReq,\n wbMODLReq,\n wbICONReq,\n wbArrayS(SNAM, 'SpeedTree Seeds', wbInteger('SpeedTree Seed', itU32), 0, cpNormal, True),\n wbStruct(CNAM, 'Tree Data', [\n wbFloat('Leaf Curvature'),\n wbFloat('Minimum Leaf Angle'),\n wbFloat('Maximum Leaf Angle'),\n wbFloat('Branch Dimming Value'),\n wbFloat('Leaf Dimming Value'),\n wbInteger('Shadow Radius', itS32),\n wbFloat('Rock Speed'),\n wbFloat('Rustle Speed')\n ], cpNormal, True),\n wbStruct(BNAM, 'Billboard Dimensions', [\n wbFloat('Width'),\n wbFloat('Height')\n ], cpNormal, True)\n ]);\nend;\n\nprocedure DefineFO3f;\nbegin\n wbRecord(WATR, 'Water', [\n wbEDIDReq,\n wbFULL,\n wbString(NNAM, 'Noise Map', 0, cpNormal, True),\n wbInteger(ANAM, 'Opacity', itU8, nil, cpNormal, True),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n {0}'Causes Damage',\n {1}'Reflective'\n ]), cpNormal, True),\n wbString(MNAM, 'Material ID', 0, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SOUN]),\n wbFormIDCk(XNAM, 'Actor Effect', [SPEL]),\n wbInteger(DATA, 'Damage', itU16, nil, cpNormal, True, True),\n wbRUnion('Visual Data', [\n wbStruct(DNAM, 'Visual Data', [\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Water Properties - Sun Power'),\n wbFloat('Water Properties - Reflectivity Amount'),\n wbFloat('Water Properties - Fresnel Amount'),\n wbByteArray('Unused', 4),\n wbFloat('Fog Properties - Above Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Above Water - Fog Distance - Far Plane'),\n wbStruct('Shallow Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Deep Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Reflection Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbByteArray('Unused', 4),\n wbFloat('Rain Simulator - Force'),\n wbFloat('Rain Simulator - Velocity'),\n wbFloat('Rain Simulator - Falloff'),\n wbFloat('Rain Simulator - Dampner'),\n wbFloat('Displacement Simulator - Starting Size'),\n wbFloat('Displacement Simulator - Force'),\n wbFloat('Displacement Simulator - Velocity'),\n wbFloat('Displacement Simulator - Falloff'),\n wbFloat('Displacement Simulator - Dampner'),\n wbFloat('Rain Simulator - Starting Size'),\n wbFloat('Noise Properties - Normals - Noise Scale'),\n wbFloat('Noise Properties - Noise Layer One - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer One - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Speed'),\n wbFloat('Noise Properties - Normals - Depth Falloff Start'),\n wbFloat('Noise Properties - Normals - Depth Falloff End'),\n wbFloat('Fog Properties - Above Water - Fog Amount'),\n wbFloat('Noise Properties - Normals - UV Scale'),\n wbFloat('Fog Properties - Under Water - Fog Amount'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Far Plane'),\n wbFloat('Water Properties - Distortion Amount'),\n wbFloat('Water Properties - Shininess'),\n wbFloat('Water Properties - Reflection HDR Multiplier'),\n wbFloat('Water Properties - Light Radius'),\n wbFloat('Water Properties - Light Brightness'),\n wbFloat('Noise Properties - Noise Layer One - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Two - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Three - UV Scale'),\n wbFloat('Noise Properties - Noise Layer One - Amplitude Scale'),\n wbFloat('Noise Properties - Noise Layer Two - Amplitude Scale'),\n wbFloat('Noise Properties - Noise Layer Three - Amplitude Scale')\n ], cpNormal, True, nil, 46),\n wbStruct(DATA, 'Visual Data', [\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Water Properties - Sun Power'),\n wbFloat('Water Properties - Reflectivity Amount'),\n wbFloat('Water Properties - Fresnel Amount'),\n wbByteArray('Unused', 4),\n wbFloat('Fog Properties - Above Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Above Water - Fog Distance - Far Plane'),\n wbStruct('Shallow Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Deep Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbStruct('Reflection Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n wbByteArray('Unused', 4),\n wbFloat('Rain Simulator - Force'),\n wbFloat('Rain Simulator - Velocity'),\n wbFloat('Rain Simulator - Falloff'),\n wbFloat('Rain Simulator - Dampner'),\n wbFloat('Displacement Simulator - Starting Size'),\n wbFloat('Displacement Simulator - Force'),\n wbFloat('Displacement Simulator - Velocity'),\n wbFloat('Displacement Simulator - Falloff'),\n wbFloat('Displacement Simulator - Dampner'),\n wbFloat('Rain Simulator - Starting Size'),\n wbFloat('Noise Properties - Normals - Noise Scale'),\n wbFloat('Noise Properties - Noise Layer One - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Direction'),\n wbFloat('Noise Properties - Noise Layer One - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Two - Wind Speed'),\n wbFloat('Noise Properties - Noise Layer Three - Wind Speed'),\n wbFloat('Noise Properties - Normals - Depth Falloff Start'),\n wbFloat('Noise Properties - Normals - Depth Falloff End'),\n wbFloat('Fog Properties - Above Water - Fog Amount'),\n wbFloat('Noise Properties - Normals - UV Scale'),\n wbFloat('Fog Properties - Under Water - Fog Amount'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Near Plane'),\n wbFloat('Fog Properties - Under Water - Fog Distance - Far Plane'),\n wbFloat('Water Properties - Distortion Amount'),\n wbFloat('Water Properties - Shininess'),\n wbFloat('Water Properties - Reflection HDR Multiplier'),\n wbFloat('Water Properties - Light Radius'),\n wbFloat('Water Properties - Light Brightness'),\n wbFloat('Noise Properties - Noise Layer One - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Two - UV Scale'),\n wbFloat('Noise Properties - Noise Layer Three - UV Scale'),\n wbEmpty('Noise Properties - Noise Layer One - Amplitude Scale'),\n wbEmpty('Noise Properties - Noise Layer Two - Amplitude Scale'),\n wbEmpty('Noise Properties - Noise Layer Three - Amplitude Scale'),\n wbInteger('Damage (Old Format)', itU16)\n ], cpNormal, True)\n ], [], cpNormal, True),\n wbStruct(GNAM, 'Related Waters (Unused)', [\n wbFormIDCk('Daytime', [WATR, NULL]),\n wbFormIDCk('Nighttime', [WATR, NULL]),\n wbFormIDCk('Underwater', [WATR, NULL])\n ], cpNormal, True)\n ], False, nil, cpNormal, False, wbWATRAfterLoad);\n\n wbRecord(WEAP, 'Weapon', [\n wbEDIDReq,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbICON,\n wbSCRI,\n wbEITM,\n wbInteger(EAMT, 'Enchantment Charge Amount', itS16),\n wbFormIDCkNoReach(NAM0, 'Ammo', [AMMO, FLST]),\n wbDEST,\n wbREPL,\n wbETYPReq,\n wbBIPL,\n wbYNAM,\n wbZNAM,\n wbRStruct('Shell Casing Model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO2S\n ], []),\n wbRStruct('Scope Model', [\n wbString(MOD3, 'Model Filename'),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO3S\n ], []),\n wbFormIDCK(EFSD, 'Scope Effect', [EFSH]),\n wbRStruct('World Model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore),\n wbMO4S\n ], []),\n wbString(NNAM, 'Embedded Weapon Node'),\n wbFormIDCk(INAM, 'Impact DataSet', [IPDS]),\n wbFormIDCk(WNAM, '1st Person Model', [STAT]),\n wbFormIDCk(SNAM, 'Sound - Gun - Shoot 3D', [SOUN]),\n wbFormIDCk(XNAM, 'Sound - Gun - Shoot 2D', [SOUN]),\n wbFormIDCk(NAM7, 'Sound - Gun - Shoot 3D Looping', [SOUN]),\n wbFormIDCk(TNAM, 'Sound - Melee - Swing / Gun - No Ammo', [SOUN]),\n wbFormIDCk(NAM6, 'Sound - Block', [SOUN]),\n wbFormIDCk(UNAM, 'Sound - Idle', [SOUN]),\n wbFormIDCk(NAM9, 'Sound - Equip', [SOUN]),\n wbFormIDCk(NAM8, 'Sound - Unequip', [SOUN]),\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbInteger('Health', itS32),\n wbFloat('Weight'),\n wbInteger('Base Damage', itS16),\n wbInteger('Clip Size', itU8)\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n {00} wbInteger('Animation Type', itU32, wbWeaponAnimTypeEnum),\n {04} wbFloat('Animation Multiplier'),\n {08} wbFloat('Reach'),\n {12} wbInteger('Flags 1', itU8, wbFlags([\n 'Ignores Normal Weapon Resistance',\n 'Is Automatic',\n 'Has Scope',\n 'Can''t Drop',\n 'Hide Backpack',\n 'Embedded Weapon',\n 'Don''t Use 1st Person IS Animations',\n 'Non-Playable'\n ])),\n {13} wbInteger('Grip Animation', itU8, wbEnum([\n ], [\n 171, 'HandGrip1',\n 172, 'HandGrip2',\n 173, 'HandGrip3',\n 255, 'DEFAULT'\n ])),\n {14} wbInteger('Ammo Use', itU8),\n {15} wbInteger('Reload Animation', itU8, wbReloadAnimEnum),\n {16} wbFloat('Min Spread'),\n {20} wbFloat('Spread'),\n {24} wbFloat('Unknown'),\n {28} wbFloat('Sight FOV'),\n {32} wbByteArray('Unused', 4),\n {36} wbFormIDCk('Projectile', [PROJ, NULL]),\n {40} wbInteger('Base VATS To-Hit Chance', itU8),\n {41} wbInteger('Attack Animation', itU8, wbEnum([\n ], [\n 26, 'AttackLeft',\n 32, 'AttackRight',\n 38, 'Attack3',\n 44, 'Attack4',\n 50, 'Attack5',\n 56, 'Attack6',\n 62, 'Attack7',\n 68, 'Attack8',\n 74, 'AttackLoop',\n 80, 'AttackSpin',\n 86, 'AttackSpin2',\n 97, 'PlaceMine',\n 103, 'PlaceMine2',\n 109, 'AttackThrow',\n 115, 'AttackThrow2',\n 121, 'AttackThrow3',\n 127, 'AttackThrow4',\n 133, 'AttackThrow5',\n 255, 'DEFAULT'\n ])),\n {42} wbInteger('Projectile Count', itU8),\n {43} wbInteger('Embedded Weapon - Actor Value', itU8, wbEnum([\n {00} 'Perception',\n {01} 'Endurance',\n {02} 'Left Attack',\n {03} 'Right Attack',\n {04} 'Left Mobility',\n {05} 'Right Mobilty',\n {06} 'Brain'\n ])),\n {44} wbFloat('Min Range'),\n {48} wbFloat('Max Range'),\n {52} wbInteger('On Hit', itU32, wbEnum([\n 'Normal formula behavior',\n 'Dismember Only',\n 'Explode Only',\n 'No Dismember/Explode'\n ])),\n {56} wbInteger('Flags 2', itU32, wbFlags([\n {0x00000001}'Player Only',\n {0x00000002}'NPCs Use Ammo',\n {0x00000004}'No Jam After Reload',\n {0x00000008}'Override - Action Points',\n {0x00000010}'Minor Crime',\n {0x00000020}'Range - Fixed',\n {0x00000040}'Not Used In Normal Combat',\n {0x00000080}'Override - Damage to Weapon Mult',\n {0x00000100}'Don''t Use 3rd Person IS Animations',\n {0x00000200}'Short Burst',\n {0x00000400}'Rumble Alternate',\n {0x00000800}'Long Burst'\n ])),\n {60} wbFloat('Animation Attack Multiplier'),\n {64} wbFloat('Fire Rate'),\n {68} wbFloat('Override - Action Points'),\n {72} wbFloat('Rumble - Left Motor Strength'),\n {76} wbFloat('Rumble - Right Motor Strength'),\n {80} wbFloat('Rumble - Duration'),\n {84} wbFloat('Override - Damage to Weapon Mult'),\n {88} wbFloat('Attack Shots/Sec'),\n {92} wbFloat('Reload Time'),\n {96} wbFloat('Jam Time'),\n {100} wbFloat('Aim Arc'),\n {104} wbInteger('Skill', itS32, wbActorValueEnum),\n {108} wbInteger('Rumble - Pattern', itU32, wbEnum([\n 'Constant',\n 'Square',\n 'Triangle',\n 'Sawtooth'\n ])),\n {112} wbFloat('Rumble - Wavelength'),\n {116} wbFloat('Limb Dmg Mult'),\n {120} wbInteger('Resist Type', itS32, wbActorValueEnum),\n {124} wbFloat('Sight Usage'),\n {128} wbFloat('Semi-Automatic Fire Delay Min'),\n {132} wbFloat('Semi-Automatic Fire Delay Max')\n ], cpNormal, True, nil, 36),\n\n wbStruct(CRDT, 'Critical Data', [\n {00} wbInteger('Critical Damage', itU16),\n {09} wbByteArray('Unused', 2),\n {04} wbFloat('Crit % Mult'),\n {08} wbInteger('Flags', itU8, wbFlags([\n 'On Death'\n ])),\n {09} wbByteArray('Unused', 3),\n {12} wbFormIDCk('Effect', [SPEL, NULL])\n ], cpNormal, True),\n wbInteger(VNAM, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ], False, nil, cpNormal, False, wbWEAPAfterLoad);\n\n if wbSimpleRecords then\n wbRecord(WRLD, 'Worldspace', [\n wbEDIDReq,\n wbFULL,\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbRStruct('Parent', [\n wbFormIDCk(WNAM, 'Worldspace', [WRLD]),\n wbStruct(PNAM, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0x00000001}'Use Land Data',\n {0x00000002}'Use LOD Data',\n {0x00000004}'Use Map Data',\n {0x00000008}'Use Water Data',\n {0x00000010}'Use Climate Data',\n {0x00000020}'Use Image Space Data',\n {0x00000040}'',\n {0x00000080}'Needs Water Adjustment'\n ], True)),\n wbByteArray('Unknown', 1)\n ], cpNormal, True)\n ], []),\n wbFormIDCk(CNAM, 'Climate', [CLMT]),\n wbFormIDCk(NAM2, 'Water', [WATR]),\n wbFormIDCk(NAM3, 'LOD Water Type', [WATR]),\n wbFloat(NAM4, 'LOD Water Height'),\n wbStruct(DNAM, 'Land Data', [\n wbFloat('Default Land Height'),\n wbFloat('Default Water Height')\n ]),\n wbICON,\n wbStruct(MNAM, 'Map Data', [\n wbStruct('Usable Dimensions', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32)\n ]),\n wbStruct('Cell Coordinates', [\n wbStruct('NW Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbStruct('SE Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ])\n ])\n ]),\n wbStruct(ONAM, 'World Map Offset Data', [\n wbFloat('World Map Scale'),\n wbFloat('Cell X Offset'),\n wbFloat('Cell Y Offset')\n ], cpNormal, True),\n wbFormIDCk(INAM, 'Image Space', [IMGS]),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n {0x01} 'Small World',\n {0x02} 'Can''t Fast Travel',\n {0x04} '',\n {0x08} '',\n {0x10} 'No LOD Water',\n {0x20} 'No LOD Noise',\n {0x40} 'Don''t Allow NPC Fall Damage',\n {0x80} 'Needs Water Adjustment'\n ]), cpNormal, True),\n wbRStruct('Object Bounds', [\n wbStruct(NAM0, 'Min', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True),\n wbStruct(NAM9, 'Max', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True)\n ], []),\n wbFormIDCk(ZNAM, 'Music', [MUSC]),\n wbString(NNAM, 'Canopy Shadow', 0, cpNormal, True),\n wbString(XNAM, 'Water Noise Texture', 0, cpNormal, True),\n wbRArrayS('Swapped Impacts', wbStructExSK(IMPS, [0, 1], [2], 'Swapped Impact', [\n wbInteger('Material Type', itU32, wbImpactMaterialTypeEnum),\n wbFormIDCkNoReach('Old', [IPCT]),\n wbFormIDCk('New', [IPCT, NULL])\n ])),\n wbArray(IMPF, 'Footstep Materials', wbString('Unknown', 30), [\n 'ConcSolid',\n 'ConcBroken',\n 'MetalSolid',\n 'MetalHollow',\n 'MetalSheet',\n 'Wood',\n 'Sand',\n 'Dirt',\n 'Grass',\n 'Water'\n ]),\n wbByteArray(OFST, 'Offset Data')\n ], False, nil, cpNormal, False, wbRemoveOFST)\n else\n wbRecord(WRLD, 'Worldspace', [\n wbEDIDReq,\n wbFULL,\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbRStruct('Parent', [\n wbFormIDCk(WNAM, 'Worldspace', [WRLD]),\n wbStruct(PNAM, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0x00000001}'Use Land Data',\n {0x00000002}'Use LOD Data',\n {0x00000004}'Use Map Data',\n {0x00000008}'Use Water Data',\n {0x00000010}'Use Climate Data',\n {0x00000020}'Use Image Space Data',\n {0x00000040}'',\n {0x00000080}'Needs Water Adjustment'\n ], True)),\n wbByteArray('Unknown', 1)\n ], cpNormal, True)\n ], []),\n wbFormIDCk(CNAM, 'Climate', [CLMT]),\n wbFormIDCk(NAM2, 'Water', [WATR]),\n wbFormIDCk(NAM3, 'LOD Water Type', [WATR]),\n wbFloat(NAM4, 'LOD Water Height'),\n wbStruct(DNAM, 'Land Data', [\n wbFloat('Default Land Height'),\n wbFloat('Default Water Height')\n ]),\n wbICON,\n wbStruct(MNAM, 'Map Data', [\n wbStruct('Usable Dimensions', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32)\n ]),\n wbStruct('Cell Coordinates', [\n wbStruct('NW Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbStruct('SE Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ])\n ])\n ]),\n wbStruct(ONAM, 'World Map Offset Data', [\n wbFloat('World Map Scale'),\n wbFloat('Cell X Offset'),\n wbFloat('Cell Y Offset')\n ], cpNormal, True),\n wbFormIDCk(INAM, 'Image Space', [IMGS]),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n {0x01} 'Small World',\n {0x02} 'Can''t Fast Travel',\n {0x04} '',\n {0x08} '',\n {0x10} 'No LOD Water',\n {0x20} 'No LOD Noise',\n {0x40} 'Don''t Allow NPC Fall Damage',\n {0x80} 'Needs Water Adjustment'\n ]), cpNormal, True),\n wbRStruct('Object Bounds', [\n wbStruct(NAM0, 'Min', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True),\n wbStruct(NAM9, 'Max', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True)\n ], []),\n wbFormIDCk(ZNAM, 'Music', [MUSC]),\n wbString(NNAM, 'Canopy Shadow', 0, cpNormal, True),\n wbString(XNAM, 'Water Noise Texture', 0, cpNormal, True),\n wbRArrayS('Swapped Impacts', wbStructExSK(IMPS, [0, 1], [2], 'Swapped Impact', [\n wbInteger('Material Type', itU32, wbImpactMaterialTypeEnum),\n wbFormIDCkNoReach('Old', [IPCT]),\n wbFormIDCk('New', [IPCT, NULL])\n ])),\n wbArray(IMPF, 'Footstep Materials', wbString('Unknown', 30), [\n 'ConcSolid',\n 'ConcBroken',\n 'MetalSolid',\n 'MetalHollow',\n 'MetalSheet',\n 'Wood',\n 'Sand',\n 'Dirt',\n 'Grass',\n 'Water'\n ]),\n wbArray(OFST, 'Offset Data', wbArray('Rows', wbInteger('Offset', itU32), wbOffsetDataColsCounter), 0)\n ], False, nil, cpNormal, False, wbRemoveOFST);\n\n wbRecord(WTHR, 'Weather', [\n wbEDIDReq,\n wbFormIDCk(_0_IAD, 'Sunrise Image Space Modifier', [IMAD]),\n wbFormIDCk(_1_IAD, 'Day Image Space Modifier', [IMAD]),\n wbFormIDCk(_2_IAD, 'Sunset Image Space Modifier', [IMAD]),\n wbFormIDCk(_3_IAD, 'Night Image Space Modifier', [IMAD]),\n wbString(DNAM, 'Cloud Textures - Layer 0', 0, cpNormal, True),\n wbString(CNAM, 'Cloud Textures - Layer 1', 0, cpNormal, True),\n wbString(ANAM, 'Cloud Textures - Layer 2', 0, cpNormal, True),\n wbString(BNAM, 'Cloud Textures - Layer 3', 0, cpNormal, True),\n wbMODL,\n wbByteArray(LNAM, 'Unknown', 4, cpNormal, True),\n wbArray(ONAM, 'Cloud Speed', wbInteger('Layer', itU8{, wbDiv(2550)}), 4, nil, nil, cpNormal, True),\n wbArray(PNAM, 'Cloud Layer Colors',\n wbArray('Layer',\n wbStruct('Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n ['Sunrise', 'Day', 'Sunset', 'Night']\n ),\n 4),\n wbArray(NAM0, 'Colors by Types/Times',\n wbArray('Type',\n wbStruct('Time', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]),\n ['Sunrise', 'Day', 'Sunset', 'Night']\n ),\n ['Sky-Upper','Fog','Unused','Ambient','Sunlight','Sun','Stars','Sky-Lower','Horizon','Unused']\n , cpNormal, True),\n wbStruct(FNAM, 'Fog Distance', [\n wbFloat('Day - Near'),\n wbFloat('Day - Far'),\n wbFloat('Night - Near'),\n wbFloat('Night - Far'),\n wbFloat('Day - Power'),\n wbFloat('Night - Fower')\n ], cpNormal, True),\n wbByteArray(INAM, 'Unused', 304, cpIgnore, True),\n wbStruct(DATA, '', [\n wbInteger('Wind Speed', itU8),\n wbInteger('Cloud Speed (Lower)', itU8),\n wbInteger('Cloud Speed (Upper)', itU8),\n wbInteger('Trans Delta', itU8),\n wbInteger('Sun Glare', itU8),\n wbInteger('Sun Damage', itU8),\n wbInteger('Precipitation - Begin Fade In', itU8),\n wbInteger('Precipitation - End Fade Out', itU8),\n wbInteger('Thunder/Lightning - Begin Fade In', itU8),\n wbInteger('Thunder/Lightning - End Fade Out', itU8),\n wbInteger('Thunder/Lightning - Frequency', itU8),\n wbInteger('Weather Classification', itU8, wbWthrDataClassification),\n wbStruct('Lightning Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8)\n ])\n ], cpNormal, True),\n wbRArray('Sounds', wbStruct(SNAM, 'Sound', [\n wbFormIDCk('Sound', [SOUN]),\n wbInteger('Type', itU32, wbEnum([\n {0}'Default',\n {1}'Precip',\n {2}'Wind',\n {3}'Thunder'\n ]))\n ]))\n ]);\n\n wbAddGroupOrder(GMST);\n wbAddGroupOrder(TXST);\n wbAddGroupOrder(MICN);\n wbAddGroupOrder(GLOB);\n wbAddGroupOrder(CLAS);\n wbAddGroupOrder(FACT);\n wbAddGroupOrder(HDPT);\n wbAddGroupOrder(HAIR);\n wbAddGroupOrder(EYES);\n wbAddGroupOrder(RACE);\n wbAddGroupOrder(SOUN);\n wbAddGroupOrder(ASPC);\n wbAddGroupOrder(MGEF);\n wbAddGroupOrder(SCPT);\n wbAddGroupOrder(LTEX);\n wbAddGroupOrder(ENCH);\n wbAddGroupOrder(SPEL);\n wbAddGroupOrder(ACTI);\n wbAddGroupOrder(TACT);\n wbAddGroupOrder(TERM);\n wbAddGroupOrder(ARMO);\n wbAddGroupOrder(BOOK);\n wbAddGroupOrder(CONT);\n wbAddGroupOrder(DOOR);\n wbAddGroupOrder(INGR);\n wbAddGroupOrder(LIGH);\n wbAddGroupOrder(MISC);\n wbAddGroupOrder(STAT);\n wbAddGroupOrder(SCOL);\n wbAddGroupOrder(MSTT);\n wbAddGroupOrder(PWAT);\n wbAddGroupOrder(GRAS);\n wbAddGroupOrder(TREE);\n wbAddGroupOrder(FURN);\n wbAddGroupOrder(WEAP);\n wbAddGroupOrder(AMMO);\n wbAddGroupOrder(NPC_);\n wbAddGroupOrder(CREA);\n wbAddGroupOrder(LVLC);\n wbAddGroupOrder(LVLN);\n wbAddGroupOrder(KEYM);\n wbAddGroupOrder(ALCH);\n wbAddGroupOrder(IDLM);\n wbAddGroupOrder(NOTE);\n wbAddGroupOrder(PROJ);\n wbAddGroupOrder(LVLI);\n wbAddGroupOrder(WTHR);\n wbAddGroupOrder(CLMT);\n wbAddGroupOrder(COBJ);\n wbAddGroupOrder(REGN);\n wbAddGroupOrder(NAVI);\n wbAddGroupOrder(CELL);\n wbAddGroupOrder(WRLD);\n wbAddGroupOrder(DIAL);\n wbAddGroupOrder(QUST);\n wbAddGroupOrder(IDLE);\n wbAddGroupOrder(PACK);\n wbAddGroupOrder(CSTY);\n wbAddGroupOrder(LSCR);\n wbAddGroupOrder(ANIO);\n wbAddGroupOrder(WATR);\n wbAddGroupOrder(EFSH);\n wbAddGroupOrder(EXPL);\n wbAddGroupOrder(DEBR);\n wbAddGroupOrder(IMGS);\n wbAddGroupOrder(IMAD);\n wbAddGroupOrder(FLST);\n wbAddGroupOrder(PERK);\n wbAddGroupOrder(BPTD);\n wbAddGroupOrder(ADDN);\n wbAddGroupOrder(AVIF);\n wbAddGroupOrder(RADS);\n wbAddGroupOrder(CAMS);\n wbAddGroupOrder(CPTH);\n wbAddGroupOrder(VTYP);\n wbAddGroupOrder(IPCT);\n wbAddGroupOrder(IPDS);\n wbAddGroupOrder(ARMA);\n wbAddGroupOrder(ECZN);\n wbAddGroupOrder(MESG);\n wbAddGroupOrder(RGDL);\n wbAddGroupOrder(DOBJ);\n wbAddGroupOrder(LGTM);\n wbAddGroupOrder(MUSC);\nend;\n\nprocedure DefineFO3;\nbegin\n DefineFO3a;\n DefineFO3b;\n DefineFO3c;\n DefineFO3d;\n DefineFO3e;\n DefineFO3f;\nend;\n\nend.\n"
},
{
"path": "lib/xedit/wbDefinitionsFO4.pas",
"content": "{*******************************************************************************\n\n The contents of this file are subject to the Mozilla Public License\n Version 1.1 (the \"License\"); you may not use this file except in\n compliance with the License. You may obtain a copy of the License at\n http://www.mozilla.org/MPL/\n\n Software distributed under the License is distributed on an \"AS IS\"\n basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the\n License for the specific language governing rights and limitations\n under the License.\n\n*******************************************************************************}\n\nunit wbDefinitionsFO4;\n\n{$I wbDefines.inc}\n\ninterface\n\nuses\n wbInterface;\n\nvar\n\twbBipedObjectFlags: IwbFlagsDef;\n\twbEquipType: IwbFlagsDef;\n\twbFurnitureEntryTypeFlags: IwbFlagsDef;\n\twbPKDTFlags: IwbFlagsDef;\n\twbPKDTInterruptFlags: IwbFlagsDef;\n\twbSMNodeFlags: IwbFlagsDef;\n\n\twbActorPropertyEnum: IwbEnumDef;\n\twbAdvanceActionEnum: IwbEnumDef;\n\twbStaggerEnum: IwbEnumDef;\n\twbAlignmentEnum: IwbEnumDef;\n\twbArmorPropertyEnum: IwbEnumDef;\n\twbAxisEnum: IwbEnumDef;\n\twbBipedObjectEnum: IwbEnumDef;\n\twbBlendModeEnum: IwbEnumDef;\n\twbBlendOpEnum: IwbEnumDef;\n\twbBodyPartIndexEnum: IwbEnumDef;\n\twbCastEnum: IwbEnumDef;\n\twbCastingSourceEnum: IwbEnumDef;\n\twbCrimeTypeEnum: IwbEnumDef;\n\twbCriticalStageEnum: IwbEnumDef;\n\twbEmotionTypeEnum: IwbEnumDef;\n\twbEntryPointsEnum: IwbEnumDef;\n\twbEventFunctionEnum: IwbEnumDef;\n\twbEventMemberEnum: IwbEnumDef;\n\twbFormTypeEnum: IwbEnumDef;\n\twbFurnitureAnimTypeEnum: IwbEnumDef;\n\twbLocationEnum: IwbEnumDef;\n\twbMiscStatEnum: IwbEnumDef;\n\twbMusicEnum: IwbEnumDef;\n wbObjectModProperties: IwbArrayDef;\n\twbObjectTypeEnum: IwbEnumDef;\n\twbPropTypeEnum: IwbEnumDef;\n\twbQuadrantEnum: IwbEnumDef;\n\twbSexEnum: IwbEnumDef;\n\twbSkillEnum: IwbEnumDef;\n\twbSoulGemEnum: IwbEnumDef;\n\twbSoundLevelEnum: IwbEnumDef;\n\twbTargetEnum: IwbEnumDef;\n\twbVatsValueFunctionEnum: IwbEnumDef;\n\twbWardStateEnum: IwbEnumDef;\n\twbWeaponAnimTypeEnum: IwbEnumDef;\n\twbWeaponPropertyEnum: IwbEnumDef;\n\twbZTestFuncEnum: IwbEnumDef;\n wbKeywordTypeEnum: IwbEnumDef;\n wbReverbClassEnum: IwbEnumDef;\n wbHitBehaviourEnum: IwbEnumDef;\n wbBoolEnum: IwbEnumDef;\n\nprocedure DefineFO4;\n\nimplementation\n\nuses\n Types,\n Classes,\n SysUtils,\n Math,\n Variants,\n wbHelpers;\n\nconst\n _00_IAD: TwbSignature = #$00'IAD';\n _01_IAD: TwbSignature = #$01'IAD';\n _02_IAD: TwbSignature = #$02'IAD';\n _03_IAD: TwbSignature = #$03'IAD';\n _04_IAD: TwbSignature = #$04'IAD';\n _05_IAD: TwbSignature = #$05'IAD';\n _06_IAD: TwbSignature = #$06'IAD';\n _07_IAD: TwbSignature = #$07'IAD';\n _08_IAD: TwbSignature = #$08'IAD';\n _09_IAD: TwbSignature = #$09'IAD';\n _0A_IAD: TwbSignature = #$0A'IAD';\n _0B_IAD: TwbSignature = #$0B'IAD';\n _0C_IAD: TwbSignature = #$0C'IAD';\n _0D_IAD: TwbSignature = #$0D'IAD';\n _0E_IAD: TwbSignature = #$0E'IAD';\n _0F_IAD: TwbSignature = #$0F'IAD';\n _10_IAD: TwbSignature = #$10'IAD';\n _11_IAD: TwbSignature = #$11'IAD';\n _12_IAD: TwbSignature = #$12'IAD';\n _13_IAD: TwbSignature = #$13'IAD';\n _14_IAD: TwbSignature = #$14'IAD';\n _40_IAD: TwbSignature = #$40'IAD';\n _41_IAD: TwbSignature = #$41'IAD';\n _42_IAD: TwbSignature = #$42'IAD';\n _43_IAD: TwbSignature = #$43'IAD';\n _44_IAD: TwbSignature = #$44'IAD';\n _45_IAD: TwbSignature = #$45'IAD';\n _46_IAD: TwbSignature = #$46'IAD';\n _47_IAD: TwbSignature = #$47'IAD';\n _48_IAD: TwbSignature = #$48'IAD';\n _49_IAD: TwbSignature = #$49'IAD';\n _4A_IAD: TwbSignature = #$4A'IAD';\n _4B_IAD: TwbSignature = #$4B'IAD';\n _4C_IAD: TwbSignature = #$4C'IAD';\n _4D_IAD: TwbSignature = #$4D'IAD';\n _4E_IAD: TwbSignature = #$4E'IAD';\n _4F_IAD: TwbSignature = #$4F'IAD';\n _50_IAD: TwbSignature = #$50'IAD';\n _51_IAD: TwbSignature = #$51'IAD';\n _52_IAD: TwbSignature = #$52'IAD';\n _53_IAD: TwbSignature = #$53'IAD';\n _54_IAD: TwbSignature = #$54'IAD';\n\n{00TX} _00_0TX: TwbSignature = #$30'0TX';\n{10TX} _10_0TX: TwbSignature = #$31'0TX';\n{20TX} _20_0TX: TwbSignature = #$32'0TX';\n{30TX} _30_0TX: TwbSignature = #$33'0TX';\n{40TX} _40_0TX: TwbSignature = #$34'0TX';\n{50TX} _50_0TX: TwbSignature = #$35'0TX';\n{60TX} _60_0TX: TwbSignature = #$36'0TX';\n{70TX} _70_0TX: TwbSignature = #$37'0TX';\n{80TX} _80_0TX: TwbSignature = #$38'0TX';\n{90TX} _90_0TX: TwbSignature = #$39'0TX';\n{:0TX} _3A_0TX: TwbSignature = #$3A'0TX';\n{;0TX} _3B_0TX: TwbSignature = #$3B'0TX';\n{<0TX} _3C_0TX: TwbSignature = #$3C'0TX';\n{=0TX} _3D_0TX: TwbSignature = #$3D'0TX';\n{>0TX} _3E_0TX: TwbSignature = #$3E'0TX';\n{?0TX} _3F_0TX: TwbSignature = #$3F'0TX';\n{@0TX} _40h_0TX: TwbSignature = #$40'0TX';\n{A0TX} A0TX: TwbSignature = 'A0TX';\n{B0TX} B0TX: TwbSignature = 'B0TX';\n{C0TX} C0TX: TwbSignature = 'C0TX';\n{D0TX} D0TX: TwbSignature = 'D0TX';\n{E0TX} E0TX: TwbSignature = 'E0TX';\n{F0TX} F0TX: TwbSignature = 'F0TX';\n{G0TX} G0TX: TwbSignature = 'G0TX';\n{H0TX} H0TX: TwbSignature = 'H0TX';\n{I0TX} I0TX: TwbSignature = 'I0TX';\n{J0TX} J0TX: TwbSignature = 'J0TX';\n{K0TX} K0TX: TwbSignature = 'K0TX';\n{L0TX} L0TX: TwbSignature = 'L0TX';\n\n AACT : TwbSignature = 'AACT';\n ACBS : TwbSignature = 'ACBS';\n ACEC : TwbSignature = 'ACEC'; { New To Dawnguard }\n ACEP : TwbSignature = 'ACEP'; { New To Dawnguard }\n ACHR : TwbSignature = 'ACHR';\n ACID : TwbSignature = 'ACID'; { New To Dawnguard }\n ACPR : TwbSignature = 'ACPR'; { New To Skyrim }\n ACSR : TwbSignature = 'ACSR'; { New To Dawnguard }\n ACTI : TwbSignature = 'ACTI';\n ACTV : TwbSignature = 'ACTV'; { New To Fallout 4 }\n ACUN : TwbSignature = 'ACUN'; { New To Dawnguard }\n ADDN : TwbSignature = 'ADDN';\n AECH : TwbSignature = 'AECH'; { New To Fallout 4 }\n AHCF : TwbSignature = 'AHCF'; { New To Skyrim }\n AHCM : TwbSignature = 'AHCM'; { New To Skyrim }\n AIDT : TwbSignature = 'AIDT';\n ALCA : TwbSignature = 'ALCA'; { New To Skyrim }\n ALCC : TwbSignature = 'ALCC'; { New To Fallout 4 }\n ALCH : TwbSignature = 'ALCH';\n ALCL : TwbSignature = 'ALCL'; { New To Skyrim }\n ALCO : TwbSignature = 'ALCO'; { New To Skyrim }\n ALCS : TwbSignature = 'ALCS'; { New To Fallout 4 }\n ALDI : TwbSignature = 'ALDI'; { New To Fallout 4 }\n ALDN : TwbSignature = 'ALDN'; { New To Skyrim }\n ALEA : TwbSignature = 'ALEA'; { New To Skyrim }\n ALED : TwbSignature = 'ALED'; { New To Skyrim }\n ALEQ : TwbSignature = 'ALEQ'; { New To Skyrim }\n ALFA : TwbSignature = 'ALFA'; { New To Skyrim }\n ALFC : TwbSignature = 'ALFC'; { New To Skyrim }\n ALFD : TwbSignature = 'ALFD'; { New To Skyrim }\n ALFE : TwbSignature = 'ALFE'; { New To Skyrim }\n ALFI : TwbSignature = 'ALFI'; { New To Skyrim }\n ALFL : TwbSignature = 'ALFL'; { New To Skyrim }\n ALFR : TwbSignature = 'ALFR'; { New To Skyrim }\n ALFV : TwbSignature = 'ALFV'; { New To Fallout 4 }\n ALID : TwbSignature = 'ALID'; { New To Skyrim }\n ALLA : TwbSignature = 'ALLA'; { New To Fallout 4 }\n ALLS : TwbSignature = 'ALLS'; { New To Skyrim }\n ALMI : TwbSignature = 'ALMI'; { New To Fallout 4 }\n ALNA : TwbSignature = 'ALNA'; { New To Skyrim }\n ALNT : TwbSignature = 'ALNT'; { New To Skyrim }\n ALPC : TwbSignature = 'ALPC'; { New To Skyrim }\n ALRT : TwbSignature = 'ALRT'; { New To Skyrim }\n ALSP : TwbSignature = 'ALSP'; { New To Skyrim }\n ALST : TwbSignature = 'ALST'; { New To Skyrim }\n ALUA : TwbSignature = 'ALUA'; { New To Skyrim }\n AMDL : TwbSignature = 'AMDL'; { New To Fallout 4 }\n AMMO : TwbSignature = 'AMMO';\n ANAM : TwbSignature = 'ANAM';\n ANIO : TwbSignature = 'ANIO';\n AOR2 : TwbSignature = 'AOR2'; { New To Fallout 4 }\n AORU : TwbSignature = 'AORU'; { New To Fallout 4 }\n APPR : TwbSignature = 'APPR'; { New To Fallout 4 }\n ARMA : TwbSignature = 'ARMA';\n ARMO : TwbSignature = 'ARMO';\n ARTO : TwbSignature = 'ARTO';\n ASPC : TwbSignature = 'ASPC';\n ASTP : TwbSignature = 'ASTP';\n ATKD : TwbSignature = 'ATKD'; { New to Skyrim }\n ATKE : TwbSignature = 'ATKE'; { New to Skyrim }\n ATKR : TwbSignature = 'ATKR'; { New to Skyrim }\n ATKT : TwbSignature = 'ATKT'; { New To Fallout 4 }\n ATKS : TwbSignature = 'ATKS'; { New To Fallout 4 }\n ATKW : TwbSignature = 'ATKW'; { New To Fallout 4 }\n ATTN : TwbSignature = 'ATTN'; { New To Fallout 4 }\n ATTX : TwbSignature = 'ATTX'; { New To Fallout 4 }\n ATXT : TwbSignature = 'ATXT';\n AVFL : TwbSignature = 'AVFL'; { New To Fallout 4 }\n AVIF : TwbSignature = 'AVIF';\n AVSK : TwbSignature = 'AVSK'; { New to Skyrim }\n BAMT : TwbSignature = 'BAMT'; { New to Skyrim }\n BCLF : TwbSignature = 'BCLF'; { New to Fallout 4 }\n BIDS : TwbSignature = 'BIDS'; { New to Skyrim }\n BIPL : TwbSignature = 'BIPL';\n BMCT : TwbSignature = 'BMCT';\n BMMP : TwbSignature = 'BMMP'; { New to Fallout 4 }\n BNAM : TwbSignature = 'BNAM';\n BNDS : TwbSignature = 'BNDS'; { New to Fallout 4 }\n BOD2 : TwbSignature = 'BOD2'; { New to Skyrim 1.6.91 CK}\n BODT : TwbSignature = 'BODT'; { New to Skyrim }\n BOOK : TwbSignature = 'BOOK';\n BPND : TwbSignature = 'BPND';\n BPNI : TwbSignature = 'BPNI';\n BPNN : TwbSignature = 'BPNN';\n BPNT : TwbSignature = 'BPNT';\n BPTD : TwbSignature = 'BPTD';\n BPTN : TwbSignature = 'BPTN';\n BSIZ : TwbSignature = 'BSIZ'; { New to Fallout 4 }\n BSMB : TwbSignature = 'BSMB'; { New to Fallout 4 }\n BSMP : TwbSignature = 'BSMP'; { New to Fallout 4 }\n BSMS : TwbSignature = 'BSMS'; { New to Fallout 4 }\n BTXT : TwbSignature = 'BTXT';\n CAMS : TwbSignature = 'CAMS';\n CDIX : TwbSignature = 'CDIX'; { New to Fallout 4 }\n CELL : TwbSignature = 'CELL';\n CIS1 : TwbSignature = 'CIS1'; { New to Skyrim }\n CIS2 : TwbSignature = 'CIS2'; { New to Skyrim }\n CITC : TwbSignature = 'CITC'; { New to Skyrim }\n CLAS : TwbSignature = 'CLAS';\n CLFM : TwbSignature = 'CLFM';\n CLMT : TwbSignature = 'CLMT';\n CLSZ : TwbSignature = 'CLSZ'; { New to Fallout 4 }\n CMPO : TwbSignature = 'CMPO'; { New to Fallout 4 }\n CNAM : TwbSignature = 'CNAM';\n CNTO : TwbSignature = 'CNTO';\n COBJ : TwbSignature = 'COBJ';\n COCT : TwbSignature = 'COCT'; { New to Skyrim 'Count'}\n COED : TwbSignature = 'COED';\n COLL : TwbSignature = 'COLL';\n CONT : TwbSignature = 'CONT';\n CPTH : TwbSignature = 'CPTH';\n CRDT : TwbSignature = 'CRDT';\n CRGR : TwbSignature = 'CRGR'; { New to Skyrim }\n CRIF : TwbSignature = 'CRIF'; { New to Skyrim }\n CRIS : TwbSignature = 'CRIS'; { New to Fallout 4 }\n CRVA : TwbSignature = 'CRVA'; { New to Skyrim }\n CS2H : TwbSignature = 'CS2H'; { New To Fallout 4 }\n CS2D : TwbSignature = 'CS2D'; { New To Fallout 4 }\n CS2E : TwbSignature = 'CS2E'; { New To Fallout 4 }\n CS2F : TwbSignature = 'CS2F'; { New To Fallout 4 }\n CS2K : TwbSignature = 'CS2K'; { New To Fallout 4 }\n CSCR : TwbSignature = 'CSCR';\n CSCV : TwbSignature = 'CSCV'; { New To Fallout 4 }\n CSDC : TwbSignature = 'CSDC';\n CSDI : TwbSignature = 'CSDI';\n CSDT : TwbSignature = 'CSDT';\n CSFL : TwbSignature = 'CSFL'; { New to Skyrim }\n CSGD : TwbSignature = 'CSGD'; { New to Skyrim }\n CSLR : TwbSignature = 'CSLR'; { New to Skyrim }\n CSMD : TwbSignature = 'CSMD'; { New to Skyrim }\n CSME : TwbSignature = 'CSME'; { New to Skyrim }\n CSRA : TwbSignature = 'CSRA'; { New To Fallout 4 }\n CSTY : TwbSignature = 'CSTY';\n CTDA : TwbSignature = 'CTDA';\n CUSD : TwbSignature = 'CUSD'; { New to Fallout 4 }\n CVPA : TwbSignature = 'CVPA'; { New to Fallout 4 }\n DALC : TwbSignature = 'DALC'; { New to Skyrim }\n DAMA : TwbSignature = 'DAMA'; { New to Fallout 4 }\n DAMC : TwbSignature = 'DAMC'; { New to Fallout 4 }\n DATA : TwbSignature = 'DATA';\n DEBR : TwbSignature = 'DEBR';\n DELE : TwbSignature = 'DELE';\n DEMO : TwbSignature = 'DEMO'; { New to Skyrim }\n DESC : TwbSignature = 'DESC';\n DEST : TwbSignature = 'DEST';\n DEVA : TwbSignature = 'DEVA'; { New to Skyrim }\n DFOB : TwbSignature = 'DFOB'; { New to Fallout 4 }\n DFTF : TwbSignature = 'DFTF'; { New To Skyrim }\n DFTM : TwbSignature = 'DFTM'; { New To Skyrim }\n DIAL : TwbSignature = 'DIAL';\n DLBR : TwbSignature = 'DLBR';\n DLVW : TwbSignature = 'DLVW';\n DMAX : TwbSignature = 'DMAX'; { New to Skyrim }\n DMDC : TwbSignature = 'DMDC'; { New to Fallout 4 }\n DMDL : TwbSignature = 'DMDL';\n DMDS : TwbSignature = 'DMDS'; { New to Skyrim }\n DMDT : TwbSignature = 'DMDT';\n DMGT : TwbSignature = 'DMGT'; { New to Fallout 4 }\n DMIN : TwbSignature = 'DMIN'; { New to Skyrim }\n DNAM : TwbSignature = 'DNAM';\n DOBJ : TwbSignature = 'DOBJ';\n DODT : TwbSignature = 'DODT';\n DOFT : TwbSignature = 'DOFT'; { New to Skyrim }\n DOOR : TwbSignature = 'DOOR';\n DPLT : TwbSignature = 'DPLT'; { New to Skyrim }\n DSTA : TwbSignature = 'DSTA'; { New To Fallout 4 }\n DSTD : TwbSignature = 'DSTD';\n DSTF : TwbSignature = 'DSTF';\n DTGT : TwbSignature = 'DTGT'; { New To Fallout 4 }\n DTID : TwbSignature = 'DTID'; { New To Fallout 4 }\n DUAL : TwbSignature = 'DUAL';\n EAMT : TwbSignature = 'EAMT';\n ECOR : TwbSignature = 'ECOR'; { New to Skyrim }\n ECZN : TwbSignature = 'ECZN';\n EDID : TwbSignature = 'EDID';\n EFID : TwbSignature = 'EFID';\n EFIT : TwbSignature = 'EFIT';\n EFSH : TwbSignature = 'EFSH';\n EITM : TwbSignature = 'EITM';\n ENAM : TwbSignature = 'ENAM';\n ENCH : TwbSignature = 'ENCH';\n ENIT : TwbSignature = 'ENIT';\n EPF2 : TwbSignature = 'EPF2';\n EPF3 : TwbSignature = 'EPF3';\n EPFB : TwbSignature = 'EPFB'; { New To Fallout 4 }\n EPFD : TwbSignature = 'EPFD';\n EPFT : TwbSignature = 'EPFT';\n EQUP : TwbSignature = 'EQUP';\n ESCE : TwbSignature = 'ESCE';\n ETYP : TwbSignature = 'ETYP';\n EXPL : TwbSignature = 'EXPL';\n EYES : TwbSignature = 'EYES';\n FACT : TwbSignature = 'FACT';\n FCHT : TwbSignature = 'FCHT'; { New to Skyrim }\n FCPL : TwbSignature = 'FCPL'; { New To Fallout 4 }\n FFFF : TwbSignature = 'FFFF';\n FIMD : TwbSignature = 'FIMD'; { New To Fallout 4 }\n FLMV : TwbSignature = 'FLMV'; { New to Skyrim }\n FLOR : TwbSignature = 'FLOR';\n FLST : TwbSignature = 'FLST';\n FLTR : TwbSignature = 'FLTR'; { New to Skyrim }\n FLTV : TwbSignature = 'FLTV';\n FMIN : TwbSignature = 'FMIN'; { New To Fallout 4 }\n FMRI : TwbSignature = 'FMRI'; { New To Fallout 4 }\n FMRN : TwbSignature = 'FMRN'; { New To Fallout 4 }\n FMRS : TwbSignature = 'FMRS'; { New To Fallout 4 }\n FNAM : TwbSignature = 'FNAM';\n FNMK : TwbSignature = 'FNMK'; { New to Skyrim }\n FNPR : TwbSignature = 'FNPR'; { New to Skyrim }\n FPRT : TwbSignature = 'FPRT'; { New to Skyrim }\n FSTP : TwbSignature = 'FSTP';\n FSTS : TwbSignature = 'FSTS';\n FTSF : TwbSignature = 'FTSF'; { New to Skyrim }\n FTSM : TwbSignature = 'FTSM'; { New to Skyrim }\n FTST : TwbSignature = 'FTST'; { New to Skyrim }\n FTYP : TwbSignature = 'FTYP'; { New To Fallout 4 }\n FULL : TwbSignature = 'FULL';\n FURN : TwbSignature = 'FURN';\n FVPA : TwbSignature = 'FVPA'; { New To Fallout 4 }\n GDRY : TwbSignature = 'GDRY'; { New to Fallout 4 }\n GLOB : TwbSignature = 'GLOB';\n GMST : TwbSignature = 'GMST';\n GNAM : TwbSignature = 'GNAM';\n GRAS : TwbSignature = 'GRAS';\n GREE : TwbSignature = 'GREE'; { New to Fallout 4 }\n GWOR : TwbSignature = 'GWOR'; { New to Skyrim }\n HAZD : TwbSignature = 'HAZD';\n HCLF : TwbSignature = 'HCLF'; { New to Skyrim }\n HDPT : TwbSignature = 'HDPT';\n HEAD : TwbSignature = 'HEAD'; { New to Skyrim }\n HEDR : TwbSignature = 'HEDR';\n HLTX : TwbSignature = 'HLTX'; { New to Fallout 4 }\n HNAM : TwbSignature = 'HNAM';\n HTID : TwbSignature = 'HTID'; { New to Skyrim }\n ICO2 : TwbSignature = 'ICO2';\n ICON : TwbSignature = 'ICON';\n IDLA : TwbSignature = 'IDLA';\n IDLB : TwbSignature = 'IDLB';\n IDLC : TwbSignature = 'IDLC';\n IDLE : TwbSignature = 'IDLE';\n IDLF : TwbSignature = 'IDLF';\n IDLM : TwbSignature = 'IDLM';\n IDLT : TwbSignature = 'IDLT';\n IMAD : TwbSignature = 'IMAD';\n IMGS : TwbSignature = 'IMGS';\n IMSP : TwbSignature = 'IMSP'; { New to Skyrim }\n INAM : TwbSignature = 'INAM';\n INCC : TwbSignature = 'INCC'; { New to Skyrim }\n INDX : TwbSignature = 'INDX';\n INFO : TwbSignature = 'INFO';\n INGR : TwbSignature = 'INGR';\n INNR : TwbSignature = 'INNR'; { New To Fallout 4 }\n INRD : TwbSignature = 'INRD'; { New To Fallout 4 }\n INTT : TwbSignature = 'INTT'; { New To Fallout 4 }\n INTV : TwbSignature = 'INTV';\n IOVR : TwbSignature = 'IOVR'; { New To Fallout 4 }\n IPCT : TwbSignature = 'IPCT';\n IPDS : TwbSignature = 'IPDS';\n ISIZ : TwbSignature = 'ISIZ'; { New To Fallout 4 }\n ITID : TwbSignature = 'ITID'; { New To Fallout 4 }\n ITMC : TwbSignature = 'ITMC'; { New To Fallout 4 }\n ITME : TwbSignature = 'ITME'; { New To Fallout 4 }\n ITMS : TwbSignature = 'ITMS'; { New To Fallout 4 }\n ITXT : TwbSignature = 'ITXT';\n JAIL : TwbSignature = 'JAIL'; { New To Skyrim }\n JNAM : TwbSignature = 'JNAM';\n JOUT : TwbSignature = 'JOUT'; { New To Skyrim }\n KEYM : TwbSignature = 'KEYM';\n KNAM : TwbSignature = 'KNAM';\n KSIZ : TwbSignature = 'KSIZ';\n KSSM : TwbSignature = 'KSSM'; { New To Fallout 4 }\n KWDA : TwbSignature = 'KWDA';\n KYWD : TwbSignature = 'KYWD';\n LAND : TwbSignature = 'LAND';\n LAYR : TwbSignature = 'LAYR'; { New to Fallout 4 }\n LCEC : TwbSignature = 'LCEC'; { New to Skyrim }\n LCEP : TwbSignature = 'LCEP'; { New to Skyrim }\n LCID : TwbSignature = 'LCID'; { New to Skyrim }\n LCPR : TwbSignature = 'LCPR'; { New to Skyrim }\n LCRT : TwbSignature = 'LCRT';\n LCSR : TwbSignature = 'LCSR'; { New to Skyrim }\n LCTN : TwbSignature = 'LCTN';\n LCUN : TwbSignature = 'LCUN'; { New to Skyrim }\n LENS : TwbSignature = 'LENS'; { New to Fallout 4 }\n LFSD : TwbSignature = 'LFSD'; { New to Fallout 4 }\n LFSP : TwbSignature = 'LFSP'; { New to Fallout 4 }\n LGTM : TwbSignature = 'LGTM';\n LIGH : TwbSignature = 'LIGH';\n LLCT : TwbSignature = 'LLCT'; {New to Skyrim, part of LVLI 'Count'}\n LLKC : TwbSignature = 'LLKC'; { New to Fallout 4 }\n LNAM : TwbSignature = 'LNAM';\n LSCR : TwbSignature = 'LSCR';\n LSPR : TwbSignature = 'LSPR'; { New to Fallout 4 }\n LTEX : TwbSignature = 'LTEX';\n LTMP : TwbSignature = 'LTMP';\n LTPT : TwbSignature = 'LTPT'; { New to Fallout 4 }\n LTPC : TwbSignature = 'LTPC'; { New to Fallout 4 }\n LVLC : TwbSignature = 'LVLC';\n LVLD : TwbSignature = 'LVLD';\n LVLF : TwbSignature = 'LVLF';\n LVLG : TwbSignature = 'LVLG';\n LVLI : TwbSignature = 'LVLI';\n LVLM : TwbSignature = 'LVLM'; { New to Fallout 4 }\n LVLN : TwbSignature = 'LVLN';\n LVLO : TwbSignature = 'LVLO';\n LVSG : TwbSignature = 'LVSG'; { New to Fallout 4 }\n LVSP : TwbSignature = 'LVSP';\n MASE : TwbSignature = 'MASE'; { New To Fallout 4 }\n MAST : TwbSignature = 'MAST';\n MATO : TwbSignature = 'MATO';\n MATT : TwbSignature = 'MATT';\n MCHT : TwbSignature = 'MCHT'; { New to Skyrim }\n MDOB : TwbSignature = 'MDOB';\n MESG : TwbSignature = 'MESG';\n MGEF : TwbSignature = 'MGEF';\n MHDT : TwbSignature = 'MHDT'; { New to Skyrim }\n MIC2 : TwbSignature = 'MIC2';\n MICN : TwbSignature = 'MICN'; { New to Fallout 4 }\n MICO : TwbSignature = 'MICO';\n MISC : TwbSignature = 'MISC';\n MLSI : TwbSignature = 'MLSI'; { New to Fallout 4 }\n MNAM : TwbSignature = 'MNAM';\n MO2C : TwbSignature = 'MO2C'; { New to Fallout 4 }\n MO2F : TwbSignature = 'MO2F'; { New to Fallout 4 }\n MO2S : TwbSignature = 'MO2S';\n MO2T : TwbSignature = 'MO2T';\n MO3C : TwbSignature = 'MO3C'; { New to Fallout 4 }\n MO3F : TwbSignature = 'MO3F'; { New to Fallout 4 }\n MO3S : TwbSignature = 'MO3S';\n MO3T : TwbSignature = 'MO3T';\n MO4C : TwbSignature = 'MO4C'; { New to Fallout 4 }\n MO4F : TwbSignature = 'MO4F'; { New to Fallout 4 }\n MO4S : TwbSignature = 'MO4S';\n MO4T : TwbSignature = 'MO4T';\n MO5C : TwbSignature = 'MO5C'; { New to Fallout 4 }\n MO5F : TwbSignature = 'MO5F'; { New to Fallout 4 }\n MO5S : TwbSignature = 'MO5S'; { New to Skyrim }\n MO5T : TwbSignature = 'MO5T'; { New to Skyrim }\n MOD2 : TwbSignature = 'MOD2';\n MOD3 : TwbSignature = 'MOD3';\n MOD4 : TwbSignature = 'MOD4';\n MOD5 : TwbSignature = 'MOD5'; { New to Skyrim }\n MODC : TwbSignature = 'MODC'; { New to Fallout 4 }\n MODF : TwbSignature = 'MODF'; { New to Fallout 4 }\n MODL : TwbSignature = 'MODL';\n MODS : TwbSignature = 'MODS';\n MODT : TwbSignature = 'MODT';\n MODQ : TwbSignature = 'MODQ'; { New to Fallout 4 }\n MOVT : TwbSignature = 'MOVT';\n MPAI : TwbSignature = 'MPAI'; { New To Skyrim }\n MPAV : TwbSignature = 'MPAV'; { New To Skyrim }\n MPCD : TwbSignature = 'MPCD'; { New to Fallout 4 }\n MPGN : TwbSignature = 'MPGN'; { New to Fallout 4 }\n MPGS : TwbSignature = 'MPGS'; { New to Fallout 4 }\n MPPC : TwbSignature = 'MPPC'; { New to Fallout 4 }\n MPPF : TwbSignature = 'MPPF'; { New to Fallout 4 }\n MPPI : TwbSignature = 'MPPI'; { New to Fallout 4 }\n MPPK : TwbSignature = 'MPPK'; { New to Fallout 4 }\n MPPM : TwbSignature = 'MPPM'; { New to Fallout 4 }\n MPPN : TwbSignature = 'MPPN'; { New to Fallout 4 }\n MPPT : TwbSignature = 'MPPT'; { New to Fallout 4 }\n MPRT : TwbSignature = 'MPRT'; { New to Skyrim }\n MRSV : TwbSignature = 'MRSV'; { New to Fallout 4 }\n MSDK : TwbSignature = 'MSDK'; { New to Fallout 4 }\n MSDV : TwbSignature = 'MSDV'; { New to Fallout 4 }\n MSID : TwbSignature = 'MSID'; { New to Fallout 4 }\n MSM0 : TwbSignature = 'MSM0'; { New to Fallout 4 }\n MSM1 : TwbSignature = 'MSM1'; { New to Fallout 4 }\n MSTT : TwbSignature = 'MSTT';\n MSWP : TwbSignature = 'MSWP'; { New to Fallout 4 }\n MTNM : TwbSignature = 'MTNM'; { New to Skyrim }\n MTYP : TwbSignature = 'MTYP'; { New To Skyrim }\n MUSC : TwbSignature = 'MUSC';\n MUST : TwbSignature = 'MUST';\n MWGT : TwbSignature = 'MWGT'; { New to Fallout 4 }\n NAM0 : TwbSignature = 'NAM0';\n NAM1 : TwbSignature = 'NAM1';\n NAM2 : TwbSignature = 'NAM2';\n NAM3 : TwbSignature = 'NAM3';\n NAM4 : TwbSignature = 'NAM4';\n NAM5 : TwbSignature = 'NAM5';\n NAM6 : TwbSignature = 'NAM6';\n NAM7 : TwbSignature = 'NAM7';\n NAM8 : TwbSignature = 'NAM8';\n NAM9 : TwbSignature = 'NAM9';\n NAMA : TwbSignature = 'NAMA'; { New to Skyrim }\n NAME : TwbSignature = 'NAME';\n NAVI : TwbSignature = 'NAVI';\n NAVM : TwbSignature = 'NAVM';\n NETO : TwbSignature = 'NETO'; { New to Fallout 4 }\n NEXT : TwbSignature = 'NEXT';\n NNAM : TwbSignature = 'NNAM';\n NNGT : TwbSignature = 'NNGT'; { New to Fallout 4 }\n NNGS : TwbSignature = 'NNGS'; { New to Fallout 4 }\n NNUS : TwbSignature = 'NNUS'; { New to Fallout 4 }\n NNUT : TwbSignature = 'NNUT'; { New to Fallout 4 }\n NOCM : TwbSignature = 'NOCM'; { New to Fallout 4 }\n NONE : TwbSignature = 'NONE'; { New to Fallout 4, used in OMOD Form Type }\n NOTE : TwbSignature = 'NOTE'; { New to Fallout 4 }\n NPC_ : TwbSignature = 'NPC_';\n NPOS : TwbSignature = 'NPOS'; { New to Fallout 4 }\n NPOT : TwbSignature = 'NPOT'; { New to Fallout 4 }\n NQUS : TwbSignature = 'NQUS'; { New to Fallout 4 }\n NQUT : TwbSignature = 'NQUT'; { New to Fallout 4 }\n NTOP : TwbSignature = 'NTOP'; { New to Fallout 4 }\n NTRM : TwbSignature = 'NTRM'; { New to Fallout 4 }\n NULL : TwbSignature = 'NULL';\n NVER : TwbSignature = 'NVER';\n NVMI : TwbSignature = 'NVMI';\n NVNM : TwbSignature = 'NVNM'; { New to Skyrim }\n NVPP : TwbSignature = 'NVPP'; { New to Skyrim }\n NVSI : TwbSignature = 'NVSI'; { New to Dawnguard }\n OBND : TwbSignature = 'OBND';\n OBTE : TwbSignature = 'OBTE'; { New to Fallout 4 }\n OBTF : TwbSignature = 'OBTF'; { New to Fallout 4 }\n OBTS : TwbSignature = 'OBTS'; { New to Fallout 4 }\n OCOR : TwbSignature = 'OCOR'; { New to Skyrim }\n OFST : TwbSignature = 'OFST';\n OMOD : TwbSignature = 'OMOD'; { New to Fallout 4 }\n ONAM : TwbSignature = 'ONAM';\n OTFT : TwbSignature = 'OTFT';\n OVIS : TwbSignature = 'OVIS'; { New to Fallout 4 }\n PACK : TwbSignature = 'PACK';\n PARW : TwbSignature = 'PARW'; { New to Skyrim }\n PBAR : TwbSignature = 'PBAR'; { New to Skyrim }\n PBEA : TwbSignature = 'PBEA'; { New to Skyrim }\n PCMB : TwbSignature = 'PCMB'; { New to Fallout 4 }\n PCON : TwbSignature = 'PCON'; { New to Skyrim }\n PDTO : TwbSignature = 'PDTO'; { New to Skyrim }\n PERK : TwbSignature = 'PERK';\n PFIG : TwbSignature = 'PFIG';\n PFLA : TwbSignature = 'PFLA'; { New to Skyrim }\n PFO2 : TwbSignature = 'PFO2'; { New to Skyrim }\n PFOR : TwbSignature = 'PFOR'; { New to Skyrim }\n PFPC : TwbSignature = 'PFPC';\n PFRN : TwbSignature = 'PFRN'; { New to Fallout 4 }\n PGRE : TwbSignature = 'PGRE';\n PHTN : TwbSignature = 'PHTN'; { New to Skyrim }\n PHWT : TwbSignature = 'PHWT'; { New to Skyrim }\n PHZD : TwbSignature = 'PHZD';\n PKC2 : TwbSignature = 'PKC2'; { New to Skyrim }\n PKCU : TwbSignature = 'PKCU'; { New to Skyrim }\n PKDT : TwbSignature = 'PKDT';\n PKID : TwbSignature = 'PKID';\n PKIN : TwbSignature = 'PKIN'; { New to Fallout 4 }\n PLCN : TwbSignature = 'PLCN'; { New to Skyrim }\n PLDT : TwbSignature = 'PLDT';\n PLVD : TwbSignature = 'PLVD'; { New to Skyrim }\n PLYR : TwbSignature = 'PLYR';\n PMIS : TwbSignature = 'PMIS';\n PNAM : TwbSignature = 'PNAM';\n POBA : TwbSignature = 'POBA';\n POCA : TwbSignature = 'POCA';\n POEA : TwbSignature = 'POEA';\n PRCB : TwbSignature = 'PRCB'; { New to Skyrim }\n PRKC : TwbSignature = 'PRKC';\n PRKE : TwbSignature = 'PRKE';\n PRKF : TwbSignature = 'PRKF';\n PRKR : TwbSignature = 'PRKR'; { New to Skyrim }\n PRKZ : TwbSignature = 'PRKZ'; { New to Skyrim }\n PROJ : TwbSignature = 'PROJ';\n PRPS : TwbSignature = 'PRPS'; { New to Fallout 4 }\n PSDT : TwbSignature = 'PSDT';\n PTDA : TwbSignature = 'PTDA'; { New to Skyrim }\n PTOP : TwbSignature = 'PTOP'; { New to Fallout 4 }\n PTRN : TwbSignature = 'PTRN'; { New to Fallout 4 }\n QNAM : TwbSignature = 'QNAM';\n QOBJ : TwbSignature = 'QOBJ';\n QSDT : TwbSignature = 'QSDT';\n QSTA : TwbSignature = 'QSTA';\n QSTI : TwbSignature = 'QSTI'; { New to Fallout 4 }\n QTGL : TwbSignature = 'QTGL'; { New To Skyrim }\n QTOP : TwbSignature = 'QTOP'; { New to Fallout 4 }\n QUAL : TwbSignature = 'QUAL'; { New To Skyrim }\n QUST : TwbSignature = 'QUST';\n RACE : TwbSignature = 'RACE';\n RADR : TwbSignature = 'RADR'; { New To Fallout 4 }\n RBPC : TwbSignature = 'RBPC'; { New To Fallout 4 }\n RCEC : TwbSignature = 'RCEC'; { New To Skyrim }\n RCLR : TwbSignature = 'RCLR';\n RCPR : TwbSignature = 'RCPR'; { New to Dawnguard }\n RCSR : TwbSignature = 'RCSR'; { New To Skyrim }\n RCUN : TwbSignature = 'RCUN'; { New To Skyrim }\n RDAT : TwbSignature = 'RDAT';\n RDGS : TwbSignature = 'RDGS';\n RDMO : TwbSignature = 'RDMO';\n RDMP : TwbSignature = 'RDMP';\n RDOT : TwbSignature = 'RDOT';\n RDSA : TwbSignature = 'RDSA'; { New to Skyrim }\n RDWT : TwbSignature = 'RDWT';\n REFR : TwbSignature = 'REFR';\n REGN : TwbSignature = 'REGN';\n RELA : TwbSignature = 'RELA';\n REPL : TwbSignature = 'REPL';\n REPT : TwbSignature = 'REPT'; { New To Fallout 4 }\n REVB : TwbSignature = 'REVB';\n RFCT : TwbSignature = 'RFCT';\n RFGP : TwbSignature = 'RFGP'; { New to Fallout 4 }\n RGDL : TwbSignature = 'RGDL'; { Unused in Skyrim, but contained in Skyrim.esm }\n RLDM : TwbSignature = 'RLDM'; { New to Fallout 4 }\n RNAM : TwbSignature = 'RNAM';\n RNMV : TwbSignature = 'RNMV'; { New to Skyrim }\n RPLD : TwbSignature = 'RPLD';\n RPLI : TwbSignature = 'RPLI';\n RPRF : TwbSignature = 'RPRF'; { New To Skyrim }\n RPRM : TwbSignature = 'RPRM'; { New To Skyrim }\n RVIS : TwbSignature = 'RVIS'; { New to Fallout 4 }\n SADD : TwbSignature = 'SADD'; { New To Fallout 4 }\n SAKD : TwbSignature = 'SAKD'; { New To Fallout 4 }\n SAPT : TwbSignature = 'SAPT'; { New To Fallout 4 }\n SCCO : TwbSignature = 'SCCO'; { New To Fallout 4 }\n SCDA : TwbSignature = 'SCDA';\n SCEN : TwbSignature = 'SCEN';\n SCHR : TwbSignature = 'SCHR';\n SCOL : TwbSignature = 'SCOL'; { Unused in Skyrim, but contained in Skyrim.esm }\n SCPT : TwbSignature = 'SCPT'; { Unused in Skyrim, but contained in Skyrim.esm }\n SCQS : TwbSignature = 'SCQS'; { New To Fallout 4 }\n SCRL : TwbSignature = 'SCRL';\n SCRN : TwbSignature = 'SCRN';\n SCRO : TwbSignature = 'SCRO';\n SCSN : TwbSignature = 'SCSN'; { New To Fallout 4 }\n SCTX : TwbSignature = 'SCTX';\n SDSC : TwbSignature = 'SDSC'; { New to Skyrim }\n SGNM : TwbSignature = 'SGNM'; { New to Fallout 4 }\n SHOU : TwbSignature = 'SHOU';\n SHRT : TwbSignature = 'SHRT'; { New to Skyrim }\n SKIL : TwbSignature = 'SKIL'; { New to Fallout 4 }\n SLCP : TwbSignature = 'SLCP';\n SLGM : TwbSignature = 'SLGM';\n SMBN : TwbSignature = 'SMBN';\n SMEN : TwbSignature = 'SMEN';\n SMQN : TwbSignature = 'SMQN';\n SNAM : TwbSignature = 'SNAM';\n SNCT : TwbSignature = 'SNCT';\n SNDD : TwbSignature = 'SNDD';\n SNDR : TwbSignature = 'SNDR';\n SNMV : TwbSignature = 'SNMV'; { New to Skyrim }\n SOFT : TwbSignature = 'SOFT'; { New to Skyrim }\n SOPM : TwbSignature = 'SOPM';\n SOUL : TwbSignature = 'SOUL';\n SOUN : TwbSignature = 'SOUN';\n SPCT : TwbSignature = 'SPCT'; { New to Skyrim }\n SPED : TwbSignature = 'SPED'; { New To Skyrim }\n SPEL : TwbSignature = 'SPEL';\n SPGD : TwbSignature = 'SPGD';\n SPIT : TwbSignature = 'SPIT';\n SPLO : TwbSignature = 'SPLO';\n SPMV : TwbSignature = 'SPMV'; { New To Skyrim }\n SPOR : TwbSignature = 'SPOR'; { New to Skyrim }\n SRAC : TwbSignature = 'SRAC'; { New to Fallout 4 }\n SRAF : TwbSignature = 'SRAF'; { New to Fallout 4 }\n SSPN : TwbSignature = 'SSPN'; { New to Fallout 4 }\n STAG : TwbSignature = 'STAG'; { New to Fallout 4 }\n STAT : TwbSignature = 'STAT';\n STCP : TwbSignature = 'STCP'; { New to Fallout 4 }\n STKD : TwbSignature = 'STKD'; { New to Fallout 4 }\n STOL : TwbSignature = 'STOL'; { New to Skyrim }\n STOP : TwbSignature = 'STOP'; { New to Fallout 4 }\n STSC : TwbSignature = 'STSC'; { New to Fallout 4 }\n SWMV : TwbSignature = 'SWMV'; { New to Skyrim }\n TACT : TwbSignature = 'TACT';\n TCLT : TwbSignature = 'TCLT';\n TERM : TwbSignature = 'TERM'; { New to Fallout 4 }\n TES4 : TwbSignature = 'TES4';\n TETI : TwbSignature = 'TETI'; { New to Fallout 4 }\n TEND : TwbSignature = 'TEND'; { New to Fallout 4 }\n TIAS : TwbSignature = 'TIAS'; { New to Skyrim }\n TIFC : TwbSignature = 'TIFC'; { New To Skyrim }\n TINC : TwbSignature = 'TINC'; { New to Skyrim }\n TIND : TwbSignature = 'TIND'; { New to Skyrim }\n TINI : TwbSignature = 'TINI'; { New to Skyrim }\n TINL : TwbSignature = 'TINL'; { New to Skyrim }\n TINP : TwbSignature = 'TINP'; { New to Skyrim }\n TINT : TwbSignature = 'TINT'; { New to Skyrim }\n TINV : TwbSignature = 'TINV'; { New to Skyrim }\n TIQS : TwbSignature = 'TIQS'; { New to Fallout 4 }\n TIRS : TwbSignature = 'TIRS'; { New to Skyrim }\n TLOD : TwbSignature = 'TLOD'; { New to Fallout 4 }\n TNAM : TwbSignature = 'TNAM';\n TOFT : TwbSignature = 'TOFT'; { New to Fallout 4 }\n TPIC : TwbSignature = 'TPIC';\n TPLT : TwbSignature = 'TPLT';\n TPTA : TwbSignature = 'TPTA'; { New To Fallout 4 }\n TRDA : TwbSignature = 'TRDA'; { New To Fallout 4 }\n TRDT : TwbSignature = 'TRDT';\n TREE : TwbSignature = 'TREE';\n TRNS : TwbSignature = 'TRNS'; { New To Fallout 4 }\n TSCE : TwbSignature = 'TSCE'; { New To Fallout 4 }\n TTEB : TwbSignature = 'TTEB'; { New To Fallout 4 }\n TTEC : TwbSignature = 'TTEC'; { New To Fallout 4 }\n TTED : TwbSignature = 'TTED'; { New To Fallout 4 }\n TTEF : TwbSignature = 'TTEF'; { New To Fallout 4 }\n TTET : TwbSignature = 'TTET'; { New To Fallout 4 }\n TTGE : TwbSignature = 'TTGE'; { New To Fallout 4 }\n TTGP : TwbSignature = 'TTGP'; { New To Fallout 4 }\n TVDT : TwbSignature = 'TVDT'; { New To Skyrim }\n TWAT : TwbSignature = 'TWAT'; { New To Skyrim }\n TX00 : TwbSignature = 'TX00';\n TX01 : TwbSignature = 'TX01';\n TX02 : TwbSignature = 'TX02';\n TX03 : TwbSignature = 'TX03';\n TX04 : TwbSignature = 'TX04';\n TX05 : TwbSignature = 'TX05';\n TX06 : TwbSignature = 'TX06'; { New To Skyrim }\n TX07 : TwbSignature = 'TX07'; { New To Skyrim }\n TXST : TwbSignature = 'TXST';\n UNAM : TwbSignature = 'UNAM';\n UNES : TwbSignature = 'UNES'; { New To Skyrim }\n UNWP : TwbSignature = 'UNWP'; { New To Fallout 4 }\n VATS : TwbSignature = 'VATS';\n VCLR : TwbSignature = 'VCLR';\n VENC : TwbSignature = 'VENC'; { New To Skyrim }\n VEND : TwbSignature = 'VEND'; { New To Skyrim }\n VENV : TwbSignature = 'VENV'; { New To Skyrim }\n VHGT : TwbSignature = 'VHGT';\n VISI : TwbSignature = 'VISI'; { New To Fallout 4 }\n VMAD : TwbSignature = 'VMAD';\n VNAM : TwbSignature = 'VNAM';\n VNML : TwbSignature = 'VNML';\n VTCK : TwbSignature = 'VTCK';\n VTEX : TwbSignature = 'VTEX';\n VTXT : TwbSignature = 'VTXT';\n VTYP : TwbSignature = 'VTYP';\n WAIT : TwbSignature = 'WAIT'; { New To Skyrim }\n WAMD : TwbSignature = 'WAMD'; { New To Fallout 4 }\n WATR : TwbSignature = 'WATR';\n WBDT : TwbSignature = 'WBDT'; { New to Skyrim }\n WCTR : TwbSignature = 'WCTR'; { New To Skyrim }\n WEAP : TwbSignature = 'WEAP';\n WGDR : TwbSignature = 'WGDR'; { New To Fallout 4 }\n WKMV : TwbSignature = 'WKMV'; { New to Skyrim }\n WLEV : TwbSignature = 'WLEV'; { New To Fallout 4 }\n WLST : TwbSignature = 'WLST';\n WMAP : TwbSignature = 'WMAP'; { New To Fallout 4 }\n WNAM : TwbSignature = 'WNAM';\n WOOP : TwbSignature = 'WOOP';\n WRLD : TwbSignature = 'WRLD';\n WTHR : TwbSignature = 'WTHR';\n WZMD : TwbSignature = 'WZMD'; { New To Fallout 4 }\n XACT : TwbSignature = 'XACT';\n XALP : TwbSignature = 'XALP'; { New To Skyrim }\n XAMC : TwbSignature = 'XAMC'; { New To Fallout 4 }\n XAPD : TwbSignature = 'XAPD';\n XAPR : TwbSignature = 'XAPR';\n XASP : TwbSignature = 'XASP'; { New To Fallout 4 }\n XATP : TwbSignature = 'XATP'; { New To Fallout 4 }\n XATR : TwbSignature = 'XATR'; { New To Dawnguard }\n XBSD : TwbSignature = 'XBSD'; { New To Fallout 4 }\n XCAS : TwbSignature = 'XCAS';\n XCCM : TwbSignature = 'XCCM';\n XCHG : TwbSignature = 'XCHG';\n XCIM : TwbSignature = 'XCIM';\n XCLC : TwbSignature = 'XCLC';\n XCLL : TwbSignature = 'XCLL';\n XCLP : TwbSignature = 'XCLP';\n XCLR : TwbSignature = 'XCLR';\n XCLW : TwbSignature = 'XCLW';\n XCMO : TwbSignature = 'XCMO';\n XCNT : TwbSignature = 'XCNT';\n XCRI : TwbSignature = 'XCRI'; { New To Fallout 4 }\n XCVL : TwbSignature = 'XCVL'; { New To Skyrim }\n XCVR : TwbSignature = 'XCVR'; { New To Fallout 4 }\n XCWT : TwbSignature = 'XCWT';\n XCZA : TwbSignature = 'XCZA'; { New To Skyrim }\n XCZC : TwbSignature = 'XCZC'; { New To Skyrim }\n XCZR : TwbSignature = 'XCZR'; { New To Skyrim }\n XDCR : TwbSignature = 'XDCR';\n XEMI : TwbSignature = 'XEMI';\n XESP : TwbSignature = 'XESP';\n XEZN : TwbSignature = 'XEZN';\n XFVC : TwbSignature = 'XFVC'; { New To Skyrim }\n XGDR : TwbSignature = 'XGDR'; { New To Fallout 4 }\n XGLB : TwbSignature = 'XGLB';\n XHLP : TwbSignature = 'XHLP';\n XHLT : TwbSignature = 'XHLT'; { New To Fallout 4 }\n XHOR : TwbSignature = 'XHOR'; { New To Skyrim }\n XHTW : TwbSignature = 'XHTW'; { New To Skyrim }\n XIBS : TwbSignature = 'XIBS';\n XILL : TwbSignature = 'XILL'; { New To Skyrim }\n XILW : TwbSignature = 'XILW'; { New To Fallout 4 }\n XIS2 : TwbSignature = 'XIS2'; { New To Skyrim }\n XLCM : TwbSignature = 'XLCM';\n XLCN : TwbSignature = 'XLCN'; { New To Skyrim }\n XLIB : TwbSignature = 'XLIB'; { New To Skyrim }\n XLIG : TwbSignature = 'XLIG'; { New To Skyrim }\n XLKR : TwbSignature = 'XLKR';\n XLKT : TwbSignature = 'XLKT'; { New To Fallout 4 }\n XLOC : TwbSignature = 'XLOC';\n XLOD : TwbSignature = 'XLOD';\n XLRL : TwbSignature = 'XLRL'; { New To Skyrim }\n XLRM : TwbSignature = 'XLRM';\n XLRT : TwbSignature = 'XLRT'; { New To Skyrim }\n XLTW : TwbSignature = 'XLTW';\n XLYR : TwbSignature = 'XLYR'; { New To Fallout 4 }\n XMBO : TwbSignature = 'XMBO';\n XMBP : TwbSignature = 'XMBP';\n XMBR : TwbSignature = 'XMBR';\n XMRC : TwbSignature = 'XMRC';\n XMRK : TwbSignature = 'XMRK';\n XMSP : TwbSignature = 'XMSP'; { New To Fallout 4 }\n XNAM : TwbSignature = 'XNAM';\n XNDP : TwbSignature = 'XNDP';\n XOCP : TwbSignature = 'XOCP';\n XORD : TwbSignature = 'XORD';\n XOWN : TwbSignature = 'XOWN';\n XPDD : TwbSignature = 'XPDD'; { New To Fallout 4 }\n XPLK : TwbSignature = 'XPLK'; { New To Fallout 4 }\n XPOD : TwbSignature = 'XPOD';\n XPPA : TwbSignature = 'XPPA';\n XPRD : TwbSignature = 'XPRD';\n XPRI : TwbSignature = 'XPRI'; { New To Fallout 4 }\n XPRM : TwbSignature = 'XPRM';\n XPTL : TwbSignature = 'XPTL';\n XPWR : TwbSignature = 'XPWR';\n XRDO : TwbSignature = 'XRDO'; { New To Fallout 4 }\n XRDS : TwbSignature = 'XRDS';\n XRFG : TwbSignature = 'XRFG'; { New To Fallout 4 }\n XRGB : TwbSignature = 'XRGB';\n XRGD : TwbSignature = 'XRGD';\n XRMR : TwbSignature = 'XRMR';\n XRNK : TwbSignature = 'XRNK';\n XSCL : TwbSignature = 'XSCL';\n XSPC : TwbSignature = 'XSPC'; { New To Skyrim }\n XTEL : TwbSignature = 'XTEL';\n XTNM : TwbSignature = 'XTNM'; { New To Skyrim }\n XTRI : TwbSignature = 'XTRI';\n XWCN : TwbSignature = 'XWCN'; { New To Skyrim }\n XWCS : TwbSignature = 'XWCS'; { New To Skyrim }\n XWCU : TwbSignature = 'XWCU'; { New To Skyrim }\n XWEM : TwbSignature = 'XWEM'; { New To Skyrim }\n XWPG : TwbSignature = 'XWPG'; { New To Fallout 4 }\n XWPN : TwbSignature = 'XWPN'; { New To Fallout 4 }\n XXXX : TwbSignature = 'XXXX';\n YNAM : TwbSignature = 'YNAM';\n ZNAM : TwbSignature = 'ZNAM';\n ZOOM : TwbSignature = 'ZOOM'; { New To Fallout 4 }\n\n // signatures of reference records\n sigReferences : array [0..11] of TwbSignature = (\n 'NULL', 'PLYR', 'ACHR', 'REFR', 'PGRE', 'PHZD',\n 'PMIS', 'PARW', 'PBAR', 'PBEA', 'PCON', 'PFLA'\n );\n\n // signatures of referenceable records (placed by references or constructable)\n sigBaseObjects : array [0..43] of TwbSignature = (\n 'NULL', 'ACTI', 'ADDN', 'ALCH', 'AMMO', 'ARMO',\n 'ARTO', 'ASPC', 'BNDS', 'BOOK', 'CMPO', 'COBJ',\n 'CONT', 'DEBR', 'DOOR', 'EXPL', 'FLST', 'FLOR',\n 'FURN', 'HAZD', 'IDLM', 'INGR', 'KEYM', 'LIGH',\n 'LVLI', 'LVLN', 'LVSP', 'MISC', 'MSTT', 'NOTE',\n 'NPC_', 'OMOD', 'PROJ', 'SCOL', 'SCRL', 'SOUN',\n 'SPEL', 'STAT', 'TACT', 'TERM', 'TREE', 'TXST',\n 'WATR', 'WEAP'\n );\n\nvar\n wbPKDTSpecificFlagsUnused : Boolean;\n wbEDID: IwbSubRecordDef;\n wbCOED: IwbSubRecordDef;\n wbXLCM: IwbSubRecordDef;\n wbEITM: IwbSubRecordDef;\n wbOBND: IwbSubRecordDef;\n wbOBNDReq: IwbSubRecordDef;\n wbDEST: IwbSubRecordStructDef;\n wbDESTActor: IwbSubRecordStructDef;\n wbDODT: IwbSubRecordDef;\n wbXRGD: IwbSubRecordDef;\n wbXRGB: IwbSubRecordDef;\n wbSPLO: IwbSubRecordDef;\n wbSPLOs: IwbSubRecordArrayDef;\n wbCNTO: IwbSubRecordStructDef;\n wbCNTOs: IwbSubRecordArrayDef;\n wbAIDT: IwbSubRecordDef;\n wbFULL: IwbSubRecordDef;\n wbFULLActor: IwbSubRecordDef;\n wbFULLReq: IwbSubRecordDef;\n wbDESC: IwbSubRecordDef;\n wbDESCReq: IwbSubRecordDef;\n wbXSCL: IwbSubRecordDef;\n wbDATAPosRot: IwbSubRecordDef;\n wbPosRot: IwbStructDef;\n wbMODC: IwbSubRecordDef;\n wbMODF: IwbSubRecordDef;\n wbMODL: IwbSubRecordStructDef;\n wbMODS: IwbSubRecordDef;\n wbMO2S: IwbSubRecordDef;\n wbMO3S: IwbSubRecordDef;\n wbMO4S: IwbSubRecordDef;\n wbMO2F: IwbSubRecordDef;\n wbMO3F: IwbSubRecordDef;\n wbMO4F: IwbSubRecordDef;\n wbMO5F: IwbSubRecordDef;\n wbMO2C: IwbSubRecordDef;\n wbMO3C: IwbSubRecordDef;\n wbMO4C: IwbSubRecordDef;\n wbMO5C: IwbSubRecordDef;\n wbMODLActor: IwbSubRecordStructDef;\n wbMODLReq: IwbSubRecordStructDef;\n wbCTDA: IwbSubRecordStructDef;\n wbCTDAs: IwbSubRecordArrayDef;\n wbCTDAsReq: IwbSubRecordArrayDef;\n wbCTDAsCount: IwbSubRecordArrayDef;\n wbCTDAsReqCount: IwbSubRecordArrayDef;\n wbXLOD: IwbSubRecordDef;\n wbXESP: IwbSubRecordDef;\n wbICON: IwbSubRecordDef;\n wbMICO: IwbSubRecordDef;\n wbActorValue: IwbIntegerDef;\n wbETYP: IwbSubRecordDef;\n wbETYPReq: IwbSubRecordDef;\n wbEFID: IwbSubRecordDef;\n wbEFIT: IwbSubRecordDef;\n wbEffectsReq: IwbSubRecordArrayDef;\n wbFirstPersonFlagsU32: IwbIntegerDef;\n wbBOD2: IwbSubRecordDef;\n wbScriptEntry: IwbStructDef;\n wbScriptFlags: IwbIntegerDef;\n wbScriptPropertyObject: IwbUnionDef;\n\twbScriptPropertyStruct: IwbArrayDef;\n\twbScriptProperties: IwbArrayDef;\n wbScriptFragments: IwbStructDef;\n wbScriptFragmentsQuest: IwbStructDef;\n wbScriptFragmentsInfo: IwbStructDef;\n wbScriptFragmentsPack: IwbStructDef;\n wbScriptFragmentsScen: IwbStructDef;\n wbPLDT: IwbSubRecordDef;\n wbPLVD: IwbSubRecordDef;\n wbTargetData: IwbStructDef;\n wbAttackData: IwbSubRecordStructDef;\n wbLLCT: IwbSubRecordDef;\n wbLVLD: IwbSubRecordDef;\n wbVMAD: IwbSubRecordDef;\n wbVMADFragmentedPERK: IwbSubRecordDef;\n wbVMADFragmentedPACK: IwbSubRecordDef;\n wbVMADFragmentedQUST: IwbSubRecordDef;\n wbVMADFragmentedSCEN: IwbSubRecordDef;\n wbVMADFragmentedINFO: IwbSubRecordDef;\n wbCOCT: IwbSubRecordDef;\n wbKSIZ: IwbSubRecordDef;\n wbKWDAs: IwbSubRecordDef;\n wbReqKWDAs: IwbSubRecordDef;\n wbKeywords: IwbSubRecordStructDef;\n wbCNAM: IwbSubRecordDef;\n wbCITC: IwbSubRecordDef;\n wbMGEFData: IwbSubRecordStructDef;\n wbMGEFType: IwbIntegerDef;\n wbMDOB: IwbSubRecordDef;\n wbSPIT: IwbSubRecordDef;\n wbDMDC: IwbSubRecordDef;\n wbDMDS: IwbSubRecordDef;\n wbMO5S: IwbSubRecordDef;\n wbSPCT: IwbSubRecordDef;\n wbMODT: IwbSubRecordDef;\n wbDMDT: IwbSubRecordDef;\n wbXOWN: IwbSubRecordDef;\n wbXRNK: IwbSubRecordDef;\n wbPhonemeTargets: IwbSubRecordDef;\n wbPHWT: IwbSubRecordStructDef;\n wbHeadPart: IwbSubRecordStructDef;\n wbQUSTAliasFlags: IwbSubRecordDef;\n wbPDTO: IwbSubRecordDef;\n wbPDTOs: IwbSubRecordArrayDef;\n wbUNAMs: IwbSubRecordArrayDef;\n wbNull: IwbValueDef;\n wbTimeInterpolator: IwbStructDef;\n wbColorInterpolator: IwbStructDef;\n wbYNAM: IwbSubRecordDef;\n wbZNAM: IwbSubRecordDef;\n wbSPED: IwbSubRecordDef;\n wbCUSD: IwbSubRecordDef;\n wbINRD: IwbSubRecordDef;\n wbPTRN: IwbSubRecordDef;\n wbNTRM: IwbSubRecordDef;\n wbPRPS: IwbSubRecordDef;\n wbFLTR: IwbSubRecordDef;\n wbAPPR: IwbSubRecordDef;\n wbObjectTemplate: IwbSubRecordStructDef;\n wbBSMPSequence: IwbSubRecordArrayDef;\n wbFTYP: IwbSubRecordDef;\n wbATTX: IwbSubRecordDef;\n wbMNAMFurnitureMarker: IwbSubRecordDef;\n wbSNAMMarkerParams: IwbSubRecordDef;\n wbOBTSReq: IwbSubRecordDef;\n //wbTintTemplateGroups: IwbSubrecordArrayDef;\n //wbMorphGroups: IwbSubrecordArrayDef;\n //wbRaceFRMI: IwbSubrecordArrayDef;\n wbRaceRBPC: IwbSubRecordDef;\n wbNVNM: IwbSubRecordDef;\n wbMaxHeightDataCELL: IwbSubRecordDef;\n wbMaxHeightDataWRLD: IwbSubRecordDef;\n wbOFST: IwbSubRecordDef;\n\nfunction Sig2Int(aSignature: TwbSignature): Cardinal; inline;\nbegin\n Result := PCardinal(@aSignature)^;\nend;\n\nfunction wbEPFDActorValueToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n AsCardinal : Cardinal;\n AsFloat : Single;\nbegin\n AsCardinal := aInt;\n AsFloat := PSingle(@AsCardinal)^;\n aInt := Round(AsFloat);\n case aType of\n ctToStr: Result := wbActorValueEnum.ToString(aInt, aElement);\n ctToSortKey: Result := wbActorValueEnum.ToSortKey(aInt, aElement);\n ctCheck: Result := wbActorValueEnum.Check(aInt, aElement);\n ctToEditValue: Result := wbActorValueEnum.ToEditValue(aInt, aElement);\n ctEditType: Result := 'ComboBox';\n ctEditInfo: Result := wbActorValueEnum.EditInfo[aInt, aElement];\n end;\nend;\n\nfunction wbEPFDActorValueToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n AsCardinal : Cardinal;\n AsFloat : Single;\nbegin\n AsFloat := wbActorValueEnum.FromEditValue(aString, aElement);\n PSingle(@AsCardinal)^ := AsFloat;\n Result := AsCardinal;\nend;\n\nfunction wbCTDAParam2QuestStageToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Stages : IwbContainerElementRef;\n Stage : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Parameter #1'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n // get winning quest override except for partial forms\n if MainRecord.WinningOverride.Flags._Flags and $00004000 = 0 then\n MainRecord := MainRecord.WinningOverride\n else if MainRecord.Flags._Flags and $00004000 <> 0 then\n MainRecord := MainRecord.MasterOrSelf;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Stages'], IwbContainerElementRef, Stages) then begin\n for i := 0 to Pred(Stages.ElementCount) do\n if Supports(Stages.Elements[i], IwbContainerElementRef, Stage) then begin\n j := Stage.ElementNativeValues['INDX\\Stage Index'];\n s := Trim(Stage.ElementValues['Log Entries\\Log Entry\\CNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbPerkDATAQuestStageToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Stages : IwbContainerElementRef;\n Stage : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Param1 := Container.ElementByName['Quest'];\n\n if not Assigned(Param1) then\n Exit;\n\n if not Supports(Param1.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n // get winning quest override except for partial forms\n if MainRecord.WinningOverride.Flags._Flags and $00004000 = 0 then\n MainRecord := MainRecord.WinningOverride\n else if MainRecord.Flags._Flags and $00004000 <> 0 then\n MainRecord := MainRecord.MasterOrSelf;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo:\n EditInfos := TStringList.Create;\n else\n EditInfos := nil;\n end;\n try\n if Supports(MainRecord.ElementByName['Stages'], IwbContainerElementRef, Stages) then begin\n for i := 0 to Pred(Stages.ElementCount) do\n if Supports(Stages.Elements[i], IwbContainerElementRef, Stage) then begin\n j := Stage.ElementNativeValues['INDX\\Stage Index'];\n s := Trim(Stage.ElementValues['Log Entries\\Log Entry\\CNAM']);\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.AddObject(t, TObject(j))\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbCTDAParam2QuestStageToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i : Integer;\n s : string;\nbegin\n i := 1;\n s := Trim(aString);\n while (i <= Length(s)) and (s[i] in ['0'..'9']) do\n Inc(i);\n s := Copy(s, 1, Pred(i));\n\n Result := StrToInt(s);\nend;\n\nfunction wbREFRNavmeshTriangleToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Navmesh : IwbElement;\n MainRecord : IwbMainRecord;\n Triangles : IwbContainerElementRef;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt);\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerRefFromUnionOrValue(aElement);\n if not Assigned(Container) then Exit;\n\n Navmesh := Container.Elements[0];\n\n if not Assigned(Navmesh) then\n Exit;\n\n if not Supports(Navmesh.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n MainRecord := MainRecord.WinningOverride;\n\n if MainRecord.Signature <> NAVM then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n if Supports(MainRecord.ElementByPath['NVNM\\Triangles'], IwbContainerElementRef, Triangles) and (aType = ctCheck) then\n if aInt >= Triangles.ElementCount then\n Result := '';\nend;\n\nfunction wbStringToInt(const aString: string; const aElement: IwbElement): Int64;\nbegin\n Result := StrToIntDef(aString, 0);\nend;\n\n{ Alias to string conversion, requires quest reference or quest record specific to record that references alias }\nfunction wbAliasToStr(aInt: Int64; const aQuestRef: IwbElement; aType: TwbCallbackType): string;\nvar\n MainRecord : IwbMainRecord;\n EditInfos : TStringList;\n Aliases : IwbContainerElementRef;\n Alias : IwbContainerElementRef;\n i, j : Integer;\n s, t : string;\nbegin\n case aType of\n ctToStr: if aInt = -1 then\n Result := 'None'\n else if aInt = -2 then\n Result := 'Player'\n else\n Result := IntToStr(aInt) + ' ';\n ctToEditValue: if aInt = -1 then Result := 'None' else\n Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: if (aInt = -1) or (aInt = -2) then Result := '' else\n Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n if ((aInt = -1) or (aInt = -2)) and (aType <> ctEditType) and (aType <> ctEditInfo) then\n Exit;\n\n if not Assigned(aQuestRef) then\n Exit;\n\n // aQuestRef can be a QUST record or reference to QUST record\n if not Supports(aQuestRef, IwbMainRecord, MainRecord) then\n if not Supports(aQuestRef.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n // get winning quest override except for partial forms\n if MainRecord.WinningOverride.Flags._Flags and $00004000 = 0 then\n MainRecord := MainRecord.WinningOverride\n else if MainRecord.Flags._Flags and $00004000 <> 0 then\n MainRecord := MainRecord.MasterOrSelf;\n\n if MainRecord.Signature <> QUST then begin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n end;\n Exit;\n end;\n\n case aType of\n ctEditType: begin\n Result := 'ComboBox';\n Exit;\n end;\n ctEditInfo: begin\n EditInfos := TStringList.Create;\n end;\n else\n EditInfos := nil;\n end;\n\n try\n if Supports(MainRecord.ElementByName['Aliases'], IwbContainerElementRef, Aliases) then begin\n for i := 0 to Pred(Aliases.ElementCount) do\n if Supports(Aliases.Elements[i], IwbContainerElementRef, Alias) then begin\n // skip alias collection\n if Assigned(Alias.ElementBySignature['ALCS']) then\n Continue;\n j := Alias.Elements[0].NativeValue;\n s := Alias.ElementEditValues['ALID'];\n t := IntToStr(j);\n while Length(t) < 3 do\n t := '0' + t;\n if s <> '' then\n t := t + ' ' + s;\n if Assigned(EditInfos) then\n EditInfos.Add(t)\n else if j = aInt then begin\n case aType of\n ctToStr, ctToEditValue: Result := t;\n ctCheck: Result := '';\n end;\n Exit;\n end;\n end;\n end;\n\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctCheck: Result := '';\n ctEditInfo: begin\n EditInfos.Add('None');\n EditInfos.Sort;\n Result := EditInfos.CommaText;\n end;\n end;\n finally\n FreeAndNil(EditInfos);\n end;\nend;\n\nfunction wbStrToAlias(const aString: string; const aElement: IwbElement): Int64;\nvar\n i : Integer;\n s : string;\nbegin\n Result := -1;\n\n if aString = 'None' then\n Exit\n else if aString = 'Player' then begin\n Result := -2;\n Exit;\n end;\n\n i := 1;\n s := Trim(aString);\n while (i <= Length(s)) and (s[i] in ['-', '0'..'9']) do\n Inc(i);\n s := Copy(s, 1, Pred(i));\n\n Result := StrToIntDef(s, -1);\nend;\n\nfunction wbScriptObjectAliasToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\nbegin\n if not wbResolveAlias then begin\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: Result := IntToHex64(aInt, 8);\n else\n Result := '';\n end;\n Exit;\n end;\n\n if not Assigned(aElement) then\n Exit;\n\n Container := GetContainerRefFromUnionOrValue(aElement);\n\n if not Assigned(Container) then\n Exit;\n\n Result := wbAliasToStr(aInt, Container.ElementByName['FormID'], aType);\nend;\n\nfunction wbPackageLocationAliasToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainer;\nbegin\n if not wbResolveAlias then begin\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: Result := IntToHex64(aInt, 8);\n else\n Result := '';\n end;\n Exit;\n end;\n\n if not Assigned(aElement) then\n Exit;\n\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.ElementType <> etMainRecord) do\n Container := Container.Container;\n\n if not Assigned(Container) then\n Exit;\n\n Result := wbAliasToStr(aInt, Container.ElementBySignature['QNAM'], aType);\nend;\n\nfunction wbQuestAliasToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainer;\nbegin\n if not wbResolveAlias then begin\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: Result := IntToHex64(aInt, 8);\n else\n Result := '';\n end;\n Exit;\n end;\n\n if not Assigned(aElement) then\n Exit;\n\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.ElementType <> etMainRecord) do\n Container := Container.Container;\n\n if not Assigned(Container) then\n Exit;\n\n Result := wbAliasToStr(aInt, Container, aType);\nend;\n\nfunction wbQuestExternalAliasToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainer;\nbegin\n if not wbResolveAlias then begin\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: Result := IntToHex64(aInt, 8);\n else\n Result := '';\n end;\n Exit;\n end;\n\n if not Assigned(aElement) then\n Exit;\n\n Container := aElement.Container;\n\n if not Assigned(Container) then\n Exit;\n\n Result := wbAliasToStr(aInt, Container.ElementBySignature['ALEQ'] , aType);\nend;\n\nfunction wbConditionAliasToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainer;\n MainRecord : IwbMainRecord;\n GroupRecord : IwbGroupRecord;\nbegin\n if not wbResolveAlias then begin\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: Result := IntToHex64(aInt, 8);\n else\n Result := '';\n end;\n Exit;\n end;\n\n if not Assigned(aElement) then\n Exit;\n\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.ElementType <> etMainRecord) do\n Container := Container.Container;\n\n if not Assigned(Container) then\n Exit;\n\n if not Supports(Container, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.Signature = QUST then\n Result := wbAliasToStr(aInt, Container, aType)\n else if MainRecord.Signature = SCEN then\n Result := wbAliasToStr(aInt, Container.ElementBySignature['PNAM'], aType)\n else if MainRecord.Signature = PACK then\n Result := wbAliasToStr(aInt, Container.ElementBySignature['QNAM'], aType)\n else if MainRecord.Signature = INFO then begin\n // get DIAL for INFO\n if Supports(MainRecord.Container, IwbGroupRecord, GroupRecord) then\n if Supports(GroupRecord.ChildrenOf, IwbMainRecord, MainRecord) then\n Result := wbAliasToStr(aInt, MainRecord.ElementBySignature['QNAM'], aType);\n end else\n // this should never be called since aliases in conditions can be in the forms above only\n // but just in case\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: Result := IntToHex64(aInt, 8);\n else\n Result := '';\n end;\nend;\n\nfunction wbClmtMoonsPhaseLength(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n PhaseLength : Byte;\n Masser : Boolean;\n Secunda : Boolean;\nbegin\n Result := '';\n if aType = ctToSortKey then begin\n Result := IntToHex64(aInt, 2);\n end else if aType = ctToStr then begin\n PhaseLength := aInt mod 64;\n Masser := (aInt and 64) <> 0;\n Secunda := (aInt and 128) <> 0;\n if Masser then\n if Secunda then\n Result := 'Masser, Secunda / '\n else\n Result := 'Masser / '\n else\n if Secunda then\n Result := 'Secunda / '\n else\n Result := 'No Moon / ';\n Result := Result + IntToStr(PhaseLength);\n end;\nend;\n\nfunction wbClmtTime(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n Result := TimeToStr( EncodeTime(aInt div 6, (aInt mod 6) * 10, 0, 0) )\n else\n Result := '';\nend;\n\n\nvar\n wbCtdaTypeFlags : IwbFlagsDef;\n\nfunction wbCtdaTypeToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n s: string;\nbegin\n Result := '';\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Use aliases',\n {0x04} 'Use global',\n {0x08} 'Use packdata',\n {0x10} 'Swap Subject and Target'\n ]);\n{\n Compare operator (upper 3 bits)\n LGE\n 000 0=Equal to\n 001 1=Not equal to\n 010 2=Greater than\n 011 3=Greater than or equal to\n 100 4=Less than\n 101 5=Less than or equal to\n\n Flags (lower 5 bits)\n 0x01=OR (default is to AND conditions together)\n 0x02=Parameters (use aliases) : Force function parameters to use quest alias data (exclusive with \"use pack data\")\n 0x04=Use global\n 0x08=Use Pack Data : Force function parameters to use pack data (exclusive with \"use aliases\")\n 0x10=Swap Subject and Target\n}\n case aType of\n ctEditType:\n Result := 'CheckComboBox';\n ctEditInfo:\n Result := 'Equal,Greater,Lesser,Or,\"Use Aliases\",\"Use Global\",\"Use Packdata\",\"Swap Subject and Target\"';\n ctToEditValue: begin\n Result := '00000000';\n case aInt and $E0 of\n $00 : Result[1] := '1';\n $40 : Result[2] := '1';\n $60 : begin\n Result[1] := '1';\n Result[2] := '1';\n end;\n $80 : Result[3] := '1';\n $A0 : begin\n Result[1] := '1';\n Result[3] := '1';\n end;\n end;\n if (aInt and $01) <> 0 then // Or\n Result[4] := '1';\n if (aInt and $02) <> 0 then // Use aliases\n Result[5] := '1';\n if (aInt and $04) <> 0 then // Use global\n Result[6] := '1';\n if (aInt and $08) <> 0 then // Use packdata\n Result[7] := '1';\n if (aInt and $10) <> 0 then // Swap Subject and Target\n Result[8] := '1';\n end;\n ctToStr: begin\n case aInt and $E0 of\n $00 : Result := 'Equal to';\n $20 : Result := 'Not equal to';\n $40 : Result := 'Greater than';\n $60 : Result := 'Greater than or equal to';\n $80 : Result := 'Less than';\n $A0 : Result := 'Less than or equal to';\n else\n Result := ''\n end;\n s := wbCtdaTypeFlags.ToString(aInt and $1F, aElement);\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: begin\n case aInt and $E0 of\n $00, $20, $40, $60, $80, $A0 : Result := '';\n else\n Result := ''\n end;\n s := wbCtdaTypeFlags.Check(aInt and $1F, aElement);\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n end;\nend;\n\nfunction wbCtdaTypeToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\nbegin\n s := aString + '00000000';\n if s[1] = '1' then begin\n if s[2] = '1' then begin\n if s[3] = '1' then begin\n Result := $00;\n end else begin\n Result := $60;\n end;\n end else begin\n if s[3] = '1' then begin\n Result := $A0;\n end else begin\n Result := $00;\n end;\n end;\n end else begin\n if s[2] = '1' then begin\n if s[3] = '1' then begin\n Result := $20;\n end else begin\n Result := $40;\n end;\n end else begin\n if s[3] = '1' then begin\n Result := $80;\n end else begin\n Result := $20;\n end;\n end;\n end;\n // Or\n if s[4] = '1' then\n Result := Result or $01;\n // Use aliases\n if s[5] = '1' then\n Result := Result or $02;\n // Use global\n if s[6] = '1' then\n Result := Result or $04;\n // Use packdata\n if s[7] = '1' then\n Result := Result or $08;\n // Swap Subject and Target\n if s[8] = '1' then\n Result := Result or $10;\nend;\n\nvar\n wbEventFunctionAndMemberEditInfo: string;\n\nfunction wbEventFunctionAndMemberToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n EventFunction, EventMember: Integer;\n i, j: Integer;\n s1, s2: string;\n slMember: TStringList;\nbegin\n Result := '';\n EventFunction := aInt and $FFFF;\n EventMember := aInt shr 16;\n case aType of\n ctToStr, ctToEditValue: begin\n Result := wbEventFunctionEnum.ToEditValue(EventFunction, nil);\n Result := Result + ':' + wbEventMemberEnum.ToEditValue(EventMember, nil);\n end;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctCheck: begin\n s1 := wbEventFunctionEnum.Check(EventFunction, nil);\n if s1 <> '' then\n s1 := 'EventFunction' + s1;\n s2 := wbEventMemberEnum.Check(EventMember, nil);\n if s2 <> '' then\n s2 := 'EventMember' + s2;\n if (s1 <> '') or (s2 <> '') then\n Result := s1 + ':' + s2;\n end;\n ctEditType:\n Result := 'ComboBox';\n ctEditInfo: begin\n Result := wbEventFunctionAndMemberEditInfo;\n if Result = '' then try\n slMember := TStringList.Create;\n slMember.CommaText := wbEventMemberEnum.EditInfo[0, nil];\n with TStringList.Create do try\n for i := 0 to Pred(wbEventFunctionEnum.NameCount) do\n for j := 0 to Pred(slMember.Count) do\n Add(wbEventFunctionEnum.Names[i] + ':' + slMember[j]);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n wbEventFunctionAndMemberEditInfo := Result;\n finally\n FreeAndNil(slMember);\n end\n end;\n end;\nend;\n\nfunction wbEventFunctionAndMemberToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n EventFunction, EventMember, i: Integer;\nbegin\n i := Pos(':', aString);\n if i > 0 then begin\n EventFunction := wbEventFunctionEnum.FromEditValue(Copy(aString, 1, i-1), nil);\n EventMember := wbEventMemberEnum.FromEditValue(Copy(aString, i+1, Length(aString)), nil);\n end\n else begin\n EventFunction := 0;\n EventMember := 0;\n end;\n Result := EventMember shl 16 + EventFunction;\nend;\n\nprocedure wbMESGDNAMAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : Integer;\n Container : IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := Integer(aOldValue) and 1;\n NewValue := Integer(aNewValue) and 1;\n if NewValue = OldValue then\n Exit;\n if NewValue = 1 then\n Container.RemoveElement('TNAM')\n else\n Container.Add('TNAM', True);\n end;\nend;\n\nprocedure wbGMSTEDIDAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : string;\n Container : IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := aOldValue;\n NewValue := aNewValue;\n if (Length(OldValue) < 1) or (Length(OldValue) < 1) or (OldValue[1] <> NewValue[1]) then begin\n Container.RemoveElement('DATA');\n Container.Add('DATA', True);\n end;\n end;\nend;\n\nprocedure wbFLSTEDIDAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue : string;\n OldOrdered, NewOrdered : Boolean;\n Container : IwbContainerElementRef;\nconst\n OrderedList = 'OrderedList';\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n OldValue := aOldValue;\n NewValue := aNewValue;\n\n if Length(OldValue) > Length(OrderedList) then\n Delete(OldValue, 1, Length(OldValue)-Length(OrderedList));\n if Length(NewValue) > Length(OrderedList) then\n Delete(NewValue, 1, Length(NewValue)-Length(OrderedList));\n\n OldOrdered := SameText(OldValue, OrderedList);\n NewOrdered := SameText(NewValue, OrderedList);\n\n if OldOrdered <> NewOrdered then\n Container.RemoveElement('FormIDs');\n end;\nend;\n\nprocedure wbCtdaTypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n OldValue, NewValue: Integer;\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n // reset value if \"use global\" has changed\n OldValue := aOldValue and $04;\n NewValue := aNewValue and $04;\n if OldValue <> NewValue then\n Container.ElementNativeValues['..\\Comparison Value'] := 0;\n\n {>>> \"run on target\", no such flag in Skyrim <<<}\n// if aNewValue and $02 then begin\n// Container.ElementNativeValues['..\\Run On'] := 1;\n// if Integer(Container.ElementNativeValues['..\\Run On']) = 1 then\n// aElement.NativeValue := Byte(aNewValue) and not $02;\n// end;\nend;\n\nprocedure wbAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n Exit;\nend;\n\nfunction wbMODTCallback(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Strings: TDynStrings;\n i: Integer;\nbegin\n Result := '';\n if wbLoaderDone and (aType in [ctToStr, ctToSortKey] ) then begin\n Strings := wbContainerHandler.ResolveHash(aInt);\n for i := Low(Strings) to High(Strings) do\n Result := Result + Strings[i] + ', ';\n SetLength(Result, Length(Result) -2 );\n end;\nend;\n\n{>>> Needs revision for Skyrim <<<}\n//function wbIdleAnam(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\n//begin\n// Result := '';\n// case aType of\n// ctToStr: begin\n// case aInt and not $C0 of\n// 0: Result := 'Idle';\n// 1: Result := 'Movement';\n// 2: Result := 'Left Arm';\n// 3: Result := 'Left Hand';\n// 4: Result := 'Weapon';\n// 5: Result := 'Weapon Up';\n// 6: Result := 'Weapon Down';\n// 7: Result := 'Special Idle';\n// 20: Result := 'Whole Body';\n// 21: Result := 'Upper Body';\n// else\n// Result := '';\n// end;\n//\n// if (aInt and $80) = 0 then\n// Result := Result + ', Must return a file';\n// if (aInt and $40) = 1 then\n// Result := Result + ', Unknown Flag';\n// end;\n// ctToSortKey: begin\n// Result := IntToHex64(aInt, 2);\n// end;\n// ctCheck: begin\n// case aInt and not $C0 of\n// 0..7, 20, 21: Result := '';\n// else\n// Result := '';\n// end;\n// end;\n// end;\n//end;\n\nfunction wbScaledInt4ToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nconst\n PlusMinus : array[Boolean] of string = ('+', '-');\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n ctToSortKey: begin\n Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n if Length(Result) < 22 then\n Result := StringOfChar('0', 22 - Length(Result)) + Result;\n Result := PlusMinus[aInt < 0] + Result;\n end;\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbScaledInt4ToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n f: Extended;\nbegin\n f := StrToFloat(aString);\n f := f * 10000;\n Result := Round(f);\nend;\n\nfunction wbCloudSpeedToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: Result := FloatToStrF((aInt - 127)/127/10, ffFixed, 99, 4);\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbCloudSpeedToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n f: Extended;\nbegin\n f := StrToFloat(aString);\n f := f*10*127 + 127;\n Result := Min(Round(f), 254);\nend;\n\nfunction wbShortXYtoStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n x, y: SmallInt;\nbegin\n y := aInt and $FFFF;\n x := aInt shr 16 and $FFFF;\n Result := '';\n case aType of\n ctToStr, ctToEditValue: Result := Format('%d, %d', [x, y]);\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbStrToShortXY(const aString: string; const aElement: IwbElement): Int64;\nvar\n x, y: SmallInt;\n Value: Cardinal;\nbegin\n y := StrToIntDef(Copy(aString, 1, Pred(Pos(', ', aString))), 0);\n x := StrToIntDef(Copy(aString, Pos(', ', aString) + 2, Length(aString)), 0);\n PWord(@Value)^ := x;\n PWord(Cardinal(@Value) + SizeOf(SmallInt))^ := y;\n Result := Value;\nend;\n\nfunction wbHideFFFF(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n if aInt = $FFFF then\n Result := 'None'\n else\n Result := IntToStr(aInt);\nend;\n\nfunction wbAtxtPosition(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt div 17, 2) + IntToHex64(aInt mod 17, 2)\n else if aType = ctCheck then begin\n if (aInt < 0) or (aInt > 288) then\n Result := ''\n else\n Result := '';\n end else if aType = ctToStr then\n Result := IntToStr(aInt) + ' -> ' + IntToStr(aInt div 17) + ':' + IntToStr(aInt mod 17);\nend;\n\nfunction wbPlacedAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n s: string;\n Cell: IwbMainRecord;\n Position: TwbVector;\n Grid: TwbGridCell;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['NAME'];\n if Assigned(Rec) then begin\n s := Trim(Rec.Value);\n if s <> '' then\n Result := 'places ' + s;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n\n // grid position of persistent reference in exterior persistent cell (interior cells are not persistent)\n if Supports(aMainRecord.Container, IwbGroupRecord, Container) then\n Cell := IwbGroupRecord(Container).ChildrenOf;\n if Assigned(Cell) and Cell.IsPersistent and (Cell.Signature = 'CELL') then\n if aMainRecord.GetPosition(Position) then begin\n Grid := wbPositionToGridCell(Position);\n Result := Result + ' at ' + IntToStr(Grid.x) + ',' + IntToStr(Grid.y);\n end;\n\n // in precombined mesh\n if aMainRecord.HasPrecombinedMesh then\n Result := Result + ' in ' + aMainRecord.PrecombinedMesh;\n end;\n end;\nend;\n\nfunction wbINFOAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Container: IwbContainer;\n s: string;\nbegin\n Result := Trim(aMainRecord.ElementValues['Responses\\Response\\NAM1']);\n if Result <> '' then\n Result := '''' + Result + '''';\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n end;\n end;\n\n s := Trim(aMainRecord.ElementValues['QNAM']);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'for ' + s;\n end;\nend;\n\nfunction wbNAVMAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Container: IwbContainer;\n s: string;\nbegin\n Result := '';\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n end;\n end;\nend;\n\n//function wbNAVMAddInfo(const aMainRecord: IwbMainRecord): string;\n//var\n// Rec : IwbRecord;\n// Element : IwbElement;\n// s : string;\n//begin\n// Result := '';\n//\n// Rec := aMainRecord.RecordBySignature['DATA'];\n// if Assigned(Rec) then begin\n// Element := Rec.ElementByName['Cell'];\n// if Assigned(Element) then\n// Element := Element.LinksTo;\n// if Assigned(Element) then\n// s := Trim(Element.Name);\n// if s <> '' then\n// Result := 'for ' + s;\n// end;\n//end;\n\nfunction wbCellAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n GroupRecord : IwbGroupRecord;\n s: string;\nbegin\n Result := '';\n\n if not aMainRecord.IsPersistent then begin\n Rec := aMainRecord.RecordBySignature['XCLC'];\n if Assigned(Rec) then\n Result := 'at ' + Rec.Elements[0].Value + ',' + Rec.Elements[1].Value;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and not\n (Supports(Container, IwbGroupRecord, GroupRecord) and (GroupRecord.GroupType = 1)) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := wbFormID.ToString(GroupRecord.GroupLabel, aMainRecord);\n if s <> '' then begin\n if Result <> '' then\n s := s + ' ';\n Result := 'in ' + s + Result;\n end;\n end;\nend;\n\nprocedure wbCTDARunOnAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n if aOldValue <> aNewValue then\n if aNewValue <> 2 then\n aElement.Container.ElementNativeValues['Reference'] := 0;\nend;\n\n{>>> Needs revision for Skyrim <<<}\nprocedure wbPERKPRKETypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainerElementRef;\n// rDATA : IwbRecord;\nbegin\n if aOldValue <> aNewValue then\n if Supports(aElement.Container, IwbContainerElementRef, Container) then begin\n if Supports(Container.Container, IwbContainerElementRef, Container) then begin\n Container.RemoveElement('DATA');\n Container.Add('DATA', True);\n Container.RemoveElement('Perk Conditions');\n Container.RemoveElement('Entry Point Function Parameters');\n if aNewValue = 2 then begin\n Container.Add('EPFT', True);\n Container.ElementNativeValues['DATA\\Entry Point\\Function'] := 2;\n end;\n end;\n end;\nend;\n\nfunction wbNPCLevelDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\n i: Int64;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n i := Container.ElementByName['Flags'].NativeValue;\n if i and $00000080 <> 0 then\n Result := 1;\nend;\n\nfunction wbMGEFAssocItemDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n Archtype : Variant;\n DataContainer : IwbDataContainer;\n Element : IwbElement;\nconst\n OffsetArchtype = 56;\n\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n VarClear(ArchType);\n Element := Container.ElementByName['Archetype'];\n if Assigned(Element) then\n ArchType := Element.NativeValue\n else if Supports(Container, IwbDataContainer, DataContainer) and\n DataContainer.IsValidOffset(aBasePtr, aEndPtr, OffsetArchtype) then begin // we are part a proper structure\n aBasePtr := Pointer(Cardinal(aBasePtr) + OffsetArchtype);\n ArchType := PCardinal(aBasePtr)^;\n end;\n\n if not VarIsEmpty(ArchType) then\n case Integer(ArchType) of\n 12: Result := 1; // Light\n 17: Result := 2; // Bound Item\n 18: Result := 3; // Summon Creature\n 25: Result := 4; // Guide\n 34: Result := 8; // Peak Mod\n 35: Result := 5; // Cloak\n 36: Result := 6; // Werewolf\n 39: Result := 7; // Enhance Weapon\n 40: Result := 4; // Spawn Hazard\n 46: Result := 6; // Vampire Lord\n end;\nend;\n\nprocedure wbMGEFAssocItemAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainer;\n Element : IwbElement;\nbegin\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if (aNewValue <> 0) then begin\n Element := Container.ElementByName['Archetype'];\n if Assigned(Element) and (Element.NativeValue = 0) then\n Element.NativeValue := $FF; // Signals ArchType that it should not mess with us on the next change!\n // I assume this will alo protect Second AV Weight (The two actor values are after ArchType)\n end;\nend;\n\nprocedure wbMGEFAV2WeightAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainer;\n Element : IwbElement;\nbegin\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n if (aNewValue <> 0.0) then begin\n Element := Container.ElementByName['Archetype'];\n if Assigned(Element) and (Element.NativeValue = 0) then\n Element.NativeValue := $FF; // Signals ArchType that it should not mess with us on the next change!\n end;\nend;\n\nprocedure wbMGEFArchtypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container: IwbContainerElementRef;\nbegin\n if VarSameValue(aOldValue, aNewValue) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if (aNewValue < $FF) and (aOldValue < $FF) then begin\n Container.ElementNativeValues['..\\Assoc. Item'] := 0;\n case Integer(aNewValue) of\n 06: Container.ElementNativeValues['..\\Actor Value'] := 00;//Agression\n 07: Container.ElementNativeValues['..\\Actor Value'] := 01;//Confidence\n 08: Container.ElementNativeValues['..\\Actor Value'] := 00;//Agression\n 11: Container.ElementNativeValues['..\\Actor Value'] := 54;//Invisibility\n 21: Container.ElementNativeValues['..\\Actor Value'] := 53;//Paralysis\n 24: Container.ElementNativeValues['..\\Actor Value'] := 01;//Confidence\n 38: Container.ElementNativeValues['..\\Actor Value'] := 01;//Confidence\n 42: Container.ElementNativeValues['..\\Actor Value'] := 01;//Confidence\n else\n Container.ElementNativeValues['..\\Actor Value'] := -1;\n end;\n Container.ElementNativeValues['..\\Second Actor Value'] := -1;\n Container.ElementNativeValues['..\\Second AV Weight'] := 0.0;\n end;\nend;\n\nfunction wbCTDAReferenceDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Integer(Container.ElementNativeValues['Run On']) = 2 then\n Result := 1;\nend;\n\nfunction wbNAVIIslandDataDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbMainRecord;\n Element : IwbElement;\nbegin\n Result := 0;\n\n Container := aElement.Container;\n while Assigned(Container) and (Container.ElementType <> etSubRecord) do\n Container := Container.Container;\n\n if not Supports(Container, IwbSubRecord, SubRecord) then\n Exit;\n\n Element := SubRecord.ElementByName['Is Island'];\n if not Assigned(Element) then\n Exit;\n\n Result := Element.NativeValue;\nend;\n\nfunction wbNAVIParentDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n SubRecord : IwbMainRecord;\n Element : IwbElement;\nbegin\n Result := 0;\n\n Container := aElement.Container;\n while Assigned(Container) and (Container.ElementType <> etsubRecord) do\n Container := Container.Container;\n\n if not Supports(Container, IwbSubRecord, SubRecord) then\n Exit;\n\n Element := SubRecord.ElementByName['Parent Worldspace'];\n if not Assigned(Element) then\n Exit;\n\n if (Element.NativeValue = 0) then\n Result := 1;\nend;\n\nfunction wbNVNMParentDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n Parent : IwbElement;\n i : integer;\nbegin // Could be simplified by checking if Parent Worldspace is NULL, that's what the runtime does :)\n Result := 0;\n\n Container := aElement.Container;\n\n Parent := Container.ElementByName['Parent Worldspace'];\n\n if not Assigned(Parent) then\n Exit;\n\n i := Parent.NativeValue;\n\n // is interior cell?\n if i = 0 then\n Result := 1;\nend;\n\nfunction wbDoorTriangleDoorTriangleDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n Parent : IwbElement;\n i : int64;\nbegin\n Result := 0;\n\n Container := aElement.Container;\n\n Parent := Container.ElementByName['DTUnknown'];\n\n if not Assigned(Parent) then\n Exit;\n\n i := Parent.NativeValue;\n\n // not sure if it would be an error in the file or if it really possible\n if i <> 0 then\n Result := 1;\nend;\n\nfunction wbSubrecordSizeDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n SubRecord : IwbSubRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n\n if Supports(aElement, IwbSubRecord, SubRecord) then\n if SubRecord.DataSize > 0 then\n Result := 1;\nend;\n\nfunction wbCOEDOwnerDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n LinksTo : IwbElement;\n MainRecord : IwbMainRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n LinksTo := Container.ElementByName['Owner'].LinksTo;\n\n if Supports(LinksTo, IwbMainRecord, MainRecord) then\n if MainRecord.Signature = 'NPC_' then\n Result := 1\n else if MainRecord.Signature = 'FACT' then\n Result := 2;\nend;\n\nfunction wbGMSTUnionDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rEDID: IwbRecord;\n s: string;\nbegin\n Result := 1;\n rEDID := aElement.Container.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > 0 then\n case s[1] of\n 's': Result := 0; {String} {>>> Localization Strings <<<}\n 'i': Result := 1; {intS32}\n 'f': Result := 2; {Float}\n 'b': Result := 3; {Boolean}\n end;\n end;\nend;\n\nfunction wbFLSTLNAMIsSorted(const aContainer: IwbContainer): Boolean;\nvar\n rEDID : IwbRecord;\n s : string;\nconst\n OrderedList = 'OrderedList';\nbegin\n Result := False; {>>> Should not be sorted according to Arthmoor and JustinOther <<<}\n rEDID := aContainer.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > Length(OrderedList) then\n Delete(s, 1, Length(s)-Length(OrderedList));\n if SameText(s, OrderedList) then\n Result := False;\n end;\nend;\n\nfunction wbPerkDATADecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rPRKE: IwbRecord;\n eType: IwbElement;\nbegin\n Result := 0;\n rPRKE := aElement.Container.RecordBySignature[PRKE];\n if Assigned(rPRKE) then begin\n eType := rPRKE.ElementByName['Type'];\n if Assigned(eType) then begin\n Result := eType.NativeValue;\n end;\n end;\nend;\n\nfunction wbEPFDDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := 0;\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n Result := Container.ElementNativeValues['EPFT'];\n if Result = 2 then\n case Integer(Container.ElementNativeValues['..\\DATA\\Entry Point\\Function']) of\n 5, 12, 13, 14: Result := 8;\n end;\nend;\n\nfunction wbSceneActionSoundDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := 0;\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n if Container.ElementNativeValues['ANAM'] <> 4 then\n Result := 1;\nend;\n\nfunction wbEFSHFormatDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n MainRecord: IwbMainRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then\n Exit;\n if not Supports(aElement.Container, IwbMainRecord, MainRecord) then\n Exit;\n if MainRecord.Version < 102 then\n Result := 1;\nend;\n\nfunction wbDeciderFormVersion99(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nbegin\n Result := wbFormVerDecider(aBasePtr, aEndPtr, aElement, 99);\nend;\n\nfunction wbAECHDataDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n rKNAM : IwbElement;\n s: string;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n rKNAM := Container.ElementBySignature['KNAM'];\n if not Assigned(rKNAM) then Exit;\n\n s := rKNAM.EditValue;\n\n if s = 'BSOverdrive' then\n Result := 0\n else if s = 'BSStateVariableFilter' then\n Result := 1\n else if s = 'BSDelayEffect' then\n Result := 2;\nend;\n\nfunction wbCLFMColorDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n rFNAM : IwbElement;\n i : Integer;\nbegin\n Result := 0;\n\n // resolving to a float causes data loss when copying\n // since deciding field FNAM comes after a value CNAM\n Exit;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n rFNAM := Container.ElementBySignature['FNAM'];\n if not Assigned(rFNAM) then Exit;\n\n i := rFNAM.NativeValue;\n\n if i and 2 <> 0 then\n Result := 1;\nend;\n\nfunction wbCLFMColorToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainer;\n rFNAM : IwbElement;\n i : Integer;\n s : string;\nbegin\n i := 0;\n Container := aElement.Container;\n if Assigned(Container) then begin\n rFNAM := Container.ElementBySignature['FNAM'];\n if Assigned(rFNAM) then\n i := rFNAM.NativeValue;\n end;\n\n if i and 2 <> 0 then\n s := FloatToStrF(PSingle(@aInt)^, ffFixed, 99, wbFloatDigits)\n else\n s := 'rgba(' + IntToStr(aInt and $FF) + ', ' +\n IntToStr(aInt shr 8 and $FF) + ', ' +\n IntToStr(aInt shr 16 and $FF) + ', ' +\n IntToStr(aInt shr 24 and $FF) + ')';\n\n case aType of\n ctToStr: Result := s;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctToEditValue: Result := s;\n end;\nend;\n\nfunction wbCLFMColorToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\n value: Single;\nbegin\n if SameText(Copy(aString, 1, 5), 'rgba(') then begin\n s := Copy(aString, 6, Pos(')', aString) - 6);\n with TStringList.Create do try\n Delimiter := ',';\n StrictDelimiter := True;\n DelimitedText := s;\n Result := 0;\n if Count = 4 then begin\n PByte(@Result)[0] := StrToIntDef(Strings[0], 0);\n PByte(@Result)[1] := StrToIntDef(Strings[1], 0);\n PByte(@Result)[2] := StrToIntDef(Strings[2], 0);\n PByte(@Result)[3] := StrToIntDef(Strings[3], 0);\n end;\n finally\n Free;\n end;\n end\n else begin\n try value := StrToFloat(aString) except value := 0.0 end;\n Result := PInteger(@value)^;\n end;\nend;\n\nfunction wbNOTEDataDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n rDNAM : IwbElement;\n i : Integer;\nbegin\n Result := 0;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n rDNAM := Container.ElementBySignature['DNAM'];\n if not Assigned(rDNAM) then Exit;\n\n i := rDNAM.NativeValue;\n\n case i of\n 0: Result := 1;\n 1: Result := 2;\n 3: Result := 3;\n end;\nend;\n\nfunction wbSNDRDataDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n rCNAM : IwbElement;\nbegin\n Result := 0;\n\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n rCNAM := Container.ElementBySignature['CNAM'];\n if not Assigned(rCNAM) then Exit;\n\n if rCNAM.EditValue = 'AutoWeapon' then\n Result := 1;\nend;\n\n\n{>>> For VMAD <<<}\nfunction wbScriptObjFormatDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n ObjFormat: Integer;\n Container: IwbContainer;\nbegin\n Result := 0;\n\n Container := aElement.Container;\n while Assigned(Container) and (Container.ElementType <> etSubRecord) do\n Container := Container.Container;\n\n if not Assigned(Container) then Exit;\n\n ObjFormat := Container.ElementNativeValues['Object Format'];\n\n if ObjFormat = 1 then\n Result := 1;\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptPropertyDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n case Integer(Container.ElementNativeValues['Type']) of\n 1: Result := 1;\n 2: Result := 2;\n 3: Result := 3;\n 4: Result := 4;\n 5: Result := 5;\n 6: Result := 6;\n 7: Result := 7;\n 11: Result := 8;\n 12: Result := 9;\n 13: Result := 10;\n 14: Result := 11;\n 15: Result := 12;\n 17: Result := 13;\n end;\nend;\n\nfunction wbScriptPropertyStructMemberDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n case Integer(Container.ElementNativeValues['Type']) of\n 1: Result := 1;\n 2: Result := 2;\n 3: Result := 3;\n 4: Result := 4;\n 5: Result := 5;\n 11: Result := 6;\n 12: Result := 7;\n 13: Result := 8;\n 14: Result := 9;\n 15: Result := 10;\n end;\nend;\n\nprocedure wbScriptPropertyTypeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainerElementRef;\nbegin\n if aOldValue <> aNewValue then\n if Supports(aElement.Container, IwbContainerElementRef, Container) then\n Container.ElementByName['Value'].SetToDefault;\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptFragmentsDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n MainRecord : IwbMainRecord;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.ElementType <> etMainRecord) do\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n Supports(Container, IwbMainRecord, MainRecord);\n if MainRecord.Signature = PERK then\n Result := 1\n else if MainRecord.Signature = TERM then\n Result := 1\n else if MainRecord.Signature = INFO then\n Result := 2\n else if MainRecord.Signature = PACK then\n Result := 3\n else if MainRecord.Signature = QUST then\n Result := 4\n else if MainRecord.Signature = SCEN then\n Result := 5;\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptFragmentsQuestCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if aElement.ElementType = etValue then\n Container := aElement.Container\n else\n Container := aElement as IwbContainer;\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.Name <> 'Script Fragments') do\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n Result := Cardinal(Container.ElementNativeValues['fragmentCount']);\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptFragmentsInfoCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\n F : Integer;\n i : Integer;\nbegin\n Result := 0;\n if aElement.ElementType = etValue then\n Container := aElement.Container\n else\n Container := aElement as IwbContainer;\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.Name <> 'Script Fragments') do\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n F := Container.ElementByName['Flags'].NativeValue;\n for i := 0 to 2 do begin\n if (F and 1) = 1 then\n Inc(Result);\n F := F shr 1;\n end;\n for i := 3 to 7 do begin\n if (F and 1) = 1 then begin\n Inc(Result);\n if Assigned(wbProgressCallback) then\n wbProgressCallback('==='+aElement.Name+' ['+Container.Name+':'+Container.Path+'] = unknown info VMAD flag bit '+IntToStr(i));\n end;\n F := F shr 1;\n end;\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptFragmentsSceneCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\n F : Integer;\n i : Integer;\nbegin\n Result := 0;\n if aElement.ElementType = etValue then\n Container := aElement.Container\n else\n Container := aElement as IwbContainer;\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.Name <> 'Script Fragments') do\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n F := Container.ElementByName['Flags'].NativeValue;\n for i := 0 to 2 do begin\n if (F and 1) = 1 then\n Inc(Result);\n F := F shr 1;\n end;\n for i := 3 to 7 do begin\n if (F and 1) = 1 then begin\n Inc(Result);\n if Assigned(wbProgressCallback) then\n wbProgressCallback('==='+aElement.Name+' ['+Container.Name+':'+Container.Path+'] = unknown scene VMAD flag bit '+IntToStr(i));\n end;\n F := F shr 1;\n end;\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptFragmentsPackCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\n F : Integer;\n i : Integer;\nbegin\n Result := 0;\n if aElement.ElementType = etValue then\n Container := aElement.Container\n else\n Container := aElement as IwbContainer;\n if not Assigned(Container) then Exit;\n while Assigned(Container) and (Container.Name <> 'Script Fragments') do\n Container := Container.Container;\n if not Assigned(Container) then Exit;\n\n F := Container.ElementByName['Flags'].NativeValue;\n for i := 0 to 7 do begin\n if (F and 1) = 1 then\n Inc(Result);\n F := F shr 1;\n end;\nend;\n\n{>>> For VMAD <<<}\nfunction wbScriptFragmentsEmptyScriptDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Container.ElementEditValues['scriptName'] = '' then\n Result := 1;\nend;\n\nfunction wbBOOKTeachesDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\n i: Int64;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n i := Container.ElementByName['Flags'].NativeValue;\n if i and $01 <> 0 then\n Result := 1\n else if i and $04 <> 0 then\n Result := 2\n else if i and $10 <> 0 then\n Result := 3\n else\n Result := 0;\nend;\n\ntype\n TCTDAFunctionParamType = (\n { 0} ptNone,\n { 1} ptInteger,\n { 2} ptFloat,\n { 3} ptActor, // ACHR\n { 4} ptActorBase, // NPC_\n { 5} ptActorValue, // Enum: wbActorValue\n { 6} ptAdvanceAction, // ?? Enum\n { 7} ptAlias, // index into QUST quest aliases\n { 8} ptAlignment, // ?? Enum\n { 9} ptAssociationType, // ASTP\n {10} ptAxis, // ?? Char\n {11} ptCastingSource, // ?? Enum\n {12} ptCell, // CELL\n {13} ptClass, // CLAS\n {14} ptCrimeType, // ?? Enum\n {15} ptCriticalStage, // ?? Enum\n {16} ptEncounterZone, // ECZN\n {17} ptEquipType, // ?? Enum\n {18} ptEvent, // Struct\n {19} ptEventData, // LCTN, KYWD or FLST\n {20} ptFaction, // FACT\n {21} ptFormList, // FLST\n {22} ptFormType, // ?? Enum\n {23} ptFurniture, // FURN\n {24} ptFurnitureAnim, // enum\n {25} ptFurnitureEntry, // flags\n {26} ptGlobal, // GLOB\n {27} ptIdleForm, // IDLE\n {28} ptInventoryObject, // ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, ARMA, LIGH, LVLI, COBJ\n {29} ptKeyword, // KYWD\n {30} ptLocation, // LCTN\n {31} ptMagicEffect, // MGEF\n {32} ptMagicItem, // SPEL\n {33} ptMiscStat, // ?? Enum\n {34} ptObjectReference, // REFR, ACHR\n {35} ptOwner, // FACT, NPC_\n {36} ptPackage, // PACK\n {37} ptPackdata, // index into PACK package data inputs\n {38} ptPerk, // PERK\n {39} ptQuest, // QUST\n {40} ptQuestStage, // ?? Integer\n {41} ptRace, // RACE\n {42} ptReferencableObject,\n {43} ptRefType, // LCRT\n {44} ptRegion, // REGN\n {45} ptScene, // SCEN\n {46} ptSex, // Enum: Male, Female\n {47} ptShout, // SHOU\n {48} ptVariableName, // Integer\n {49} ptVATSValueFunction, //\n {50} ptVATSValueParam,\n {51} ptVoiceType, // VTYP\n {52} ptWardState, // enum\n {53} ptWeather, // WTHR\n {54} ptWorldspace, // WRLD\n {55} ptDamageType // DMGT\n );\n\n PCTDAFunction = ^TCTDAFunction;\n TCTDAFunction = record\n Index: Integer;\n Name: string;\n ParamType1: TCTDAFunctionParamType;\n ParamType2: TCTDAFunctionParamType;\n ParamType3: TCTDAFunctionParamType;\n end;\n\nconst\n wbCTDAFunctions : array[0..514] of TCTDAFunction = (\n (Index: 0; Name: 'GetWantBlocking'),\n (Index: 1; Name: 'GetDistance'; ParamType1: ptObjectReference),\n (Index: 5; Name: 'GetLocked'),\n (Index: 6; Name: 'GetPos'; ParamType1: ptAxis),\n (Index: 8; Name: 'GetAngle'; ParamType1: ptAxis),\n (Index: 10; Name: 'GetStartingPos'; ParamType1: ptAxis),\n (Index: 11; Name: 'GetStartingAngle'; ParamType1: ptAxis),\n (Index: 12; Name: 'GetSecondsPassed'),\n (Index: 14; Name: 'GetValue'; ParamType1: ptActorValue),\n (Index: 18; Name: 'GetCurrentTime'),\n (Index: 24; Name: 'GetScale'),\n (Index: 25; Name: 'IsMoving'),\n (Index: 26; Name: 'IsTurning'),\n (Index: 27; Name: 'GetLineOfSight'; ParamType1: ptObjectReference),\n (Index: 31; Name: 'GetButtonPressed'),\n (Index: 32; Name: 'GetInSameCell'; ParamType1: ptObjectReference),\n (Index: 35; Name: 'GetDisabled'),\n (Index: 39; Name: 'GetDisease'),\n (Index: 41; Name: 'GetClothingValue'),\n (Index: 42; Name: 'SameFaction'; ParamType1: ptActor),\n (Index: 43; Name: 'SameRace'; ParamType1: ptActor),\n (Index: 44; Name: 'SameSex'; ParamType1: ptActor),\n (Index: 45; Name: 'GetDetected'; ParamType1: ptActor),\n (Index: 46; Name: 'GetDead'),\n (Index: 47; Name: 'GetItemCount'; ParamType1: ptReferencableObject),\n (Index: 48; Name: 'GetGold'),\n (Index: 49; Name: 'GetSleeping'),\n (Index: 50; Name: 'GetTalkedToPC'),\n (Index: 56; Name: 'GetQuestRunning'; ParamType1: ptQuest),\n (Index: 58; Name: 'GetStage'; ParamType1: ptQuest),\n (Index: 59; Name: 'GetStageDone'; ParamType1: ptQuest; ParamType2: ptQuestStage),\n (Index: 60; Name: 'GetFactionRankDifference'; ParamType1: ptFaction; ParamType2: ptActor),\n (Index: 61; Name: 'GetAlarmed'),\n (Index: 62; Name: 'IsRaining'),\n (Index: 63; Name: 'GetAttacked'),\n (Index: 64; Name: 'GetIsCreature'),\n (Index: 65; Name: 'GetLockLevel'),\n (Index: 66; Name: 'GetShouldAttack'; ParamType1: ptActor),\n (Index: 67; Name: 'GetInCell'; ParamType1: ptCell),\n (Index: 68; Name: 'GetIsClass'; ParamType1: ptClass),\n (Index: 69; Name: 'GetIsRace'; ParamType1: ptRace),\n (Index: 70; Name: 'GetIsSex'; ParamType1: ptSex),\n (Index: 71; Name: 'GetInFaction'; ParamType1: ptFaction),\n (Index: 72; Name: 'GetIsID'; ParamType1: ptReferencableObject),\n (Index: 73; Name: 'GetFactionRank'; ParamType1: ptFaction),\n (Index: 74; Name: 'GetGlobalValue'; ParamType1: ptGlobal),\n (Index: 75; Name: 'IsSnowing'),\n (Index: 77; Name: 'GetRandomPercent'),\n (Index: 79; Name: 'WouldBeStealing'; ParamType1: ptObjectReference),\n (Index: 80; Name: 'GetLevel'),\n (Index: 81; Name: 'IsRotating'),\n (Index: 83; Name: 'GetLeveledEncounterValue'; ParamType1: ptInteger),\n (Index: 84; Name: 'GetDeadCount'; ParamType1: ptActorBase),\n (Index: 91; Name: 'GetIsAlerted'),\n (Index: 99; Name: 'GetHeadingAngle'; ParamType1: ptObjectReference),\n (Index: 101; Name: 'IsWeaponMagicOut'),\n (Index: 102; Name: 'IsTorchOut'),\n (Index: 103; Name: 'IsShieldOut'),\n (Index: 105; Name: 'IsActionRef'; ParamType1: ptObjectReference),\n (Index: 106; Name: 'IsFacingUp'),\n (Index: 107; Name: 'GetKnockedState'),\n (Index: 108; Name: 'GetWeaponAnimType'),\n (Index: 109; Name: 'IsWeaponSkillType'; ParamType1: ptActorValue),\n (Index: 110; Name: 'GetCurrentAIPackage'),\n (Index: 111; Name: 'IsWaiting'),\n (Index: 112; Name: 'IsIdlePlaying'),\n (Index: 116; Name: 'IsIntimidatedbyPlayer'),\n (Index: 117; Name: 'IsPlayerInRegion'; ParamType1: ptRegion),\n (Index: 118; Name: 'GetActorAggroRadiusViolated'),\n (Index: 119; Name: 'GetCrimeKnown'; ParamType1: ptCrimeType; ParamType2: ptActor; ParamType3: ptActor),\n (Index: 122; Name: 'GetCrime'; ParamType1: ptActor; ParamType2: ptCrimeType),\n (Index: 123; Name: 'IsGreetingPlayer'),\n (Index: 125; Name: 'IsGuard'),\n (Index: 127; Name: 'HasBeenEaten'),\n (Index: 128; Name: 'GetStaminaPercentage'),\n (Index: 129; Name: 'HasBeenRead'),\n (Index: 130; Name: 'GetDying'),\n (Index: 131; Name: 'GetSceneActionPercent'; ParamType1: ptScene; ParamType2: ptInteger),\n (Index: 132; Name: 'WouldRefuseCommand'; ParamType1: ptObjectReference),\n (Index: 133; Name: 'SameFactionAsPC'),\n (Index: 134; Name: 'SameRaceAsPC'),\n (Index: 135; Name: 'SameSexAsPC'),\n (Index: 136; Name: 'GetIsReference'; ParamType1: ptObjectReference),\n (Index: 141; Name: 'IsTalking'),\n (Index: 142; Name: 'GetComponentCount'; ParamType1: ptReferencableObject),\n (Index: 143; Name: 'GetCurrentAIProcedure'),\n (Index: 144; Name: 'GetTrespassWarningLevel'),\n (Index: 145; Name: 'IsTrespassing'),\n (Index: 146; Name: 'IsInMyOwnedCell'),\n (Index: 147; Name: 'GetWindSpeed'),\n (Index: 148; Name: 'GetCurrentWeatherPercent'),\n (Index: 149; Name: 'GetIsCurrentWeather'; ParamType1: ptWeather),\n (Index: 150; Name: 'IsContinuingPackagePCNear'),\n (Index: 152; Name: 'GetIsCrimeFaction'; ParamType1: ptFaction),\n (Index: 153; Name: 'CanHaveFlames'),\n (Index: 154; Name: 'HasFlames'),\n (Index: 157; Name: 'GetOpenState'),\n (Index: 159; Name: 'GetSitting'),\n (Index: 160; Name: 'GetFurnitureMarkerID'),\n (Index: 161; Name: 'GetIsCurrentPackage'; ParamType1: ptPackage),\n (Index: 162; Name: 'IsCurrentFurnitureRef'; ParamType1: ptObjectReference),\n (Index: 163; Name: 'IsCurrentFurnitureObj'; ParamType1: ptFurniture),\n (Index: 167; Name: 'GetFactionReaction'; ParamType1: ptFaction; ParamType2: ptFaction),\n (Index: 170; Name: 'GetDayOfWeek'),\n (Index: 172; Name: 'GetTalkedToPCParam'; ParamType1: ptActor),\n (Index: 175; Name: 'IsPCSleeping'),\n (Index: 176; Name: 'IsPCAMurderer'),\n (Index: 180; Name: 'HasSameEditorLocationAsRef'; ParamType1: ptObjectReference; ParamType2: ptKeyword),\n (Index: 181; Name: 'HasSameEditorLocationAsRefAlias'; ParamType1: ptAlias; ParamType2: ptKeyword),\n (Index: 182; Name: 'GetEquipped'; ParamType1: ptReferencableObject),\n (Index: 185; Name: 'IsSwimming'),\n (Index: 186; Name: 'ScriptEffectElapsedSeconds'),\n (Index: 188; Name: 'GetPCSleepHours'),\n (Index: 190; Name: 'GetAmountSoldStolen'),\n (Index: 192; Name: 'GetIgnoreCrime'),\n (Index: 193; Name: 'GetPCExpelled'; ParamType1: ptFaction),\n (Index: 195; Name: 'GetPCFactionMurder'; ParamType1: ptFaction),\n (Index: 197; Name: 'GetPCEnemyofFaction'; ParamType1: ptFaction),\n (Index: 199; Name: 'GetPCFactionAttack'; ParamType1: ptFaction),\n (Index: 203; Name: 'GetDestroyed'),\n (Index: 205; Name: 'GetActionRef'),\n (Index: 206; Name: 'GetSelf'),\n (Index: 207; Name: 'GetContainer'),\n (Index: 208; Name: 'GetForceRun'),\n (Index: 210; Name: 'GetForceSneak'),\n (Index: 214; Name: 'HasMagicEffect'; ParamType1: ptMagicEffect),\n (Index: 215; Name: 'GetDefaultOpen'),\n (Index: 223; Name: 'IsSpellTarget'; ParamType1: ptMagicItem),\n (Index: 224; Name: 'GetVATSMode'),\n (Index: 225; Name: 'GetPersuasionNumber'),\n (Index: 226; Name: 'GetVampireFeed'),\n (Index: 227; Name: 'GetCannibal'),\n (Index: 228; Name: 'GetIsClassDefault'; ParamType1: ptClass),\n (Index: 229; Name: 'GetClassDefaultMatch'),\n (Index: 230; Name: 'GetInCellParam'; ParamType1: ptCell; ParamType2: ptObjectReference),\n (Index: 231; Name: 'GetPlayerDialogueInput'),\n (Index: 232; Name: 'GetCombatTarget'),\n (Index: 233; Name: 'GetPackageTarget'),\n (Index: 235; Name: 'GetVatsTargetHeight'),\n (Index: 237; Name: 'GetIsGhost'),\n (Index: 242; Name: 'GetUnconscious'),\n (Index: 244; Name: 'GetRestrained'),\n (Index: 246; Name: 'GetIsUsedItem'; ParamType1: ptReferencableObject),\n (Index: 247; Name: 'GetIsUsedItemType'; ParamType1: ptFormType),\n (Index: 248; Name: 'IsScenePlaying'; ParamType1: ptScene),\n (Index: 249; Name: 'IsInDialogueWithPlayer'),\n (Index: 250; Name: 'GetLocationCleared'; ParamType1: ptLocation),\n (Index: 254; Name: 'GetIsPlayableRace'),\n (Index: 255; Name: 'GetOffersServicesNow'),\n (Index: 256; Name: 'GetGameSetting'; ParamType1: ptNone),\n (Index: 258; Name: 'HasAssociationType'; ParamType1: ptActor; ParamType2: ptAssociationType),\n (Index: 259; Name: 'HasFamilyRelationship'; ParamType1: ptActor),\n (Index: 261; Name: 'HasParentRelationship'; ParamType1: ptActor),\n (Index: 262; Name: 'IsWarningAbout'; ParamType1: ptFormList),\n (Index: 263; Name: 'IsWeaponOut'),\n (Index: 264; Name: 'HasSpell'; ParamType1: ptMagicItem),\n (Index: 265; Name: 'IsTimePassing'),\n (Index: 266; Name: 'IsPleasant'),\n (Index: 267; Name: 'IsCloudy'),\n (Index: 274; Name: 'IsSmallBump'),\n (Index: 275; Name: 'GetParentRef'),\n (Index: 277; Name: 'GetBaseValue'; ParamType1: ptActorValue),\n (Index: 278; Name: 'IsOwner'; ParamType1: ptOwner),\n (Index: 280; Name: 'IsCellOwner'; ParamType1: ptCell; ParamType2: ptOwner),\n (Index: 282; Name: 'IsHorseStolen'),\n (Index: 285; Name: 'IsLeftUp'),\n (Index: 286; Name: 'IsSneaking'),\n (Index: 287; Name: 'IsRunning'),\n (Index: 288; Name: 'GetFriendHit'),\n (Index: 289; Name: 'IsInCombat'; ParamType1: ptInteger),\n (Index: 296; Name: 'IsAnimPlaying'; ParamType1: ptReferencableObject),\n (Index: 300; Name: 'IsInInterior'),\n (Index: 303; Name: 'IsActorsAIOff'),\n (Index: 304; Name: 'IsWaterObject'),\n (Index: 305; Name: 'GetPlayerAction'),\n (Index: 306; Name: 'IsActorUsingATorch'),\n (Index: 309; Name: 'IsXBox'),\n (Index: 310; Name: 'GetInWorldspace'; ParamType1: ptWorldspace),\n (Index: 312; Name: 'GetPCMiscStat'; ParamType1: ptMiscStat),\n (Index: 313; Name: 'GetPairedAnimation'),\n (Index: 314; Name: 'IsActorAVictim'),\n (Index: 315; Name: 'GetTotalPersuasionNumber'),\n (Index: 318; Name: 'GetIdleDoneOnce'),\n (Index: 320; Name: 'GetNoRumors'),\n (Index: 323; Name: 'GetCombatState'),\n (Index: 325; Name: 'GetWithinPackageLocation'; ParamType1: ptPackdata),\n (Index: 327; Name: 'IsRidingMount'),\n (Index: 329; Name: 'IsFleeing'),\n (Index: 332; Name: 'IsInDangerousWater'),\n (Index: 338; Name: 'GetIgnoreFriendlyHits'),\n (Index: 339; Name: 'IsPlayersLastRiddenMount'),\n (Index: 344; Name: 'ReleaseWeatherOverride'),\n (Index: 348; Name: 'SendTrespassAlarm'; ParamType1: ptActor),\n (Index: 353; Name: 'IsActor'),\n (Index: 354; Name: 'IsEssential'),\n (Index: 358; Name: 'IsPlayerMovingIntoNewSpace'),\n (Index: 359; Name: 'GetInCurrentLocation'; ParamType1: ptLocation),\n (Index: 360; Name: 'GetInCurrentLocationAlias'; ParamType1: ptAlias),\n (Index: 361; Name: 'GetTimeDead'),\n (Index: 362; Name: 'HasLinkedRef'; ParamType1: ptKeyword),\n (Index: 363; Name: 'GetLinkedRef'; ParamType1: ptKeyword),\n (Index: 365; Name: 'IsChild'),\n (Index: 366; Name: 'GetStolenItemValueNoCrime'; ParamType1: ptFaction),\n (Index: 367; Name: 'GetLastPlayerAction'),\n (Index: 368; Name: 'IsPlayerActionActive'; ParamType1: ptInteger),\n (Index: 370; Name: 'IsTalkingActivatorActor'; ParamType1: ptActor),\n (Index: 372; Name: 'IsInList'; ParamType1: ptFormList),\n (Index: 373; Name: 'GetStolenItemValue'; ParamType1: ptFaction),\n (Index: 375; Name: 'GetCrimeGoldViolent'; ParamType1: ptFaction),\n (Index: 376; Name: 'GetCrimeGoldNonviolent'; ParamType1: ptFaction),\n (Index: 378; Name: 'IsOwnedBy'; ParamType1: ptActor),\n (Index: 380; Name: 'GetCommandDistance'),\n (Index: 381; Name: 'GetCommandLocationDistance'),\n (Index: 387; Name: 'GetObjectiveFailed'; ParamType1: ptQuest; ParamType2: ptInteger),\n (Index: 390; Name: 'GetHitLocation'),\n (Index: 391; Name: 'IsPC1stPerson'),\n (Index: 396; Name: 'GetCauseofDeath'),\n (Index: 397; Name: 'IsLimbGone'; ParamType1: ptInteger),\n (Index: 398; Name: 'IsWeaponInList'; ParamType1: ptFormList),\n (Index: 402; Name: 'IsBribedbyPlayer'),\n (Index: 403; Name: 'GetRelationshipRank'; ParamType1: ptActor),\n (Index: 407; Name: 'GetVATSValue'; ParamType1: ptInteger; ParamType2: ptInteger),\n (Index: 408; Name: 'IsKiller'; ParamType1: ptActor),\n (Index: 409; Name: 'IsKillerObject'; ParamType1: ptFormList),\n (Index: 410; Name: 'GetFactionCombatReaction'; ParamType1: ptFaction; ParamType2: ptFaction),\n (Index: 414; Name: 'Exists'; ParamType1: ptObjectReference),\n (Index: 415; Name: 'GetGroupMemberCount'),\n (Index: 416; Name: 'GetGroupTargetCount'),\n (Index: 419; Name: 'GetObjectiveCompleted'; ParamType1: ptQuest; ParamType2: ptInteger),\n (Index: 420; Name: 'GetObjectiveDisplayed'; ParamType1: ptQuest; ParamType2: ptInteger),\n (Index: 425; Name: 'GetIsFormType'),\n (Index: 426; Name: 'GetIsVoiceType'; ParamType1: ptVoiceType),\n (Index: 427; Name: 'GetPlantedExplosive'),\n (Index: 429; Name: 'IsScenePackageRunning'),\n (Index: 430; Name: 'GetHealthPercentage'),\n (Index: 432; Name: 'GetIsObjectType'; ParamType1: ptFormType),\n (Index: 437; Name: 'GetIsCreatureType'; ParamType1: ptInteger),\n (Index: 438; Name: 'HasKey'; ParamType1: ptObjectReference),\n (Index: 439; Name: 'IsFurnitureEntryType'; ParamType1: ptReferencableObject),\n (Index: 444; Name: 'GetInCurrentLocationFormList'; ParamType1: ptFormList),\n (Index: 445; Name: 'GetInZone'; ParamType1: ptEncounterZone),\n (Index: 446; Name: 'GetVelocity'; ParamType1: ptAxis),\n (Index: 447; Name: 'GetGraphVariableFloat'),\n (Index: 448; Name: 'HasPerk'; ParamType1: ptPerk),\n (Index: 449; Name: 'GetFactionRelation'; ParamType1: ptActor),\n (Index: 450; Name: 'IsLastIdlePlayed'; ParamType1: ptIdleForm),\n (Index: 453; Name: 'GetPlayerTeammate'),\n (Index: 454; Name: 'GetPlayerTeammateCount'),\n (Index: 458; Name: 'GetActorCrimePlayerEnemy'),\n (Index: 459; Name: 'GetCrimeGold'; ParamType1: ptFaction),\n (Index: 462; Name: 'GetPlayerGrabbedRef'),\n (Index: 463; Name: 'IsPlayerGrabbedRef'; ParamType1: ptObjectReference),\n (Index: 465; Name: 'GetKeywordItemCount'; ParamType1: ptKeyword),\n (Index: 467; Name: 'GetBroadcastState'),\n (Index: 470; Name: 'GetDestructionStage'),\n (Index: 473; Name: 'GetIsAlignment'; ParamType1: ptAlignment),\n (Index: 476; Name: 'IsProtected'),\n (Index: 477; Name: 'GetThreatRatio'; ParamType1: ptActor),\n (Index: 479; Name: 'GetIsUsedItemEquipType'; ParamType1: ptEquipType),\n (Index: 480; Name: 'GetPlayerName'),\n (Index: 483; Name: 'GetPlayerActivated'),\n (Index: 485; Name: 'GetFullyEnabledActorsInHigh'),\n (Index: 487; Name: 'IsCarryable'),\n (Index: 488; Name: 'GetConcussed'),\n (Index: 489; Name: 'SetZoneRespawns'; ParamType1: ptEncounterZone; ParamType2: ptInteger),\n (Index: 490; Name: 'SetVATSTarget'; ParamType1: ptInteger),\n (Index: 491; Name: 'GetMapMarkerVisible'),\n (Index: 493; Name: 'PlayerKnows'; ParamType1: ptReferencableObject),\n (Index: 494; Name: 'GetPermanentValue'; ParamType1: ptActorValue),\n (Index: 495; Name: 'GetKillingBlowLimb'),\n (Index: 497; Name: 'CanPayCrimeGold'; ParamType1: ptFaction),\n (Index: 499; Name: 'GetDaysInJail'),\n (Index: 500; Name: 'EPAlchemyGetMakingPoison'),\n (Index: 501; Name: 'EPAlchemyEffectHasKeyword'; ParamType1: ptKeyword),\n (Index: 503; Name: 'GetAllowWorldInteractions'),\n (Index: 506; Name: 'DialogueGetAv'; ParamType1: ptActorValue),\n (Index: 507; Name: 'DialogueHasPerk'; ParamType1: ptPerk),\n (Index: 508; Name: 'GetLastHitCritical'),\n (Index: 510; Name: 'DialogueGetItemCount'; ParamType1: ptReferencableObject),\n (Index: 511; Name: 'LastCrippledCondition'; ParamType1: ptActorValue),\n (Index: 512; Name: 'HasSharedPowerGrid'; ParamType1: ptObjectReference),\n (Index: 513; Name: 'IsCombatTarget'; ParamType1: ptActor),\n (Index: 515; Name: 'GetVATSRightAreaFree'; ParamType1: ptObjectReference),\n (Index: 516; Name: 'GetVATSLeftAreaFree'; ParamType1: ptObjectReference),\n (Index: 517; Name: 'GetVATSBackAreaFree'; ParamType1: ptObjectReference),\n (Index: 518; Name: 'GetVATSFrontAreaFree'; ParamType1: ptObjectReference),\n (Index: 519; Name: 'GetIsLockBroken'),\n (Index: 520; Name: 'IsPS3'),\n (Index: 521; Name: 'IsWindowsPC'),\n (Index: 522; Name: 'GetVATSRightTargetVisible'; ParamType1: ptObjectReference),\n (Index: 523; Name: 'GetVATSLeftTargetVisible'; ParamType1: ptObjectReference),\n (Index: 524; Name: 'GetVATSBackTargetVisible'; ParamType1: ptObjectReference),\n (Index: 525; Name: 'GetVATSFrontTargetVisible'; ParamType1: ptObjectReference),\n (Index: 528; Name: 'IsInCriticalStage'; ParamType1: ptCriticalStage),\n (Index: 530; Name: 'GetXPForNextLevel'),\n (Index: 533; Name: 'GetInfamy'; ParamType1: ptFaction),\n (Index: 534; Name: 'GetInfamyViolent'; ParamType1: ptFaction),\n (Index: 535; Name: 'GetInfamyNonViolent'; ParamType1: ptFaction),\n (Index: 536; Name: 'GetTypeCommandPerforming'),\n (Index: 543; Name: 'GetQuestCompleted'; ParamType1: ptQuest),\n (Index: 544; Name: 'GetSpeechChallengeSuccessLevel'),\n (Index: 545; Name: 'PipBoyRadioOff'),\n (Index: 547; Name: 'IsGoreDisabled'),\n (Index: 550; Name: 'IsSceneActionComplete'; ParamType1: ptScene; ParamType2: ptInteger),\n (Index: 552; Name: 'GetSpellUsageNum'; ParamType1: ptMagicItem),\n (Index: 554; Name: 'GetActorsInHigh'),\n (Index: 555; Name: 'HasLoaded3D'),\n (Index: 559; Name: 'IsImageSpaceActive'; ParamType1: ptReferencableObject),\n (Index: 560; Name: 'HasKeyword'; ParamType1: ptKeyword),\n (Index: 561; Name: 'HasRefType'; ParamType1: ptRefType),\n (Index: 562; Name: 'LocationHasKeyword'; ParamType1: ptKeyword),\n (Index: 563; Name: 'LocationHasRefType'; ParamType1: ptRefType),\n (Index: 565; Name: 'GetIsEditorLocation'; ParamType1: ptLocation),\n (Index: 566; Name: 'GetIsAliasRef'; ParamType1: ptAlias),\n (Index: 567; Name: 'GetIsEditorLocationAlias'; ParamType1: ptAlias),\n (Index: 568; Name: 'IsSprinting'),\n (Index: 569; Name: 'IsBlocking'),\n (Index: 570; Name: 'HasEquippedSpell'; ParamType1: ptCastingSource),\n (Index: 571; Name: 'GetCurrentCastingType'; ParamType1: ptCastingSource),\n (Index: 572; Name: 'GetCurrentDeliveryType'; ParamType1: ptCastingSource),\n (Index: 574; Name: 'GetAttackState'),\n (Index: 575; Name: 'GetAliasedRef'; ParamType1: ptAlias),\n (Index: 576; Name: 'GetEventData'; ParamType1: ptEvent; ParamType2: ptEventData; ParamType3: ptNone), // fireundubh: Event Function, Event Member, Data (FO4)\n (Index: 577; Name: 'IsCloserToAThanB'; ParamType1: ptObjectReference; ParamType2: ptObjectReference),\n (Index: 578; Name: 'LevelMinusPCLevel'),\n (Index: 580; Name: 'IsBleedingOut'),\n (Index: 584; Name: 'GetRelativeAngle'; ParamType1: ptObjectReference; ParamType2: ptAxis),\n (Index: 589; Name: 'GetMovementDirection'),\n (Index: 590; Name: 'IsInScene'),\n (Index: 591; Name: 'GetRefTypeDeadCount'; ParamType1: ptLocation; ParamType2: ptRefType),\n (Index: 592; Name: 'GetRefTypeAliveCount'; ParamType1: ptLocation; ParamType2: ptRefType),\n (Index: 594; Name: 'GetIsFlying'),\n (Index: 595; Name: 'IsCurrentSpell'; ParamType1: ptMagicItem; ParamType2: ptCastingSource),\n (Index: 596; Name: 'SpellHasKeyword'; ParamType1: ptCastingSource; ParamType2: ptKeyword),\n (Index: 597; Name: 'GetEquippedItemType'; ParamType1: ptCastingSource),\n (Index: 598; Name: 'GetLocationAliasCleared'; ParamType1: ptAlias),\n (Index: 600; Name: 'GetLocationAliasRefTypeDeadCount'; ParamType1: ptAlias; ParamType2: ptRefType),\n (Index: 601; Name: 'GetLocationAliasRefTypeAliveCount'; ParamType1: ptAlias; ParamType2: ptRefType),\n (Index: 602; Name: 'IsWardState'; ParamType1: ptWardState),\n (Index: 603; Name: 'IsInSameCurrentLocationAsRef'; ParamType1: ptObjectReference; ParamType2: ptKeyword),\n (Index: 604; Name: 'IsInSameCurrentLocationAsRefAlias'; ParamType1: ptAlias; ParamType2: ptKeyword),\n (Index: 605; Name: 'LocationAliasIsLocation'; ParamType1: ptAlias; ParamType2: ptLocation),\n (Index: 606; Name: 'GetKeywordDataForLocation'; ParamType1: ptLocation; ParamType2: ptKeyword),\n (Index: 608; Name: 'GetKeywordDataForAlias'; ParamType1: ptAlias; ParamType2: ptKeyword),\n (Index: 610; Name: 'LocationAliasHasKeyword'; ParamType1: ptAlias; ParamType2: ptKeyword),\n (Index: 611; Name: 'IsNullPackageData'; ParamType1: ptPackdata),\n (Index: 612; Name: 'GetNumericPackageData'; ParamType1: ptPackdata),\n (Index: 613; Name: 'IsPlayerRadioOn'),\n (Index: 614; Name: 'GetPlayerRadioFrequency'),\n (Index: 615; Name: 'GetHighestRelationshipRank'),\n (Index: 616; Name: 'GetLowestRelationshipRank'),\n (Index: 617; Name: 'HasAssociationTypeAny'; ParamType1: ptAssociationType),\n (Index: 618; Name: 'HasFamilyRelationshipAny'),\n (Index: 619; Name: 'GetPathingTargetOffset'; ParamType1: ptAxis),\n (Index: 620; Name: 'GetPathingTargetAngleOffset'; ParamType1: ptAxis),\n (Index: 621; Name: 'GetPathingTargetSpeed'),\n (Index: 622; Name: 'GetPathingTargetSpeedAngle'; ParamType1: ptAxis),\n (Index: 623; Name: 'GetMovementSpeed'),\n (Index: 624; Name: 'GetInContainer'; ParamType1: ptObjectReference),\n (Index: 625; Name: 'IsLocationLoaded'; ParamType1: ptLocation),\n (Index: 626; Name: 'IsLocationAliasLoaded'; ParamType1: ptAlias),\n (Index: 627; Name: 'IsDualCasting'),\n (Index: 629; Name: 'GetVMQuestVariable'; ParamType1: ptQuest; ParamType2: ptNone),\n (Index: 630; Name: 'GetCombatAudioDetection'),\n (Index: 631; Name: 'GetCombatVisualDetection'),\n (Index: 632; Name: 'IsCasting'),\n (Index: 633; Name: 'GetFlyingState'),\n (Index: 635; Name: 'IsInFavorState'),\n (Index: 636; Name: 'HasTwoHandedWeaponEquipped'),\n (Index: 637; Name: 'IsFurnitureExitType'; ParamType1: ptReferencableObject),\n (Index: 638; Name: 'IsInFriendStatewithPlayer'),\n (Index: 639; Name: 'GetWithinDistance'; ParamType1: ptObjectReference; ParamType2: ptFloat),\n (Index: 640; Name: 'GetValuePercent'; ParamType1: ptActorValue),\n (Index: 641; Name: 'IsUnique'),\n (Index: 642; Name: 'GetLastBumpDirection'),\n (Index: 644; Name: 'GetInfoChallangeSuccess'),\n (Index: 645; Name: 'GetIsInjured'),\n (Index: 646; Name: 'GetIsCrashLandRequest'),\n (Index: 647; Name: 'GetIsHastyLandRequest'),\n (Index: 650; Name: 'IsLinkedTo'; ParamType1: ptObjectReference; ParamType2: ptKeyword),\n (Index: 651; Name: 'GetKeywordDataForCurrentLocation'; ParamType1: ptKeyword),\n (Index: 652; Name: 'GetInSharedCrimeFaction'; ParamType1: ptObjectReference),\n (Index: 653; Name: 'GetBribeAmount'),\n (Index: 654; Name: 'GetBribeSuccess'),\n (Index: 655; Name: 'GetIntimidateSuccess'),\n (Index: 656; Name: 'GetArrestedState'),\n (Index: 657; Name: 'GetArrestingActor'),\n (Index: 659; Name: 'HasVMScript'; ParamType1: ptNone),\n (Index: 660; Name: 'GetVMScriptVariable'; ParamType1: ptNone; ParamType2: ptNone),\n (Index: 661; Name: 'GetWorkshopResourceDamage'; ParamType1: ptActorValue),\n (Index: 664; Name: 'HasValidRumorTopic'; ParamType1: ptQuest),\n (Index: 672; Name: 'IsAttacking'),\n (Index: 673; Name: 'IsPowerAttacking'),\n (Index: 674; Name: 'IsLastHostileActor'),\n (Index: 675; Name: 'GetGraphVariableInt'; ParamType1: ptNone),\n (Index: 678; Name: 'ShouldAttackKill'; ParamType1: ptActor),\n (Index: 680; Name: 'GetActivationHeight'),\n (Index: 682; Name: 'WornHasKeyword'; ParamType1: ptKeyword),\n (Index: 683; Name: 'GetPathingCurrentSpeed'),\n (Index: 684; Name: 'GetPathingCurrentSpeedAngle'; ParamType1: ptAxis),\n (Index: 691; Name: 'GetWorkshopObjectCount'; ParamType1: ptReferencableObject),\n (Index: 693; Name: 'EPMagic_SpellHasKeyword'; ParamType1: ptKeyword),\n (Index: 694; Name: 'GetNoBleedoutRecovery'),\n (Index: 696; Name: 'EPMagic_SpellHasSkill'; ParamType1: ptActorValue),\n (Index: 697; Name: 'IsAttackType'; ParamType1: ptKeyword),\n (Index: 698; Name: 'IsAllowedToFly'),\n (Index: 699; Name: 'HasMagicEffectKeyword'; ParamType1: ptKeyword),\n (Index: 700; Name: 'IsCommandedActor'),\n (Index: 701; Name: 'IsStaggered'),\n (Index: 702; Name: 'IsRecoiling'),\n (Index: 703; Name: 'HasScopeWeaponEquipped'),\n (Index: 704; Name: 'IsPathing'),\n (Index: 705; Name: 'GetShouldHelp'; ParamType1: ptActor),\n (Index: 706; Name: 'HasBoundWeaponEquipped'; ParamType1: ptCastingSource),\n (Index: 707; Name: 'GetCombatTargetHasKeyword'; ParamType1: ptKeyword),\n (Index: 709; Name: 'GetCombatGroupMemberCount'),\n (Index: 710; Name: 'IsIgnoringCombat'),\n (Index: 711; Name: 'GetLightLevel'),\n (Index: 713; Name: 'SpellHasCastingPerk'; ParamType1: ptPerk),\n (Index: 714; Name: 'IsBeingRidden'),\n (Index: 715; Name: 'IsUndead'),\n (Index: 716; Name: 'GetRealHoursPassed'),\n (Index: 718; Name: 'IsUnlockedDoor'),\n (Index: 719; Name: 'IsHostileToActor'; ParamType1: ptActor),\n (Index: 720; Name: 'GetTargetHeight'; ParamType1: ptObjectReference),\n (Index: 721; Name: 'IsPoison'),\n (Index: 722; Name: 'WornApparelHasKeywordCount'; ParamType1: ptKeyword),\n (Index: 723; Name: 'GetItemHealthPercent'),\n (Index: 724; Name: 'EffectWasDualCast'),\n (Index: 725; Name: 'GetKnockStateEnum'),\n (Index: 726; Name: 'DoesNotExist'),\n (Index: 728; Name: 'GetPlayerWalkAwayFromDialogueScene'),\n (Index: 729; Name: 'GetActorStance'),\n (Index: 734; Name: 'CanProduceForWorkshop'),\n (Index: 735; Name: 'CanFlyHere'),\n (Index: 736; Name: 'EPIsDamageType'; ParamType1: ptDamageType),\n (Index: 738; Name: 'GetActorGunState'),\n (Index: 739; Name: 'GetVoiceLineLength'),\n (Index: 741; Name: 'ObjectTemplateItem_HasKeyword'; ParamType1: ptKeyword),\n (Index: 742; Name: 'ObjectTemplateItem_HasUniqueKeyword'; ParamType1: ptKeyword),\n (Index: 743; Name: 'ObjectTemplateItem_GetLevel'),\n (Index: 744; Name: 'MovementIdleMatches'; ParamType1: ptInteger; ParamType2: ptInteger), // TODO: determine correct param types (2)\n (Index: 745; Name: 'GetActionData'),\n (Index: 746; Name: 'GetActionDataShort'; ParamType1: ptInteger),\n (Index: 747; Name: 'GetActionDataByte'; ParamType1: ptInteger),\n (Index: 748; Name: 'GetActionDataFlag'; ParamType1: ptInteger),\n (Index: 749; Name: 'ModdedItemHasKeyword'; ParamType1: ptKeyword),\n (Index: 750; Name: 'GetAngryWithPlayer'),\n (Index: 751; Name: 'IsCameraUnderWater'),\n (Index: 753; Name: 'IsActorRefOwner'; ParamType1: ptActor),\n (Index: 754; Name: 'HasActorRefOwner'; ParamType1: ptActor),\n (Index: 756; Name: 'GetLoadedAmmoCount'),\n (Index: 757; Name: 'IsTimeSpanSunrise'),\n (Index: 758; Name: 'IsTimeSpanMorning'),\n (Index: 759; Name: 'IsTimeSpanAfternoon'),\n (Index: 760; Name: 'IsTimeSpanEvening'),\n (Index: 761; Name: 'IsTimeSpanSunset'),\n (Index: 762; Name: 'IsTimeSpanNight'),\n (Index: 763; Name: 'IsTimeSpanMidnight'),\n (Index: 764; Name: 'IsTimeSpanAnyDay'),\n (Index: 765; Name: 'IsTimeSpanAnyNight'),\n (Index: 766; Name: 'CurrentFurnitureHasKeyword'; ParamType1: ptKeyword),\n (Index: 767; Name: 'GetWeaponEquipIndex'),\n (Index: 769; Name: 'IsOverEncumbered'),\n (Index: 770; Name: 'IsPackageRequestingBlockedIdles'),\n (Index: 771; Name: 'GetActionDataInt'),\n (Index: 772; Name: 'GetVATSRightMinusLeftAreaFree'; ParamType1: ptObjectReference),\n (Index: 773; Name: 'GetInIronSights'; ParamType1: ptObjectReference),\n (Index: 774; Name: 'GetActorStaggerDirection'),\n (Index: 775; Name: 'GetActorStaggerMagnitude'),\n (Index: 776; Name: 'WornCoversBipedSlot'; ParamType1: ptInteger),\n (Index: 777; Name: 'GetInventoryValue'),\n (Index: 778; Name: 'IsPlayerInConversation'),\n (Index: 779; Name: 'IsInDialogueCamera'),\n (Index: 780; Name: 'IsMyDialogueTargetPlayer'),\n (Index: 781; Name: 'IsMyDialogueTargetActor'),\n (Index: 782; Name: 'GetMyDialogueTargetDistance'),\n (Index: 783; Name: 'IsSeatOccupied'; ParamType1: ptKeyword),\n (Index: 784; Name: 'IsPlayerRiding'),\n (Index: 785; Name: 'IsTryingEventCamera'),\n (Index: 786; Name: 'UseLeftSideCamera'),\n (Index: 787; Name: 'GetNoteType'),\n (Index: 788; Name: 'LocationHasPlayerOwnedWorkshop'),\n (Index: 789; Name: 'IsStartingAction'),\n (Index: 790; Name: 'IsMidAction'),\n (Index: 791; Name: 'IsWeaponChargeAttack'),\n (Index: 792; Name: 'IsInWorkshopMode'),\n (Index: 793; Name: 'IsWeaponChargingHoldAttack'),\n (Index: 794; Name: 'IsEncounterAbovePlayerLevel'),\n (Index: 795; Name: 'IsMeleeAttacking'),\n (Index: 796; Name: 'GetVATSQueuedTargetsUnique'),\n (Index: 797; Name: 'GetCurrentLocationCleared'),\n (Index: 798; Name: 'IsPowered'),\n (Index: 799; Name: 'GetTransmitterDistance'),\n (Index: 800; Name: 'GetCameraPlaybackTime'),\n (Index: 801; Name: 'IsInWater'),\n (Index: 802; Name: 'GetWithinActivateDistance'; ParamType1: ptObjectReference),\n (Index: 803; Name: 'IsUnderWater'),\n (Index: 804; Name: 'IsInSameSpace'; ParamType1: ptObjectReference),\n (Index: 805; Name: 'LocationAllowsReset'),\n (Index: 806; Name: 'GetVATSBackRightAreaFree'; ParamType1: ptObjectReference),\n (Index: 807; Name: 'GetVATSBackLeftAreaFree'; ParamType1: ptObjectReference),\n (Index: 808; Name: 'GetVATSBackRightTargetVisible'; ParamType1: ptObjectReference),\n (Index: 809; Name: 'GetVATSBackLeftTargetVisible'; ParamType1: ptObjectReference),\n (Index: 810; Name: 'GetVATSTargetLimbVisible'; ParamType1: ptObjectReference),\n (Index: 811; Name: 'IsPlayerListening'; ParamType1: ptFloat),\n (Index: 812; Name: 'GetPathingRequestedQuickTurn'),\n (Index: 813; Name: 'EPIsCalculatingBaseDamage'),\n (Index: 814; Name: 'GetReanimating'),\n (Index: 817; Name: 'IsInRobotWorkbench'),\n\n // F4SE\n (Index: 1024; Name: 'GetSKSEVersion'; ),\n (Index: 1025; Name: 'GetSKSEVersionMinor'; ),\n (Index: 1026; Name: 'GetSKSEVersionBeta'; ),\n (Index: 1027; Name: 'GetSKSERelease'; ),\n (Index: 1028; Name: 'ClearInvalidRegistrations'; )\n );\nvar\n wbCTDAFunctionEditInfo: string;\n\nfunction wbCTDAParamDescFromIndex(aIndex: Integer): PCTDAFunction;\nvar\n L, H, I, C: Integer;\nbegin\n Result := nil;\n\n L := Low(wbCTDAFunctions);\n H := High(wbCTDAFunctions);\n while L <= H do begin\n I := (L + H) shr 1;\n C := CmpW32(wbCTDAFunctions[I].Index, aIndex);\n if C < 0 then\n L := I + 1\n else begin\n H := I - 1;\n if C = 0 then begin\n L := I;\n Result := @wbCTDAFunctions[L];\n end;\n end;\n end;\nend;\n\nfunction wbCTDACompValueDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n // \"use global\" flag\n if Integer(Container.ElementByName['Type'].NativeValue) and $04 <> 0 then\n Result := 1;\nend;\n\nfunction wbCTDAParam1Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\n ParamFlag: Byte;\n ParamType: TCTDAFunctionParamType;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n\n if Assigned(Desc) then begin\n ParamType := Desc.ParamType1;\n ParamFlag := Container.ElementByName['Type'].NativeValue;\n if ParamType in [ptObjectReference, ptActor, ptPackage] then begin\n if ParamFlag and $02 > 0 then begin\n // except for this func when Run On = Quest Alias, then alias is param3 and package is param1\n // [INFO:00020D3C]\n if not ((Container.ElementByName['Run On'].NativeValue = 5) and (Desc.Name = 'GetIsCurrentPackage')) then\n ParamType := ptAlias {>>> 'use aliases' is set <<<}\n end\n else if ParamFlag and $08 > 0 then\n ParamType := ptPackdata; {>>> 'use packdata' is set <<<}\n end;\n Result := Succ(Integer(ParamType));\n end;\nend;\n\nfunction wbCTDAParam2Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\n ParamFlag: Byte;\n ParamType: TCTDAFunctionParamType;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n\n if Assigned(Desc) then begin\n ParamType := Desc.ParamType2;\n ParamFlag := Container.ElementByName['Type'].NativeValue;\n if ParamType in [ptObjectReference, ptActor, ptPackage] then begin\n if ParamFlag and $02 > 0 then ParamType := ptAlias else {>>> 'use aliases' is set <<<}\n if ParamFlag and $08 > 0 then ParamType := ptPackdata; {>>> 'use packdata' is set <<<}\n end;\n Result := Succ(Integer(ParamType));\n end;\nend;\n\nfunction wbCTDAParam2VATSValueParamDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Result := Container.ElementByName['Parameter #1'].NativeValue;\nend;\n\nfunction wbCTDAFunctionToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Desc : PCTDAFunction;\n i : Integer;\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := Desc.Name\n else if aType = ctToEditValue then\n Result := IntToStr(aInt)\n else\n Result := '';\n end;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctCheck: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := ''\n else\n Result := '';\n end;\n ctEditType:\n Result := 'ComboBox';\n ctEditInfo: begin\n Result := wbCTDAFunctionEditInfo;\n if Result = '' then begin\n with TStringList.Create do try\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n Add(wbCTDAFunctions[i].Name);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n wbCTDAFunctionEditInfo := Result;\n end;\n end;\n end;\nend;\n\nfunction wbCTDAFunctionToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i: Integer;\nbegin\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n with wbCTDAFunctions[i] do\n if SameText(Name, aString) then begin\n Result := Index;\n Exit;\n end;\n Result := StrToInt64(aString);\nend;\n\nfunction wbNeverShow(const aElement: IwbElement): Boolean;\nbegin\n Result := wbHideNeverShow;\nend;\n\nfunction GetREGNType(aElement: IwbElement): Integer;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := -1;\n if not Assigned(aElement) then\n Exit;\n while aElement.Name <> 'Region Data Entry' do begin\n aElement := aElement.Container;\n if not Assigned(aElement) then\n Exit;\n end;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n Result := Container.ElementNativeValues['RDAT\\Type'];\nend;\n\nfunction wbREGNObjectsDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 2;\nend;\n\nfunction wbREGNWeatherDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 3;\nend;\n\nfunction wbREGNMapDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 4;\nend;\n\nfunction wbREGNLandDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 5;\nend;\n\nfunction wbREGNGrassDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 6;\nend;\n\nfunction wbREGNSoundDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 7;\nend;\n\nfunction wbREGNImposterDontShow(const aElement: IwbElement): Boolean;\nbegin\n Result := GetREGNType(aElement) <> 8;\nend;\n\nfunction wbMESGTNAMDontShow(const aElement: IwbElement): Boolean;\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n Result := False;\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if Integer(Container.ElementNativeValues['DNAM']) and 1 <> 0 then\n Result := True;\nend;\n\nfunction wbEPFDDontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Entry Point Function Parameters' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if not (Integer(Container.ElementNativeValues['EPFT']) in [1..3]) then\n Result := True;\nend;\n\nfunction wbTES4ONAMDontShow(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n Result := False;\n if not Assigned(aElement) then\n Exit;\n MainRecord := aElement.ContainingMainRecord;\n if not Assigned(MainRecord) then\n Exit;\n if not MainRecord.IsESM then\n Result := True;\nend;\n\nfunction wbEPF2DontShow(const aElement: IwbElement): Boolean;\nvar\n Container: IwbContainerElementRef;\nbegin\n Result := False;\n if aElement.Name <> 'Entry Point Function Parameters' then\n Exit;\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n if not (Integer(Container.ElementNativeValues['EPFT']) in [4]) then\n Result := True;\nend;\n\nprocedure wbRemoveOFST(const aElement: IwbElement);\nvar\n Container: IwbContainer;\n rOFST: IwbRecord;\nbegin\n if not wbRemoveOffsetData then\n Exit;\n\n if Supports(aElement, IwbContainer, Container) then begin\n if wbBeginInternalEdit then try\n Container.RemoveElement(OFST);\n finally\n wbEndInternalEdit;\n end else begin\n rOFST := Container.RecordBySignature[OFST];\n if Assigned(rOFST) then\n Container.RemoveElement(rOFST);\n end;\n end;\nend;\n\nprocedure wbWRLDAfterLoad(const aElement: IwbElement);\n function OutOfRange(aValue: Integer; aRange: Integer = 256): Boolean;\n begin\n Result := (aValue < -aRange) or (aValue > aRange);\n end;\nvar\n MainRecord: IwbMainRecord;\n Container: IwbContainer;\nbegin\n wbRemoveOFST(aElement);\n\n if wbBeginInternalEdit then try\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.ElementExists['Unused RNAM'] then\n MainRecord.RemoveElement('Unused RNAM');\n\n //if MainRecord.ElementExists['World Default Level Data'] then\n // MainRecord.RemoveElement('World Default Level Data');\n\n //if MainRecord.ElementExists['MHDT'] then\n // MainRecord.RemoveElement('MHDT');\n\n if MainRecord.ElementExists['CLSZ'] then\n MainRecord.RemoveElement('CLSZ');\n\n // large values in object bounds cause stutter and performance issues in game (reported by Arthmoor)\n // CK can occasionally set them wrong, so make a warning\n if Supports(MainRecord.ElementByName['Object Bounds'], IwbContainer, Container) then\n if OutOfRange(StrToIntDef(Container.ElementEditValues['NAM0\\X'], 0)) or\n OutOfRange(StrToIntDef(Container.ElementEditValues['NAM0\\Y'], 0)) or\n OutOfRange(StrToIntDef(Container.ElementEditValues['NAM9\\X'], 0)) or\n OutOfRange(StrToIntDef(Container.ElementEditValues['NAM9\\Y'], 0))\n then\n wbProgressCallback('');\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbDOBJObjectsAfterLoad(const aElement: IwbElement);\nvar\n ObjectsContainer : IwbContainerElementRef;\n i : Integer;\n ObjectContainer : IwbContainerElementRef;\nbegin\n wbRemoveOFST(aElement);\n\n if wbBeginInternalEdit then try\n\n if not Supports(aElement, IwbContainerElementRef, ObjectsContainer) then\n Exit;\n\n for i := Pred(ObjectsContainer.ElementCount) downto 0 do\n if Supports(ObjectsContainer.Elements[i], IwbContainerElementRef, ObjectContainer) then\n if ObjectContainer.ElementNativeValues['Use'] = 0 then\n ObjectsContainer.RemoveElement(i, True);\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbActorTemplateUseTraits(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000001) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseStats(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000002) <> 0;\n end;\nend;\n\nfunction wbActorAutoCalcDontShow(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Flags'];\n Result := (i and $00000010) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseStatsAutoCalc(const aElement: IwbElement): Boolean;\nbegin\n Result := wbActorTemplateUseStats(aElement) or wbActorAutoCalcDontShow(aElement);\nend;\n\nfunction wbActorTemplateUseFactions(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000004) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseActorEffectList(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000008) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseAIData(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000010) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseAIPackages(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000020) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseModelAnimation(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000040) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseBaseData(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000080) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseInventory(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000100) <> 0;\n end;\nend;\n\nfunction wbActorTemplateUseScript(const aElement: IwbElement): Boolean;\nvar\n Element : IwbElement;\n MainRecord : IwbMainRecord;\n i : Int64;\nbegin\n Result := False;\n Element := aElement;\n MainRecord := nil;\n while Assigned(Element) and not Supports(Element, IwbMainRecord, MainRecord) do\n Element := Element.Container;\n if Assigned(MainRecord) then begin\n i := MainRecord.ElementNativeValues['ACBS\\Template Flags'];\n Result := (i and $00000200) <> 0;\n end;\nend;\n\nfunction wbActorTemplatesUseTemplate0(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 0 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate1(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 1 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate2(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 2 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate3(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 3 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate4(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 4 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate5(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 5 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate6(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 6 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate7(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 7 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate8(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 8 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate9(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 9 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate10(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 10 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate11(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 11 and 1) = 0\n else\n Result := False;\nend;\n\nfunction wbActorTemplatesUseTemplate12(const aElement: IwbElement): Boolean;\nvar\n MainRecord : IwbMainRecord;\nbegin\n MainRecord := aElement.ContainingMainRecord;\n if Assigned(MainRecord) then\n Result := (Cardinal(MainRecord.ElementNativeValues['ACBS\\Use Template Actors']) shr 12 and 1) = 0\n else\n Result := False;\nend;\n\nprocedure wbRemoveEmptyKWDA(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Assigned(Container.ElementBySignature['KSIZ']) then\n if Assigned(Container.ElementBySignature['KWDA']) then\n Container.ElementBySignature['KWDA'].Remove;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbReplaceBODTwithBOD2(const aElement: IwbElement);\nvar\n MainRecord : IwbMainRecord;\n ContainerBOD2 : IwbContainerElementRef;\n ContainerBODT : IwbContainerElementRef;\nbegin\n Exit; {>>> Looks like causes problems with Dawnguard.esm <<<}\n\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if not Supports(MainRecord.ElementBySignature[BODT], IwbContainerElementRef, ContainerBODT) then\n Exit;\n\n if Supports(MainRecord.Add('BOD2', True), IwbContainerElementRef, ContainerBOD2) then begin\n ContainerBOD2.ElementNativeValues['First Person Flags'] := ContainerBODT.ElementNativeValues['First Person Flags'];\n ContainerBOD2.ElementNativeValues['Armor Type'] := ContainerBODT.ElementNativeValues['Armor Type'];\n MainRecord.RemoveElement(BODT);\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbARMOAfterLoad(const aElement: IwbElement);\nbegin\n wbRemoveEmptyKWDA(aElement);\n wbReplaceBODTwithBOD2(aElement);\nend;\n\nprocedure wbARMAAfterLoad(const aElement: IwbElement);\n{var\n MainRecord : IwbMainRecord;}\nbegin\n wbReplaceBODTwithBOD2(aElement);\n {if wbBeginInternalEdit then try\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n if MainRecord.ElementNativeValues['DNAM\\Weight slider - Male'] = 0 then\n MainRecord.ElementNativeValues['DNAM\\Weight slider - Male'] := 2;\n if MainRecord.ElementNativeValues['DNAM\\Weight slider - Female'] = 0 then\n MainRecord.ElementNativeValues['DNAM\\Weight slider - Female'] := 2;\n finally\n wbEndInternalEdit;\n end;}\nend;\n\nprocedure wbNPCAfterLoad(const aElement: IwbElement);\nbegin\n wbRemoveEmptyKWDA(aElement);\nend;\n\nprocedure wbREFRAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Container.ElementExists['XLOC'] then begin\n if Container.ElementNativeValues['XLOC - Lock Data\\Level'] = 0 then\n Container.ElementNativeValues['XLOC - Lock Data\\Level'] := 1;\n end;\n\n Container.RemoveElement('XPTL');\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbWEAPAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n Flags : Cardinal;\nbegin\n wbRemoveEmptyKWDA(aElement);\n\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n // clear IronSights flags which are randomly assigned in CK\n if Container.ElementExists['DNAM'] then begin\n Flags := Container.ElementNativeValues['DNAM - Data\\Flags'];\n Flags := Flags and ($FFFF xor $0040);\n Container.ElementNativeValues['DNAM - Data\\Flags'] := Flags;\n Flags := Container.ElementNativeValues['DNAM - Data\\Flags2'];\n Flags := Flags and ($FFFFFFFF xor $0100);\n Container.ElementNativeValues['DNAM - Data\\Flags2'] := Flags;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbCELLXCLWGetConflictPriority(const aElement: IwbElement; var aCP: TwbConflictPriority);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n DataRec : IwbElement;\n Flags : Cardinal;\nbegin\n if not Assigned(aElement) then\n Exit;\n\n if not Supports(aElement.Container, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(Container, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n DataRec := MainRecord.ElementBySignature[DATA];\n\n if not Assigned(DataRec) then\n Exit;\n\n Flags := DataRec.NativeValue;\n\n {0x0001 Is Interior Cell}\n if (Flags and 1) = 1 then\n {Interior cells don't use water level in Skyrim at all}\n aCP := cpIgnore;\nend;\n\nprocedure wbCELLDATAAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Container : IwbContainer;\nbegin\n if not Assigned(aElement) then\n Exit;\n Container := aElement.Container;\n while Assigned(Container) and not (Container.Def.DefType = dtRecord) do\n Container := Container.Container;\n if Assigned(Container) then\n Container.ResetConflict;\nend;\n\nprocedure wbCELLAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n// Container2 : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n DataSubRec : IwbSubrecord;\n Flags : Byte;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if Supports(Container.ElementBySignature['DATA'] , IwbSubRecord, DataSubRec) then begin\n // expand itU8 flags to itU16\n if DataSubRec.SubRecordHeaderSize = 1 then begin\n Flags := PByte(DataSubRec.DataBasePtr)^;\n DataSubRec.SetToDefault;\n DataSubRec.NativeValue := Flags;\n end;\n // 'Default' water height for exterior cells if not set (so water height will be taken from WRLD by game)\n if (not Container.ElementExists['XCLW']) and ((Integer(DataSubRec.NativeValue) and $02) <> 0) then begin\n Container.Add('XCLW', True);\n Container.ElementEditValues['XCLW'] := 'Default';\n end;\n end;\n\n // Min (-0 as in CK) water height is set to 0 when saving in CK\n if Container.ElementEditValues['XCLW'] = 'Min' then\n Container.ElementEditValues['XCLW'] := '0.0';\n\n// if Supports(Container.ElementBySignature[XCLR], IwbContainerElementRef, Container2) then begin\n// for i := Pred(Container2.ElementCount) downto 0 do\n// if not Supports(Container2.Elements[i].LinksTo, IwbMainRecord, MainRecord) or (MainRecord.Signature <> 'REGN') then\n// Container2.RemoveElement(i);\n// if Container2.ElementCount < 1 then\n// Container2.Remove;\n// end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbMESGAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n IsMessageBox : Boolean;\n HasTimeDelay : Boolean;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n IsMessageBox := (Integer(Container.ElementNativeValues['DNAM']) and 1) = 1;\n HasTimeDelay := Container.ElementExists['TNAM'];\n\n if IsMessageBox = HasTimeDelay then\n if IsMessageBox then\n Container.RemoveElement('TNAM')\n else begin\n if not Container.ElementExists['DNAM'] then\n Container.Add('DNAM', True);\n Container.ElementNativeValues['DNAM'] := Integer(Container.ElementNativeValues['DNAM']) or 1;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbLIGHAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainerElementRef;\n MainRecord : IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Container.ElementExists['FNAM'] then begin\n Container.Add('FNAM', True);\n Container.ElementNativeValues['FNAM'] := 1.0;\n end;\n\n if Container.ElementExists['DATA'] then begin\n if SameValue(Container.ElementNativeValues['DATA\\Falloff Exponent'], 0.0) then\n Container.ElementNativeValues['DATA\\Falloff Exponent'] := 1.0;\n if SameValue(Container.ElementNativeValues['DATA\\FOV'], 0.0) then\n Container.ElementNativeValues['DATA\\FOV'] := 90.0;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbEFITAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n Element : IwbElement;\n ActorValue: Variant;\n MainRecord: IwbMainRecord;\nbegin\n if wbBeginInternalEdit then try\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n MainRecord := Container.ContainingMainRecord;\n if not Assigned(MainRecord) or MainRecord.IsDeleted then\n Exit;\n\n Element := Container.ElementByPath['..\\EFID'];\n if not Assigned(Element) then\n Exit;\n if not Supports(Element.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n if MainRecord.Signature <> 'MGEF' then\n Exit;\n ActorValue := MainRecord.ElementNativeValues['DATA - Data\\Actor Value'];\n if VarIsNull(ActorValue) or VarIsClear(ActorValue) then\n Exit;\n if VarCompareValue(ActorValue, Container.ElementNativeValues['Actor Value']) <> vrEqual then\n Container.ElementNativeValues['Actor Value'] := ActorValue;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbRPLDAfterLoad(const aElement: IwbElement);\nvar\n Container: IwbContainer;\n a, b: Single;\n NeedsFlip: Boolean;\nbegin\n if wbBeginInternalEdit then try\n if Supports(aElement, IwbContainer, Container) then begin\n NeedsFlip := False;\n if Container.ElementCount > 1 then begin\n a := StrToFloat((Container.Elements[0] as IwbContainer).Elements[0].Value);\n b := StrToFloat((Container.Elements[Pred(Container.ElementCount)] as IwbContainer).Elements[0].Value);\n case CompareValue(a, b) of\n EqualsValue: begin\n a := StrToFloat((Container.Elements[0] as IwbContainer).Elements[1].Value);\n b := StrToFloat((Container.Elements[Pred(Container.ElementCount)] as IwbContainer).Elements[1].Value);\n NeedsFlip := CompareValue(a, b) = GreaterThanValue;\n end;\n GreaterThanValue:\n NeedsFlip := True;\n end;\n end;\n if NeedsFlip then\n Container.ReverseElements;\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbLLEAfterLoad(const aElement: IwbElement);\nvar\n Container : IwbContainerElementRef;\n Entries : IwbContainerElementRef;\n MainRecord : IwbMainRecord;\n i : integer;\nbegin\n if wbBeginInternalEdit then try\n // zero entries' Chance None if Form Version < 69\n if wbFormVerDecider(nil, nil, aElement, 69) = 1 then\n Exit;\n\n if not Supports(aElement, IwbContainerElementRef, Container) then\n Exit;\n\n if Container.ElementCount < 1 then\n Exit;\n\n if not Supports(aElement, IwbMainRecord, MainRecord) then\n Exit;\n\n if MainRecord.IsDeleted then\n Exit;\n\n if not Supports(MainRecord.ElementByName['Leveled List Entries'], IwbContainerElementRef, Entries) then\n Exit;\n\n\n for i := 0 to Pred(Entries.ElementCount) do begin\n if not Supports(Entries.Elements[i], IwbContainerElementRef, Container) then\n Exit;\n Container.ElementNativeValues['LVLO\\Chance None'] := 0;\n end;\n\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbPubPackCNAMDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rANAM: IwbRecord;\n ctype: string;\nbegin\n Result := 0;\n rANAM := aElement.Container.RecordBySignature[ANAM];\n if Assigned(rANAM) then begin\n ctype := rANAM.NativeValue;\n if ctype = 'Bool' then Result := 1 else\n if ctype = 'Int' then Result := 2 else\n if ctype = 'Float' then Result := 3 else\n if ctype = 'ObjectList' then Result := 3;\n end;\nend;\n\nfunction wbTypeDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n Element : IwbElement;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Element := Container.ElementByName['Type'];\n if Assigned(Element) then\n Result := Element.NativeValue\n else if wbMoreInfoForDecider then\n wbProgressCallback('\"'+Container.Name+'\" does not contain an element named Type');\nend;\n\nprocedure wbCNTOsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('COCT - Count', aElement);\nend;\n\nprocedure wbContainerAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('COCT - Count', 'Items', aElement);\n wbCounterContainerAfterSet('KSIZ - Keyword Count', 'KWDA - Keywords', aElement);\nend;\n\nprocedure wbSPLOsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('SPCT - Count', aElement);\nend;\n\nprocedure wbKWDAsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('KSIZ - Keyword Count', aElement);\nend;\n\nprocedure wbNPCAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('COCT - Count', 'Items', aElement);\n wbCounterContainerAfterSet('SPCT - Count', 'Actor Effects', aElement);\n wbCounterContainerAfterSet('LLCT - Count', 'Leveled List Entries', aElement);\n wbCounterContainerAfterSet('KSIZ - Keyword Count', 'KWDA - Keywords', aElement);\n wbCounterContainerAfterSet('PRKZ - Perk Count', 'Perks', aElement);\nend;\n\nprocedure wbRaceAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('SPCT - Count', 'Actor Effects', aElement);\n wbCounterContainerAfterSet('KSIZ - Keyword Count', 'KWDA - Keywords', aElement);\nend;\n\nprocedure wbKeywordsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('KSIZ - Keyword Count', 'KWDA - Keywords', aElement);\nend;\n\nprocedure wbLVLOsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('LLCT - Count', aElement);\nend;\n\nprocedure wbLLEAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('LLCT - Count', 'Leveled List Entries', aElement);\nend;\n\nprocedure wbPRKRsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('PRKZ - Perk Count', aElement);\nend;\n\nprocedure wbSMQNQuestsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('QNAM - Quest Count', aElement);\nend;\n\nprocedure wbCTDAsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('CITC - Condition Count', aElement);\nend;\n\nprocedure wbConditionsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('CITC - Condition Count', 'Conditions', aElement);\nend;\n\nprocedure wbCounterEffectsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n // if it is really possible to have both counter effects and multiple data, this is going to be tricky.\n wbCounterByPathAfterSet('Magic Effect Data\\DATA - Data\\Counter effect count', aElement);\nend;\n\nprocedure wbMGEFAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbKeywordsAfterSet(aElement, aOldValue, aNewValue);\n wbCounterContainerByPathAfterSet('Magic Effect Data\\DATA - Data\\Counter effect count', 'Counter Effects', aElement);\nend;\n\nprocedure wbTERMDisplayItemsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('BSIZ - Count', aElement);\nend;\n\nprocedure wbTERMMenuItemsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('ISIZ - Count', aElement);\nend;\n\nprocedure wbSNDRRatesOfFireAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('ITMC - Count', aElement);\nend;\n\nprocedure wbNPCActorSoundsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('CS2H - Count', aElement);\nend;\n\nprocedure wbMorphPresetsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('MPPC - Count', aElement);\nend;\n\nprocedure wbLENSAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('LFSP - Count', aElement);\nend;\n\n\nprocedure wbIDLAsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Container : IwbContainer;\n SelfAsContainer : IwbContainer;\nbegin\n if wbBeginInternalEdit then try\n if not wbCounterAfterSet('IDLC - Animation Count', aElement) then\n if Supports(aElement.Container, IwbContainer, Container) then begin\n Element := Container.ElementByPath['IDLC'];\n if Assigned(Element) and Supports(aElement, IwbContainer, SelfAsContainer) and\n (Element.GetNativeValue<>SelfAsContainer.GetElementCount) then\n Element.SetNativeValue(SelfAsContainer.GetElementCount);\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nprocedure wbAnimationsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Elems : IwbElement;\n Container : IwbContainer;\nbegin\n if wbBeginInternalEdit then try\n if not wbCounterContainerAfterSet('IDLC - Animation Count', 'IDLA - Animations', aElement) then\n if Supports(aElement, IwbContainer, Container) then begin\n Element := Container.ElementByPath['IDLC\\Animation Count'];\n Elems := Container.ElementByName['IDLA - Animations'];\n if Assigned(Element) and not Assigned(Elems) then\n if Element.GetNativeValue<>0 then\n Element.SetNativeValue(0);\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbOffsetDataColsCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbDataContainer;\n Element : IwbElement;\n fResult : Extended;\nbegin\n Result := 0;\n\n if Supports(aElement.Container, IwbDataContainer, Container) and (Container.Name = 'OFST - Offset Data') and\n Supports(Container.Container, IwbDataContainer, Container) then begin\n Element := Container.ElementByPath['Object Bounds\\NAM0 - Min\\X'];\n if Assigned(Element) then begin\n fResult := Element.NativeValue;\n if fResult >= MaxInt then\n Result := 0\n else\n Result := Trunc(fResult);\n Element := Container.ElementByPath['Object Bounds\\NAM9 - Max\\X'];\n if Assigned(Element) then begin\n fResult := Element.NativeValue;\n if fResult >= MaxInt then\n Result := 1\n else\n Result := Trunc(fResult) - Result + 1;\n end;\n end;\n end;\nend;\n\nprocedure wbOMODpropertyAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('Property Count', aElement);\nend;\n\nprocedure wbOMODincludeAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('Include Count', aElement);\nend;\n\nprocedure wbOMODdataAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterContainerAfterSet('Property Count', 'Properties', aElement);\n wbCounterContainerAfterSet('Include Count', 'Includes', aElement);\nend;\n\nfunction wbOMODDataIncludeCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\nbegin\n if Supports(aElement.Container, IwbContainer, Container) then\n Result := Container.ElementNativeValues['Include Count']\n else\n Result := 0;\nend;\n\nfunction wbOMODDataPropertyCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\nbegin\n if Supports(aElement.Container, IwbContainer, Container) then\n Result := Container.ElementNativeValues['Property Count']\n else\n Result := 0;\nend;\n\nfunction GetObjectModPropertyEnum(const aElement: IwbElement): IwbEnumDef;\nvar\n MainRecord: IwbMainRecord;\n rDATA: IwbContainer;\n Signature: TwbSignature;\n FormType: Cardinal;\nbegin\n Result := nil;\n\n MainRecord := aElement.ContainingMainRecord;\n\n if not Assigned(MainRecord) then\n Exit;\n\n Signature := MainRecord.Signature;\n\n if Signature = OMOD then\n if Supports(MainRecord.ElementBySignature['DATA'], IwbContainer, rDATA) then begin\n FormType := rDATA.ElementNativeValues['Form Type'];\n Signature := PwbSignature(@FormType)^;\n end;\n\n if Signature = ARMO then\n Result := wbArmorPropertyEnum\n else if Signature = WEAP then\n Result := wbWeaponPropertyEnum\n else if Signature = NPC_ then\n Result := wbActorPropertyEnum;\nend;\n\nfunction wbObjectModPropertyToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n PropEnum: IwbEnumDef;\nbegin\n Result := '';\n\n PropEnum := GetObjectModPropertyEnum(aElement);\n\n if not Assigned(PropEnum) then\n case aType of\n ctToStr, ctToSortKey, ctToEditValue: Result := IntToStr(aInt);\n end\n else\n case aType of\n ctToStr: Result := PropEnum.ToString(aInt, aElement);\n ctToSortKey: Result := PropEnum.ToSortKey(aInt, aElement);\n ctCheck: Result := PropEnum.Check(aInt, aElement);\n ctToEditValue: Result := PropEnum.ToEditValue(aInt, aElement);\n ctEditType: Result := 'ComboBox';\n ctEditInfo: Result := PropEnum.EditInfo[aInt, aElement];\n end;\nend;\n\nfunction wbObjectModPropertyToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n PropEnum: IwbEnumDef;\nbegin\n PropEnum := GetObjectModPropertyEnum(aElement);\n\n if not Assigned(PropEnum) then\n Result := StrToIntDef(aString, 0)\n else\n Result := PropEnum.FromEditValue(aString, aElement);\nend;\n\nfunction wbOMODDataFunctionTypeDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n ValueType : Integer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n ValueType := Container.ElementNativeValues['Value Type'];\n\n case ValueType of\n 0: Result := 0;\n 1: Result := 0;\n 2: Result := 1;\n 4: Result := 3;\n 5: Result := 2;\n 6: Result := 3;\n end;\nend;\n\nfunction wbOMODDataPropertyValue1Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n ValueType : Integer;\n PropName : string;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n ValueType := Container.ElementNativeValues['Value Type'];\n PropName := Container.ElementEditValues['Property'];\n\n case ValueType of\n 0: Result := 1;\n 1: Result := 2;\n 2: Result := 3;\n 4, 6: Result := 4;\n 5: begin\n if PropName = 'SoundLevel' then Result := 6 else\n if PropName = 'StaggerValue' then Result := 7 else\n if PropName = 'HitBehaviour' then Result := 8 else\n Result := 5;\n end;\n end;\nend;\n\nfunction wbOMODDataPropertyValue2Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container : IwbContainer;\n ValueType : Integer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n ValueType := Container.ElementNativeValues['Value Type'];\n\n case ValueType of\n 0: Result := 1;\n 1: Result := 2;\n 2: Result := 3;\n 4: Result := 1;\n 6: Result := 2;\n end;\nend;\n\nprocedure wbOBTSCombinationsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('OBTE - Count', aElement);\nend;\n\nprocedure wbINNRAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('VNAM - Count', aElement);\nend;\n\nfunction wbCELLCombinedMeshesCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\nbegin\n if Supports(aElement.Container, IwbContainer, Container) then\n Result := Container.ElementNativeValues['Meshes Count']\n else\n Result := 0;\nend;\n\nprocedure wbCELLCombinedMeshesAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nbegin\n wbCounterAfterSet('Meshes Count', aElement);\nend;\n\nfunction wbCELLCombinedRefsCounter(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Cardinal;\nvar\n Container : IwbContainer;\nbegin\n // the counter is double of entries (each member of struct is counted)\n if Supports(aElement.Container, IwbContainer, Container) then\n Result := Container.ElementNativeValues['References Count'] div 2\n else\n Result := 0;\nend;\n\nprocedure wbCELLCombinedRefsAfterSet(const aElement: IwbElement; const aOldValue, aNewValue: Variant);\nvar\n Element : IwbElement;\n Container : IwbContainer;\n SelfAsContainer : IwbContainer;\nbegin\n // the counter is double of entries (each member of struct is counted)\n if wbBeginInternalEdit then try\n if Supports(aElement.Container, IwbContainer, Container) and\n Supports(aElement, IwbContainer, SelfAsContainer) then begin\n Element := Container.ElementByName['References Count'];\n if Assigned(Element) then try\n if (Element.GetNativeValue <> (SelfAsContainer.GetElementCount * 2)) then\n Element.SetNativeValue(SelfAsContainer.GetElementCount * 2);\n except end;\n end;\n finally\n wbEndInternalEdit;\n end;\nend;\n\nfunction wbCombinedMeshIDToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Cell: IwbMainRecord;\nbegin\n Result := IntToHex(aInt, 8);\n\n Cell := aElement.ContainingMainRecord;\n if not Assigned(Cell) then\n Exit;\n\n case aType of\n ctToStr, ctToEditValue: begin\n Result := 'Precombined\\' + IntToHex(Cell.FormID and $00FFFFFF, 8) + '_' + Result + '_OC.nif';\n end;\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbCombinedMeshIDToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\n i: Integer;\nbegin\n Result := 0;\n // hex number between first and second underscope\n i := Pos('_', aString);\n if i <> 0 then begin\n s := Copy(aString, i + 1, Length(aString) - i);\n i := Pos('_', s);\n if i <> 0 then begin\n s := Copy(s, 1, i - 1);\n if Length(s) = 8 then try\n Result := StrToInt64('$' + s);\n except end;\n end;\n end;\nend;\n\nfunction wbREFRRecordFlagsDecider(const aElement: IwbElement): Integer;\nvar\n MainRecord : IwbMainRecord;\n NameRec : IwbElement;\nbegin\n Result := 0;\n\n if not Assigned(aElement) then\n Exit;\n\n MainRecord := aElement.ContainingMainRecord;\n\n if not Assigned(MainRecord) then\n Exit;\n\n NameRec := MainRecord.ElementBySignature[NAME];\n if not Assigned(NameRec) then\n Exit;\n\n if not Supports(NameRec.LinksTo, IwbMainRecord, MainRecord) then\n Exit;\n\n if (MainRecord.Signature = ACTI) or\n (MainRecord.Signature = STAT) or\n (MainRecord.Signature = SCOL) or\n (MainRecord.Signature = TREE)\n then\n Result := 1\n else if\n (MainRecord.Signature = CONT) or\n (MainRecord.Signature = TERM)\n then\n Result := 2\n else if MainRecord.Signature = DOOR then\n Result := 3\n else if MainRecord.Signature = LIGH then\n Result := 4\n else if MainRecord.Signature = MSTT then\n Result := 5\n else if MainRecord.Signature = ADDN then\n Result := 6\n else if\n (MainRecord.Signature = SCRL) or\n (MainRecord.Signature = AMMO) or\n (MainRecord.Signature = ARMO) or\n (MainRecord.Signature = BOOK) or\n (MainRecord.Signature = INGR) or\n (MainRecord.Signature = KEYM) or\n (MainRecord.Signature = MISC) or\n (MainRecord.Signature = FURN) or\n (MainRecord.Signature = WEAP) or\n (MainRecord.Signature = ALCH)\n then\n Result := 7;\nend;\n\nfunction wbByteColors(const aName: string = 'Color'): IwbStructDef;\nbegin\n Result := wbStruct(aName, [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unused', 1)\n ]);\nend;\n\nfunction wbFloatColors(const aName: string = 'Color'): IwbStructDef;\nbegin\n Result := wbStruct(aName, [\n wbFloat('Red', cpNormal, True, 255, 0),\n wbFloat('Green', cpNormal, True, 255, 0),\n wbFloat('Blue', cpNormal, True, 255, 0)\n ]);\nend;\n\nfunction wbWeatherColors(const aName: string): IwbStructDef;\nbegin\n Result := wbStruct(aName, [\n wbByteColors('Sunrise'),\n wbByteColors('Day'),\n wbByteColors('Sunset'),\n wbByteColors('Night'),\n wbByteColors('EarlySunrise'),\n wbByteColors('LateSunrise'),\n wbByteColors('EarlySunset'),\n wbByteColors('LateSunset')\n ], cpNormal, True, nil, 4);\nend;\n\nfunction wbAmbientColors(const aSignature: TwbSignature; const aName: string = 'Directional Ambient Lighting Colors'): IwbSubRecordDef; overload;\nbegin\n Result := wbStruct(aSignature, aName, [\n wbStruct('Directional', [\n wbByteColors('X+'),\n wbByteColors('X-'),\n wbByteColors('Y+'),\n wbByteColors('Y-'),\n wbByteColors('Z+'),\n wbByteColors('Z-')\n ]),\n wbByteColors('Specular'),\n wbFloat('Scale')\n ])\nend;\n\nfunction wbAmbientColors(const aName: string = 'Directional Ambient Lighting Colors'): IwbStructDef; overload;\nbegin\n Result := wbStruct(aName, [\n wbStruct('Directional', [\n wbByteColors('X+'),\n wbByteColors('X-'),\n wbByteColors('Y+'),\n wbByteColors('Y-'),\n wbByteColors('Z+'),\n wbByteColors('Z-')\n ]),\n wbByteColors('Specular'),\n wbFloat('Scale', cpIgnore)\n ]);\nend;\n\nfunction wbIntToHexStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n case aType of\n ctToStr, ctToSortKey, ctToEditValue: Result := IntToHex(aInt, 8);\n else\n Result := '';\n end;\nend;\n\nfunction wbStrToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\n i: integer;\nbegin\n // ignore anything after space or :\n i := Pos(' ', aString);\n if i = 0 then\n i := Pos(':', aString);\n\n if i <> 0 then\n s := Copy(aString, 1, i - 1)\n else\n s := aString;\n\n try\n Result := StrToInt64(s)\n except\n Result := 0;\n end;\nend;\n\nfunction wbHexStrToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n s: string;\n i: integer;\nbegin\n // ignore anything after space or :\n i := Pos(' ', aString);\n if i = 0 then\n i := Pos(':', aString);\n\n if i <> 0 then\n s := Copy(aString, 1, i - 1)\n else\n s := aString;\n\n try\n Result := StrToInt64('$' + s)\n except\n Result := 0;\n end;\nend;\n\ntype\n TFaceGenFeature = record\n RaceID : String;\n Female : Boolean;\n Entries : array of record\n Index: Cardinal;\n Name : String;\n end;\n end;\n PFaceGenFeature = ^TFaceGenFeature;\n\nvar\n // cache of race specific face morphs\n FaceMorphs: array of TFaceGenFeature;\n // cache of race specific tint layers\n TintLayers: array of TFaceGenFeature;\n // cache of race specific morph groups/presets and values\n MorphValues: array of TFaceGenFeature;\n\n\nfunction wbMorphValueToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\n\n function GetCached(const aRaceID: string; aFemale: boolean): PFaceGenFeature;\n var\n i: integer;\n begin\n Result := nil;\n if Length(MorphValues) <> 0 then\n for i := Low(MorphValues) to High(MorphValues) do\n if (MorphValues[i].Female = aFemale) and (MorphValues[i].RaceID = aRaceID) then begin\n Result := @MorphValues[i];\n Break;\n end;\n end;\n\nvar\n Actor, Race : IwbMainRecord;\n Element : IwbElement;\n Container, Entry : IwbContainerElementRef;\n Container2, Entry2: IwbContainerElementRef;\n Female, Female2 : Boolean;\n RaceID, EntryName : string;\n Cache : PFaceGenFeature;\n Index : Cardinal;\n i, j, k : integer;\n slList : TStringList;\nbegin\n // defaults\n case aType of\n ctToStr, ctToEditValue: Result := IntToHex64(aInt, 8);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n Actor := aElement.ContainingMainRecord;\n if not Assigned(Actor) then\n Exit;\n\n Female := Actor.ElementEditValues['ACBS\\Flags\\Female'] = '1';\n\n Element := Actor.ElementBySignature['RNAM'];\n if not Assigned(Element) then\n Exit;\n\n Element := Element.LinksTo;\n if not Supports(Element, IwbMainRecord, Race) then\n Exit;\n\n Race := Race.WinningOverride;\n RaceID := Race.EditorID;\n\n Cache := GetCached(RaceID, Female);\n\n // cache not found, fill with data from RACE\n if not Assigned(Cache) then begin\n\n slList := TStringList.Create;\n\n for i := 0 to 1 do begin\n\n Female2 := i = 1;\n SetLength(MorphValues, Succ(Length(MorphValues)));\n Cache := @MorphValues[Pred(Length(MorphValues))];\n Cache.RaceID := RaceID;\n Cache.Female := Female2;\n\n slList.Clear;\n\n if not Female2 then\n Element := Race.ElementByName['Male Morph Groups']\n else\n Element := Race.ElementByName['Female Morph Groups'];\n\n // iterate over morph groups\n if Supports(Element, IwbContainerElementRef, Container) then\n for j := 0 to Pred(Container.ElementCount) do begin\n if not Supports(Container.Elements[j], IwbContainerElementRef, Entry) then\n Break;\n\n // group name\n EntryName := Entry.ElementEditValues['MPGN'];\n\n // iterate over morph group presets\n if not Supports(Entry.ElementByName['Morph Presets'], IwbContainerElementRef, Container2) then\n Continue;\n\n for k := 0 to Pred(Container2.ElementCount) do\n if Supports(Container2.Elements[k], IwbContainerElementRef, Entry2) then\n slList.AddObject(\n EntryName + ' - ' + Entry2.ElementEditValues['MPPN'],\n TObject(Cardinal(Entry2.ElementNativeValues['MPPI']))\n );\n end;\n\n // append morph values, same for both sexes\n if Supports(Race.ElementByName['Morph Values'], IwbContainerElementRef, Container) then\n for j := 0 to Pred(Container.ElementCount) do\n if Supports(Container.Elements[j], IwbContainerElementRef, Entry) then\n slList.AddObject(\n Entry.ElementEditValues['MSM0'] + '/' + Entry.ElementEditValues['MSM1'],\n TObject(Cardinal(Entry.ElementNativeValues['MSID']))\n );\n\n SetLength(Cache.Entries, slList.Count);\n\n for j := 0 to Pred(slList.Count) do begin\n Cache.Entries[j].Index := Cardinal(slList.Objects[j]);\n Cache.Entries[j].Name := slList[j];\n end;\n\n end;\n\n slList.Free;\n\n Cache := GetCached(RaceID, Female);\n end;\n\n if not Assigned(Cache) then\n Exit;\n\n EntryName := '';\n Index := Cardinal(aInt);\n if Length(Cache.Entries) <> 0 then\n for i := Low(Cache.Entries) to High(Cache.Entries) do\n if Cache.Entries[i].Index = Index then begin\n EntryName := Cache.Entries[i].Name;\n Break;\n end;\n\n case aType of\n ctToStr: begin\n if EntryName <> '' then\n Result := IntToHex64(aInt, 8) + ' ' + EntryName\n else\n Result := IntToHex64(aInt, 8) + ' ';\n end;\n ctCheck: begin\n if EntryName = '' then\n Result := ''\n else\n Result := '';\n end;\n ctEditType: Result := 'ComboBox';\n ctEditInfo: begin\n Result := '';\n if Length(Cache.Entries) <> 0 then\n for i := Low(Cache.Entries) to High(Cache.Entries) do begin\n if Result <> '' then Result := Result + ',';\n Result := Result + '\"' + IntToHex(Cache.Entries[i].Index, 8) + ' ' + Cache.Entries[i].Name + '\"';\n end;\n end;\n end;\nend;\n\n\n\nfunction wbFaceMorphToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\n\n function GetCached(const aRaceID: string; aFemale: boolean): PFaceGenFeature;\n var\n i: integer;\n begin\n Result := nil;\n if Length(FaceMorphs) <> 0 then\n for i := Low(FaceMorphs) to High(FaceMorphs) do\n if (FaceMorphs[i].Female = aFemale) and (FaceMorphs[i].RaceID = aRaceID) then begin\n Result := @FaceMorphs[i];\n Break;\n end;\n end;\n\nvar\n Actor, Race : IwbMainRecord;\n Element : IwbElement;\n Container, Entry : IwbContainerElementRef;\n Female, Female2 : Boolean;\n RaceID, EntryName : string;\n Cache : PFaceGenFeature;\n Index : Cardinal;\n i, j : integer;\nbegin\n // defaults\n case aType of\n ctToStr, ctToEditValue: Result := IntToHex64(aInt, 8);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n Actor := aElement.ContainingMainRecord;\n if not Assigned(Actor) then\n Exit;\n\n Female := Actor.ElementEditValues['ACBS\\Flags\\Female'] = '1';\n\n Element := Actor.ElementBySignature['RNAM'];\n if not Assigned(Element) then\n Exit;\n\n Element := Element.LinksTo;\n if not Supports(Element, IwbMainRecord, Race) then\n Exit;\n\n Race := Race.WinningOverride;\n RaceID := Race.EditorID;\n\n Cache := GetCached(RaceID, Female);\n\n // cache not found, fill with data from RACE\n if not Assigned(Cache) then begin\n\n for i := 0 to 1 do begin\n\n Female2 := i = 1;\n SetLength(FaceMorphs, Succ(Length(FaceMorphs)));\n Cache := @FaceMorphs[Pred(Length(FaceMorphs))];\n Cache.RaceID := RaceID;\n Cache.Female := Female2;\n\n if not Female2 then\n Element := Race.ElementByName['Male Face Morphs']\n else\n Element := Race.ElementByName['Female Face Morphs'];\n\n if not Supports(Element, IwbContainerElementRef, Container) then\n Continue;\n\n SetLength(Cache.Entries, Container.ElementCount);\n\n for j := 0 to Pred(Container.ElementCount) do begin\n if not Supports(Container.Elements[j], IwbContainerElementRef, Entry) then\n Break;\n Cache.Entries[j].Index := Entry.ElementNativeValues['FMRI'];\n Cache.Entries[j].Name := Entry.ElementEditValues['FMRN'];\n end;\n end;\n\n Cache := GetCached(RaceID, Female);\n end;\n\n if not Assigned(Cache) then\n Exit;\n\n EntryName := '';\n Index := Cardinal(aInt);\n if Length(Cache.Entries) <> 0 then\n for i := Low(Cache.Entries) to High(Cache.Entries) do\n if Cache.Entries[i].Index = Index then begin\n EntryName := Cache.Entries[i].Name;\n Break;\n end;\n\n case aType of\n ctToStr: begin\n if EntryName <> '' then\n Result := IntToHex64(aInt, 8) + ' ' + EntryName\n else\n Result := IntToHex64(aInt, 8) + ' ';\n end;\n ctCheck: begin\n if EntryName = '' then\n Result := ''\n else\n Result := '';\n end;\n ctEditType: Result := 'ComboBox';\n ctEditInfo: begin\n Result := '';\n if Length(Cache.Entries) <> 0 then\n for i := Low(Cache.Entries) to High(Cache.Entries) do begin\n if Result <> '' then Result := Result + ',';\n Result := Result + '\"' + IntToHex(Cache.Entries[i].Index, 8) + ' ' + Cache.Entries[i].Name + '\"';\n end;\n end;\n end;\nend;\n\nfunction wbTintLayerToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\n\n function GetCached(const aRaceID: string; aFemale: boolean): PFaceGenFeature;\n var\n i: integer;\n begin\n Result := nil;\n if Length(TintLayers) <> 0 then\n for i := Low(TintLayers) to High(TintLayers) do\n if (TintLayers[i].Female = aFemale) and (TintLayers[i].RaceID = aRaceID) then begin\n Result := @TintLayers[i];\n Break;\n end;\n end;\n\nvar\n Actor, Race : IwbMainRecord;\n Element : IwbElement;\n Container, Entry : IwbContainerElementRef;\n Container2, Entry2: IwbContainerElementRef;\n Female, Female2 : Boolean;\n RaceID, EntryName : string;\n Cache : PFaceGenFeature;\n Index : Cardinal;\n i, j, k : integer;\n slList : TStringList;\nbegin\n // defaults\n case aType of\n ctToStr, ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '';\n ctEditType: Result := '';\n ctEditInfo: Result := '';\n end;\n\n Actor := aElement.ContainingMainRecord;\n if not Assigned(Actor) then\n Exit;\n\n Female := Actor.ElementEditValues['ACBS\\Flags\\Female'] = '1';\n\n Element := Actor.ElementBySignature['RNAM'];\n if not Assigned(Element) then\n Exit;\n\n Element := Element.LinksTo;\n if not Supports(Element, IwbMainRecord, Race) then\n Exit;\n\n Race := Race.WinningOverride;\n RaceID := Race.EditorID;\n\n Cache := GetCached(RaceID, Female);\n\n // cache not found, fill with data from RACE\n if not Assigned(Cache) then begin\n\n slList := TStringList.Create;\n\n for i := 0 to 1 do begin\n\n Female2 := i = 1;\n SetLength(TintLayers, Succ(Length(TintLayers)));\n Cache := @TintLayers[Pred(Length(TintLayers))];\n Cache.RaceID := RaceID;\n Cache.Female := Female2;\n\n if not Female2 then\n Element := Race.ElementByName['Male Tint Layers']\n else\n Element := Race.ElementByName['Female Tint Layers'];\n\n if not Supports(Element, IwbContainerElementRef, Container) then\n Continue;\n\n slList.Clear;\n\n // iterate over tint groups\n for j := 0 to Pred(Container.ElementCount) do\n if Supports(Container.Elements[j], IwbContainerElementRef, Entry) then\n // iterate over tint group options\n if Supports(Entry.ElementByName['Options'], IwbContainerElementRef, Container2) then\n for k := 0 to Pred(Container2.ElementCount) do\n if Supports(Container2.Elements[k], IwbContainerElementRef, Entry2) then\n slList.AddObject(\n Entry.ElementEditValues['TTGP'] + ' - ' + Entry2.ElementEditValues['TTGP'],\n TObject(Cardinal(Entry2.ElementNativeValues['TETI\\Index']))\n );\n\n SetLength(Cache.Entries, slList.Count);\n\n for j := 0 to Pred(slList.Count) do begin\n Cache.Entries[j].Index := Cardinal(slList.Objects[j]);\n Cache.Entries[j].Name := slList[j];\n end;\n end;\n\n slList.Free;\n\n Cache := GetCached(RaceID, Female);\n end;\n\n if not Assigned(Cache) then\n Exit;\n\n EntryName := '';\n Index := Cardinal(aInt);\n if Length(Cache.Entries) <> 0 then\n for i := Low(Cache.Entries) to High(Cache.Entries) do\n if Cache.Entries[i].Index = Index then begin\n EntryName := Cache.Entries[i].Name;\n Break;\n end;\n\n case aType of\n ctToStr: begin\n if EntryName <> '' then\n Result := IntToStr(aInt) + ' ' + EntryName\n else\n Result := IntToStr(aInt) + ' ';\n end;\n ctCheck: begin\n if EntryName = '' then\n Result := ''\n else\n Result := '';\n end;\n ctEditType: Result := 'ComboBox';\n ctEditInfo: begin\n Result := '';\n if Length(Cache.Entries) <> 0 then\n for i := Low(Cache.Entries) to High(Cache.Entries) do begin\n if Result <> '' then Result := Result + ',';\n Result := Result + '\"' + IntToStr(Cache.Entries[i].Index) + ' ' + Cache.Entries[i].Name + '\"';\n end;\n end;\n end;\nend;\n\n\nvar\n wbRecordFlagsFlags : IwbFlagsDef;\n\nprocedure DefineFO4a;\n\nbegin\n wbNull := wbByteArray('Unused', -255);\n wbBoolEnum := wbEnum(['False', 'True']);\n wbLLCT := wbInteger(LLCT, 'Count', itU8, nil, cpBenign);\n wbCITC := wbInteger(CITC, 'Condition Count', itU32, nil, cpBenign);\n wbLVLD := wbInteger(LVLD, 'Chance None', itU8, nil, cpNormal, True);\n\n wbSPCT := wbInteger(SPCT, 'Count', itU32, nil, cpBenign);\n wbSPLO := wbFormIDCk(SPLO, 'Actor Effect', [SPEL, LVSP]);\n wbSPLOs := wbRArrayS('Actor Effects', wbSPLO, cpNormal, False, nil, wbSPLOsAfterSet, nil{wbActorTemplateUseActorEffectList});\n\n wbKSIZ := wbInteger(KSIZ, 'Keyword Count', itU32, nil, cpBenign);\n wbKWDAs := wbArrayS(KWDA, 'Keywords', wbFormIDCk('Keyword', [KYWD, NULL]), 0, cpNormal, False, nil, wbKWDAsAfterSet);\n wbReqKWDAs := wbArrayS(KWDA, 'Keywords', wbFormIDCk('Keyword', [KYWD, NULL]), 0, cpNormal, True, nil, wbKWDAsAfterSet);\n\n wbKeywords := wbRStruct('Keywords', [\n wbKSIZ,\n wbReqKWDAs\n ], []);\n\n //wbActorValue := wbInteger('Actor Value', itS32, wbActorValueEnum);\n wbActorValue := wbFormIDCkNoReach('Actor Value', [AVIF, NULL]);\n\n wbCOED := wbStructExSK(COED, [2], [0, 1], 'Extra Data', [\n {00} wbFormIDCkNoReach('Owner', [NPC_, FACT, NULL]),\n {04} wbUnion('Global Variable / Required Rank', wbCOEDOwnerDecider, [\n wbByteArray('Unused', 4, cpIgnore),\n wbFormIDCk('Global Variable', [GLOB, NULL]),\n wbInteger('Required Rank', itS32)\n ]),\n {08} wbFloat('Item Condition')\n ]);\n\n wbCNTO :=\n wbRStructExSK([0], [1], 'Item', [\n wbStructExSK(CNTO, [0], [1], 'Item', [\n wbFormIDCk('Item', sigBaseObjects),\n wbInteger('Count', itS32)\n ]),\n wbCOED\n ], []);\n wbCOCT := wbInteger(COCT, 'Count', itU32, nil, cpBenign);\n wbCNTOs := wbRArrayS('Items', wbCNTO, cpNormal, False, nil, wbCNTOsAfterSet);\n\n {>>> When NAME is user defined these will be incorrect <<<}\n wbBipedObjectEnum := wbEnum([\n '30 - Hair Top',\n '31 - Hair Long',\n '32 - FaceGen Head',\n '33 - BODY',\n '34 - L Hand',\n '35 - R Hand',\n '36 - [U] Torso',\n '37 - [U] L Arm',\n '38 - [U] R Arm',\n '39 - [U] L Leg',\n '40 - [U] R Leg',\n '41 - [A] Torso',\n '42 - [A] L Arm',\n '43 - [A] R Arm',\n '44 - [A] L Leg',\n '45 - [A] R Leg',\n '46 - Headband',\n '47 - Eyes',\n '48 - Beard',\n '49 - Mouth',\n '50 - Neck',\n '51 - Ring',\n '52 - Scalp',\n '53 - Decapitation',\n '54 - Unnamed',\n '55 - Unnamed',\n '56 - Unnamed',\n '57 - Unnamed',\n '58 - Unnamed',\n '59 - Shield',\n '60 - Pipboy',\n '61 - FX'\n ], [\n -1, 'None'\n ]);\n\n wbBipedObjectFlags := wbFlags([\n {0x00000001} '30 - Hair Top',\n {0x00000002} '31 - Hair Long',\n {0x00000004} '32 - FaceGen Head',\n {0x00000008} '33 - BODY',\n {0x00000010} '34 - L Hand',\n {0x00000020} '35 - R Hand',\n {0x00000040} '36 - [U] Torso',\n {0x00000080} '37 - [U] L Arm',\n {0x00000100} '38 - [U] R Arm',\n {0x00000200} '39 - [U] L Leg',\n {0x00000400} '40 - [U] R Leg',\n {0x00000800} '41 - [A] Torso',\n {0x00001000} '42 - [A] L Arm',\n {0x00002000} '43 - [A] R Arm',\n {0x00004000} '44 - [A] L Leg',\n {0x00008000} '45 - [A] R Leg',\n {0x00010000} '46 - Headband',\n {0x00020000} '47 - Eyes',\n {0x00040000} '48 - Beard',\n {0x00080000} '49 - Mouth',\n {0x00100000} '50 - Neck',\n {0x00200000} '51 - Ring',\n {0x00400000} '52 - Scalp',\n {0x00800000} '53 - Decapitation',\n {0x01000000} '54 - Unnamed',\n {0x02000000} '55 - Unnamed',\n {0x04000000} '56 - Unnamed',\n {0x08000000} '57 - Unnamed',\n {0x10000000} '58 - Unnamed',\n {0x20000000} '59 - Shield',\n {0x40000000} '60 - Pipboy',\n {0x80000000} '61 - FX'\n ], True);\n\n wbFirstPersonFlagsU32 := wbInteger('First Person Flags', itU32, wbBipedObjectFlags);\n\n wbBOD2 := wbStruct(BOD2, 'Biped Body Template', [\n wbFirstPersonFlagsU32\n ], cpNormal, False);\n\n wbMDOB := wbFormID(MDOB, 'Menu Display Object', cpNormal, False);\n wbCNAM := wbStruct(CNAM, 'Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unknown', 1)\n ]);\n\n wbDODT := wbStruct(DODT, 'Decal Data', [\n wbFloat('Min Width'),\n wbFloat('Max Width'),\n wbFloat('Min Height'),\n wbFloat('Max Height'),\n wbFloat('Depth'),\n wbFloat('Shininess'),\n wbStruct('Parallax', [\n wbFloat('Scale'),\n wbInteger('Passes', itU8) {>>> This can't be higher than 30 <<<}\n ]),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'POM Shadows',\n {0x02} 'Alpha - Blending',\n {0x04} 'Alpha - Testing',\n {0x08} 'No Subtextures'\n ], True)),\n wbInteger('Alpha Threshold?', itU16),\n wbByteColors('Color')\n ]);\n\n// wbRecordFlagsFlags := wbFlags([\n// {>>> 0x00000000 ACTI: Collision Geometry (default) <<<}\n// {0x00000001}'ESM',\n// {0x00000002}'Unknown 2',\n// {>>> 0x00000004 ARMO: Not playable <<<}\n// {0x00000004}'NotPlayable',\n// {0x00000008}'Unknown 4',\n// {0x00000010}'Unknown 5',\n// {0x00000020}'Deleted',\n// {>>> 0x00000040 ACTI: Has Tree LOD <<<}\n// {>>> 0x00000040 REGN: Border Region <<<}\n// {>>> 0x00000040 STAT: Has Tree LOD <<<}\n// {>>> 0x00000040 REFR: Hidden From Local Map <<<}\n// {0x00000040}'Constant HiddenFromLocalMap BorderRegion HasTreeLOD',\n// {>>> 0x00000080 TES4: Localized <<<}\n// {>>> 0x00000080 PHZD: Turn Off Fire <<<}\n// {>>> 0x00000080 SHOU: Treat Spells as Powers <<<}\n// {>>> 0x00000080 STAT: Add-on LOD Object <<<}\n// {0x00000080}'Localized IsPerch AddOnLODObject TurnOffFire TreatSpellsAsPowers',\n// {>>> 0x00000100 ACTI: Must Update Anims <<<}\n// {>>> 0x00000100 REFR: Inaccessible <<<}\n// {>>> 0x00000100 REFR for LIGH: Doesn't light water <<<}\n// {0x00000100}'MustUpdateAnims Inaccessible DoesntLightWater',\n// {>>> 0x00000200 ACTI: Local Map - Turns Flag Off, therefore it is Hidden <<<}\n// {>>> 0x00000200 REFR: MotionBlurCastsShadows <<<}\n// {0x00000200}'HiddenFromLocalMap StartsDead MotionBlurCastsShadows',\n// {>>> 0x00000400 LSCR: Displays in Main Menu <<<}\n// {0x00000400}'PersistentReference QuestItem DisplaysInMainMenu',\n// {0x00000800}'InitiallyDisabled',\n// {0x00001000}'Ignored',\n// {0x00002000}'ActorChanged',\n// {0x00004000}'Unknown 15',\n// {>>> 0x00008000 STAT: Has Distant LOD <<<}\n// {0x00008000}'VWD',\n// {>>> 0x00010000 ACTI: Random Animation Start <<<}\n// {>>> 0x00010000 REFR light: Never fades <<<}\n// {0x00010000}'RandomAnimationStart NeverFades',\n// {>>> 0x00020000 ACTI: Dangerous <<<}\n// {>>> 0x00020000 REFR light: Doesn't light landscape <<<}\n// {>>> 0x00020000 SLGM: Can hold NPC's soul <<<}\n// {>>> 0x00020000 STAT: Use High-Detail LOD Texture <<<}\n// {0x00020000}'Dangerous OffLimits DoesntLightLandscape HighDetailLOD CanHoldNPC',\n// {0x00040000}'Compressed',\n// {>>> 0x00080000 STAT: Has Currents <<<}\n// {0x00080000}'CantWait HasCurrents',\n// {>>> 0x00100000 ACTI: Ignore Object Interaction <<<}\n// {0x00100000}'IgnoreObjectInteraction',\n// {0x00200000}'(Used in Memory Changed Form)',\n// {0x00400000}'Unknown 23',\n// {>>> 0x00800000 ACTI: Is Marker <<<}\n// {0x00800000}'IsMarker',\n// {0x01000000}'Unknown 25',\n// {>>> 0x02000000 ACTI: Obstacle <<<}\n// {>>> 0x02000000 REFR: No AI Acquire <<<}\n// {0x02000000}'Obstacle NoAIAcquire',\n// {>>> 0x04000000 ACTI: Filter <<<}\n// {0x04000000}'NavMeshFilter',\n// {>>> 0x08000000 ACTI: Bounding Box <<<}\n// {0x08000000}'NavMeshBoundingBox',\n// {>>> 0x10000000 STAT: Show in World Map <<<}\n// {0x10000000}'MustExitToTalk ShowInWorldMap',\n// {>>> 0x20000000 ACTI: Child Can Use <<<}\n// {>>> 0x20000000 REFR: Don't Havok Settle <<<}\n// {0x20000000}'ChildCanUse DontHavokSettle',\n// {>>> 0x40000000 ACTI: GROUND <<<}\n// {>>> 0x40000000 REFR: NoRespawn <<<}\n// {0x40000000}'NavMeshGround NoRespawn',\n// {>>> 0x80000000 REFR: MultiBound <<<}\n// {0x80000000}'MultiBound'\n// ], [18]);\n\n wbRecordFlagsFlags := wbFlags(wbRecordFlagsFlags, [\n {0x00000001} { 0} 'Unknown 0',\n {0x00000002} { 1} 'Unknown 1',\n {0x00000004} { 2} 'Unknown 2',\n {0x00000008} { 3} 'Unknown 3',\n {0x00000010} { 4} 'Unknown 4',\n {0x00000020} { 4} 'Unknown 5',\n {0x00000040} { 6} 'Unknown 6',\n {0x00000080} { 7} 'Unknown 7',\n {0x00000100} { 8} 'Unknown 8',\n {0x00000200} { 9} 'Unknown 9',\n {0x00000400} {10} 'Unknown 10',\n {0x00000800} {11} 'Unknown 11',\n {0x00001000} {12} 'Unknown 12',\n {0x00002000} {13} 'Unknown 13',\n {0x00004000} {14} 'Unknown 14',\n {0x00008000} {15} 'Unknown 15',\n {0x00010000} {16} 'Unknown 16',\n {0x00020000} {17} 'Unknown 17',\n {0x00040000} {18} 'Unknown 18',\n {0x00080000} {19} 'Unknown 19',\n {0x00100000} {20} 'Unknown 20',\n {0x00200000} {21} 'Unknown 21',\n {0x00400000} {22} 'Unknown 22',\n {0x00800000} {23} 'Unknown 23',\n {0x01000000} {24} 'Unknown 24',\n {0x02000000} {25} 'Unknown 25',\n {0x04000000} {26} 'Unknown 26',\n {0x08000000} {27} 'Unknown 27',\n {0x10000000} {28} 'Unknown 28',\n {0x20000000} {29} 'Unknown 29',\n {0x40000000} {30} 'Unknown 30',\n {0x80000000} {31} 'Unknown 31'\n ]);\n\n wbRecordFlags := wbInteger('Record Flags', itU32, wbFlags(wbRecordFlagsFlags, wbFlagsList([])));\n\n wbMainRecordHeader := wbStruct('Record Header', [\n wbString('Signature', 4, cpCritical),\n wbInteger('Data Size', itU32, nil, cpIgnore),\n wbRecordFlags,\n wbFormID('FormID', cpFormID),\n wbByteArray('Version Control Info 1', 4, cpIgnore),\n wbInteger('Form Version', itU16, nil, cpIgnore),\n wbByteArray('Version Control Info 2', 2, cpIgnore)\n ]);\n\n wbSizeOfMainRecordStruct := 24;\n\n wbIgnoreRecords.Add(XXXX);\n\n wbXRGD := wbByteArray(XRGD, 'Ragdoll Data');\n wbXRGB := wbByteArray(XRGB, 'Ragdoll Biped Data');\n\n wbMusicEnum := wbEnum(['Default', 'Public', 'Dungeon']);\n wbSoundLevelEnum := wbEnum([\n 'Loud',\n 'Normal',\n 'Silent',\n 'Very Loud',\n 'Quiet'\n ]);\n\n wbEntryPointsEnum := wbEnum([\n { 0} 'Mod Breath Timer',\n { 1} 'Mod My Critical Hit Chance',\n { 2} 'Mod My Critical Hit Damage Mult',\n { 3} 'Mod Mine Explode Chance',\n { 4} 'Mod Incoming Limb Damage',\n { 5} 'Mod Book Actor Value Bonus',\n { 6} 'Mod Recovered Health',\n { 7} 'Set Should Attack',\n { 8} 'Mod Buy Prices',\n { 9} 'Add Leveled List On Death',\n {10} 'Set Max Carry Weight',\n {11} 'Mod Addiction Chance',\n {12} 'Mod Addiction Duration',\n {13} 'Mod Positive Chem Duration',\n {14} 'Activate',\n {15} 'Ignore Running During Detection',\n {16} 'Ignore Broken Lock',\n {17} 'Mod Enemy Critical Hit Chance',\n {18} 'Mod Sneak Attack Mult',\n {19} 'Mod Max Placeable Mines',\n {20} 'Mod Bow Zoom',\n {21} 'Mod Recover Arrow Chance',\n {22} 'Mod Exp',\n {23} 'Mod Telekinesis Distance',\n {24} 'Mod Telekinesis Damage Mult',\n {25} 'Mod Telekinesis Damage',\n {26} 'Mod Bashing Damage',\n {27} 'Mod Power Attack Action Points',\n {28} 'Mod Power Attack Damage',\n {29} 'Mod Spell Magnitude',\n {30} 'Mod Spell Duration',\n {31} 'Mod Secondary Value Weight',\n {32} 'Mod Armor Weight',\n {33} 'Mod Incoming Stagger',\n {34} 'Mod Target Stagger',\n {35} 'Mod Weapon Attack Damage',\n {36} 'Mod Incoming Weapon Damage',\n {37} 'Mod Target Damage Resistance',\n {38} 'Mod Spell Cost',\n {39} 'Mod Percent Blocked',\n {40} 'Mod Shield Deflect Arrow Chance',\n {41} 'Mod Incoming Spell Magnitude',\n {42} 'Mod Incoming Spell Duration',\n {43} 'Mod Player Intimidation',\n {44} 'Mod Ricochet Chance',\n {45} 'Mod Ricochet Damage',\n {46} 'Mod Bribe Amount',\n {47} 'Mod Detection Light',\n {48} 'Mod Detection Movement',\n {49} 'Mod Scrap Reward Mult',\n {50} 'Set Sweep Attack',\n {51} 'Apply Combat Hit Spell',\n {52} 'Apply Bashing Spell',\n {53} 'Apply Reanimate Spell',\n {54} 'Set Boolean Graph Variable',\n {55} 'Mod Spell Casting Sound Event',\n {56} 'Mod Pickpocket Chance',\n {57} 'Mod Detection Sneak Skill',\n {58} 'Mod Falling Damage',\n {59} 'Mod Lockpick Sweet Spot',\n {60} 'Mod Sell Prices',\n {61} 'Set Pickpocket Equipped Item',\n {62} 'Set Player Gate Lockpick',\n {63} 'Set Lockpick Starting Arc',\n {64} 'Set Progression Picking',\n {65} 'Set Lockpicks Unbreakable',\n {66} 'Mod Alchemy Effectiveness',\n {67} 'Apply Weapon Swing Spell',\n {68} 'Mod Commanded Actor Limit',\n {69} 'Apply Sneaking Spell',\n {70} 'Mod Player Magic Slowdown',\n {71} 'Mod Ward Magicka Absorption Pct',\n {72} 'Mod Initial Ingredient Effects Learned',\n {73} 'Purify Alchemy Ingredients',\n {74} 'Set Filter Activation',\n {75} 'Set Dual Cast',\n {76} 'Mod Outgoing Explosion Limb Damage',\n {77} 'Mod Enchantment Power',\n {78} 'Mod Soul Pct Captured to Weapon',\n {79} 'Mod VATS Attack Action Points',\n {80} 'Mod Reflect Damage Chance',\n {81} 'Set Activate Label',\n {82} 'Mod Kill Experience',\n {83} 'Mod Poison Dose Count',\n {84} 'Set Apply Placed Item',\n {85} 'Mod Armor Rating',\n {86} 'Mod lockpicking crime chance',\n {87} 'Mod ingredients harvested',\n {88} 'Mod Spell Range (Target Loc.)',\n {89} 'Mod Critical Charge Mult on Ricochet',\n {90} 'Mod lockpicking key reward chance',\n {91} 'Mod Auto Lockpicking Chance',\n {92} 'Mod Auto Hacking Chance',\n {93} 'Mod Typed Weapon Attack Damage',\n {94} 'Mod Typed Incoming Weapon Damage',\n {95} 'Mod Charisma Challenge Chance',\n {96} 'Mod Sprint AP Drain Rate',\n {97} 'Mod Drawn Weapon Weight Speed Effect',\n {98} 'Set Player Gate Hacking',\n {99} 'Mod Player Explosion Damage',\n {100} 'Mod Player Explosion Scale',\n {101} 'Set Rads To Health Mult',\n {102} 'Mod Actor Scope Stability',\n {103} 'Mod Actor Grenade Speed Mult',\n {104} 'Mod Explosion Force',\n {105} 'Mod VATS Penetration Min Visibility',\n {106} 'Mod Rads for Rad Health Max',\n {107} 'Mod VATS Player AP On Kill Chance',\n {108} 'Set VATS Fill Critical Bar On Hit',\n {109} 'Mod VATS Concentrated Fire Chance Bonus',\n {110} 'Mod VATS Critical Count',\n {111} 'Mod VATS Hold Em Steady Bonus',\n {112} 'Mod Typed Spell Magnitude',\n {113} 'Mod Typed Incoming Spell Magnitude',\n {114} 'Set VATS Gun-Fu Num Targets For Crits',\n {115} 'Mod Outgoing Limb Damage',\n {116} 'Mod Restore Action Cost Value',\n {117} 'Mod VATS Reload Action Points',\n {118} 'Mod Incoming Battery Damage',\n {119} 'Mod VATS Critical Charge',\n {120} 'Mod Exp Location',\n {121} 'Mod Exp Speech',\n {122} 'Mod VATS Head Shot Chance',\n {123} 'Mod VATS Hit Chance',\n {124} 'Mod Incoming Explosion Damage',\n {125} 'Mod Ammo Health Mult',\n {126} 'Mod Hacking Guesses',\n {127} 'Mod Terminal Lockout Time',\n {128} 'Set Undetectable',\n {129} 'Invest In Vendor',\n {130} 'Mod Outgoing Limb Bash Damage',\n {131} 'Set Run While Over Encumbered',\n {132} 'Get Component Radar Distance',\n {133} 'Show Grenade Trajectory',\n {134} 'Mod Cone-of-fire Mult',\n {135} 'Mod VATS Concentrated Fire Damage Mult',\n {136} 'Apply Bloody Mess Spell',\n {137} 'Mod VATS Critical Fill Chance On Bank',\n {138} 'Mod VATS Critical Fill Chance On Use',\n {139} 'Set VATS Critical Fill On AP Reward',\n {140} 'Set VATS Critical Fill On Stranger',\n {141} 'Mod Gun Range Mult',\n {142} 'Mod Scope Hold Breath AP Drain Mult',\n {143} 'Set Force Decapitate',\n {144} 'Mod VATS Shoot Explosive Damage Mult',\n {145} 'Mod Scrounger Fill Ammo Chance',\n {146} 'Set Can Explode Pants',\n {147} 'Set VATS Penetration Full Damage',\n {148} 'Mod VATS Gun-Fu 2nd Target Dmg Mult',\n {149} 'Mod VATS Gun-Fu 3rd Target Dmg Mult',\n {150} 'Mod VATS Gun-Fu 4th+ Target Dmg Mult',\n {151} 'Mod VATS Blitz Max Distance',\n {152} 'Set VATS Blitz Max Dmg Mult',\n {153} 'Mod VATS Blitz Dmg Bonus Dist',\n {154} 'Mod Bash Critical Chance',\n {155} 'VATS Apply Paralyzing Palm Spell',\n {156} 'Null Function'\n ]);\n\n wbEquipType := wbFlags([\n {0x00000001} 'Hand To Hand Melee',\n {0x00000002} 'One Hand Sword',\n {0x00000004} 'One Hand Dagger',\n {0x00000008} 'One Hand Axe',\n {0x00000010} 'One Hand Mace',\n {0x00000020} 'Two Hand Sword',\n {0x00000040} 'Two Hand Axe',\n {0x00000080} 'Bow',\n {0x00000100} 'Staff',\n {0x00000200} 'Gun',\n {0x00000400} 'Grenade',\n {0x00000800} 'Mine',\n {0x00001000} 'Spell',\n {0x00002000} 'Shield',\n {0x00004000} 'Torch'\n ], True);\n\n wbEmotionTypeEnum := wbEnum([\n {0} 'Neutral',\n {1} 'Anger',\n {2} 'Disgust',\n {3} 'Fear',\n {4} 'Sad',\n {5} 'Happy',\n {6} 'Surprise',\n {7} 'Puzzled'\n ]);\n\n wbFurnitureAnimTypeEnum := wbEnum([\n {0} '',\n {1} 'Sit',\n {2} 'Lay',\n {3} '',\n {4} 'Lean'\n ]);\n\n wbFurnitureEntryTypeFlags := wbFlags([\n {0x01} 'Front',\n {0x02} 'Behind',\n {0x04} 'Right',\n {0x08} 'Left',\n {0x10} 'Up'\n ]);\n\n wbWardStateEnum := wbEnum([\n 'None',\n 'Absorb',\n 'Break'\n ]);\n\n wbEventFunctionEnum := wbEnum([\n 'GetIsID',\n 'IsInList',\n 'GetValue',\n 'HasKeyword',\n 'GetItemValue'\n ]);\n\n // Event member names and availability are different depending on event type\n // Using generic names for the last 3 of them: Form, Value1, Value2\n wbEventMemberEnum := wbEnum([], [\n $0000, 'None',\n $314F, 'CreatedObject',\n $314C, '(Old)Location',\n $324C, '(New)Location',\n $314B, 'Keyword',\n $3146, 'Form',\n $3156, 'Value1',\n $3256, 'Value2'\n ]);\n\n wbWeaponAnimTypeEnum := wbEnum([\n {0} 'HandToHandMelee',\n {1} 'OneHandSword',\n {2} 'OneHandDagger',\n {3} 'OneHandAxe',\n {4} 'OneHandMace',\n {5} 'TwoHandSword',\n {6} 'TwoHandAxe',\n {7} 'Bow',\n {8} 'Staff',\n {9} 'Crossbow'\n ]);\n\n wbReverbClassEnum := wbEnum([\n 'Default',\n 'Class A',\n 'Class B',\n 'Class C',\n 'Class D',\n 'Class E'\n ]);\n\n wbHitBehaviourEnum := wbEnum([\n 'Normal formula behaviour',\n 'Dismember only',\n 'Explode only',\n 'No dismember/explode'\n ]);\n\n wbEDID := wbString(EDID, 'Editor ID', 0, cpNormal); // not cpBenign according to Arthmoor\n wbFULL := wbLStringKC(FULL, 'Name', 0, cpTranslate);\n wbFULLActor := wbLStringKC(FULL, 'Name', 0, cpTranslate, False, nil{wbActorTemplateUseBaseData});\n wbFULLReq := wbLStringKC(FULL, 'Name', 0, cpTranslate, True);\n wbDESC := wbLStringKC(DESC, 'Description', 0, cpTranslate);\n wbDESCReq := wbLStringKC(DESC, 'Description', 0, cpTranslate, True);\n wbXSCL := wbFloat(XSCL, 'Scale');\n\n wbOBND := wbStruct(OBND, 'Object Bounds', [\n wbInteger('X1', itS16),\n wbInteger('Y1', itS16),\n wbInteger('Z1', itS16),\n wbInteger('X2', itS16),\n wbInteger('Y2', itS16),\n wbInteger('Z2', itS16)\n ]);\n\n wbOBNDReq := wbStruct(OBND, 'Object Bounds', [\n wbInteger('X1', itS16),\n wbInteger('Y1', itS16),\n wbInteger('Z1', itS16),\n wbInteger('X2', itS16),\n wbInteger('Y2', itS16),\n wbInteger('Z2', itS16)\n ], cpNormal, True);\n\n wbPropTypeEnum := wbEnum([\n {00} 'None',\n {01} 'Object',\n {02} 'String',\n {03} 'Int32',\n {04} 'Float',\n {05} 'Bool',\n {06} 'Variable',\n {07} 'Struct',\n {08} '',\n {09} '',\n {10} '',\n {11} 'Array of Object',\n {12} 'Array of String',\n {13} 'Array of Int32',\n {14} 'Array of Float',\n {15} 'Array of Bool',\n {16} 'Array of Variable',\n {17} 'Array of Struct'\n ]);\n\n wbScriptFlags := wbInteger('Flags', itU8, wbEnum([\n {0x00} 'Local',\n {0x01} 'Inherited',\n {0x02} 'Removed',\n {0x03} 'Inherited and Removed'\n ]));\n\n wbScriptPropertyObject := wbUnion('Object Union', wbScriptObjFormatDecider, [\n wbStructSK([1], 'Object v2', [\n wbInteger('Unused', itU16, nil, cpIgnore),\n wbInteger('Alias', itS16, wbScriptObjectAliasToStr, wbStrToAlias),\n wbFormID('FormID')\n ], [2, 1, 0]),\n wbStructSK([1], 'Object v1', [\n wbFormID('FormID'),\n wbInteger('Alias', itS16, wbScriptObjectAliasToStr, wbStrToAlias),\n wbInteger('Unused', itU16, nil, cpIgnore)\n ])\n ]);\n\n wbScriptPropertyStruct :=\n wbArrayS('Struct', wbStructSK([0], 'Member', [\n wbLenString('memberName', 2),\n wbInteger('Type', itU8, wbPropTypeEnum, cpNormal, False, nil, wbScriptPropertyTypeAfterSet),\n wbInteger('Flags', itU8, wbEnum([\n {0x00} '',\n {0x01} 'Edited',\n {0x02} '',\n {0x03} 'Removed'\n ])),\n wbUnion('Value', wbScriptPropertyStructMemberDecider, [\n {00} wbNull,\n {01} wbScriptPropertyObject,\n {02} wbLenString('String', 2),\n {03} wbInteger('Int32', itS32),\n {04} wbFloat('Float'),\n {05} wbInteger('Bool', itU8, wbBoolEnum),\n {11} wbArray('Array of Object', wbScriptPropertyObject, -1),\n {12} wbArray('Array of String', wbLenString('Element', 2), -1),\n {13} wbArray('Array of Int32', wbInteger('Element', itS32), -1),\n {14} wbArray('Array of Float', wbFloat('Element'), -1),\n {15} wbArray('Array of Bool', wbInteger('Element', itU8, wbBoolEnum), -1)\n ])\n ]), -1, cpNormal, False);\n\n wbScriptProperties :=\n wbArrayS('Properties', wbStructSK([0], 'Property', [\n wbLenString('propertyName', 2),\n wbInteger('Type', itU8, wbPropTypeEnum, cpNormal, False, nil, wbScriptPropertyTypeAfterSet),\n wbInteger('Flags', itU8, wbEnum([\n {0x00} '',\n {0x01} 'Edited',\n {0x02} '',\n {0x03} 'Removed'\n ])),\n wbUnion('Value', wbScriptPropertyDecider, [\n {00} wbNull,\n {01} wbScriptPropertyObject,\n {02} wbLenString('String', 2),\n {03} wbInteger('Int32', itS32),\n {04} wbFloat('Float'),\n {05} wbInteger('Bool', itU8, wbBoolEnum),\n {06} wbScriptPropertyStruct, // Variable. No idea if possible or how to decode, leaving like that for the moment\n {07} wbScriptPropertyStruct,\n {11} wbArray('Array of Object', wbScriptPropertyObject, -1),\n {12} wbArray('Array of String', wbLenString('Element', 2), -1),\n {13} wbArray('Array of Int32', wbInteger('Element', itS32), -1),\n {14} wbArray('Array of Float', wbFloat('Element'), -1),\n {15} wbArray('Array of Bool', wbInteger('Element', itU8, wbBoolEnum), -1),\n {17} wbArray('Array of Struct', wbScriptPropertyStruct, -1)\n ])\n ]), -2, cpNormal, False, nil, nil, nil, False);\n\n wbScriptEntry := wbStructSK([0], 'Script', [\n wbLenString('scriptName', 2),\n wbScriptFlags,\n wbScriptProperties\n ]);\n\n wbScriptFragmentsInfo := wbStruct('Script Fragments', [\n wbInteger('Unknown', itS8),\n wbInteger('Flags', itU8, wbFlags([\n {1} 'OnBegin',\n {2} 'OnEnd'\n ])),\n wbScriptEntry,\n wbArray('Fragments', // Do NOT sort, ordered OnBegin, OnEnd\n wbStruct('Fragment', [\n wbInteger('Unknown', itS8),\n wbLenString('scriptName', 2),\n wbLenString('fragmentName', 2)\n ]), [], wbScriptFragmentsInfoCounter)\n ]);\n\n wbScriptFragmentsPack := wbStruct('Script Fragments', [\n wbInteger('Unknown', itS8),\n wbInteger('Flags', itU8, wbFlags([\n {1} 'OnBegin',\n {2} 'OnEnd',\n {4} 'OnChange'\n ])),\n wbScriptEntry,\n wbArray('Fragments', // Do NOT sort, ordered OnBegin, OnEnd, OnChange\n wbStruct('Fragment', [\n wbInteger('Unknown', itS8),\n wbLenString('scriptName', 2),\n wbLenString('fragmentName', 2)\n ]), [], wbScriptFragmentsPackCounter)\n ]);\n\n wbScriptFragmentsQuest := wbStruct('Script Fragments', [\n wbInteger('Unknown', itS8),\n wbInteger('fragmentCount', itU16),\n wbLenString('scriptName', 2),\n // if scriptName = \"\" then no Flags and Properties\n wbUnion('Script', wbScriptFragmentsEmptyScriptDecider, [\n wbStruct('Script Data', [\n wbScriptFlags,\n wbScriptProperties\n ]),\n// Quest [000179EF] \n// Quest [000792CA] \"Merchant Dialogue System\"\n// Quest [00091FE1] \n// MQ101KelloggSequence \"Kellogg Sequence in Vault 111\" [QUST:000D3997]\n// DialogueGlowingSeaAtom \"Children of the Atom Dialogue\" [QUST:0012DB31]\n// BoSIdleHandlerQuest [QUST:00157460]\n wbNull\n ]),\n wbArrayS('Fragments',\n wbStructSK([0, 2], 'Fragment', [\n wbInteger('Quest Stage', itU16),\n wbInteger('Unknown', itS16),\n wbInteger('Quest Stage Index', itS32),\n wbInteger('Unknown', itS8),\n wbLenString('scriptName', 2),\n wbLenString('fragmentName', 2)\n ]),\n wbScriptFragmentsQuestCounter)\n ]);\n\n wbScriptFragmentsScen := wbStruct('Script Fragments', [\n wbInteger('Unknown', itS8),\n wbInteger('Flags', itU8, wbFlags([\n {1} 'OnBegin',\n {2} 'OnEnd'\n ])),\n wbScriptEntry,\n wbArray('Fragments', // Do NOT sort, ordered OnBegin, OnEnd\n wbStruct('Fragment', [\n wbInteger('Unknown', itS8),\n wbLenString('scriptName', 2),\n wbLenString('fragmentName', 2)\n ]), [], wbScriptFragmentsSceneCounter),\n wbArray('Phase Fragments',\n wbStructSK([0, 1], 'Phase Fragment', [\n wbInteger('Phase Flag', itU8, wbFlags([\n {1} 'OnStart',\n {2} 'OnCompletion'\n ])),\n wbInteger('Phase Index', itU8),\n wbInteger('Unknown', itS16),\n wbInteger('Unknown', itS8),\n wbInteger('Unknown', itS8),\n wbLenString('scriptName', 2),\n wbLenString('fragmentName', 2)\n ]), -2)\n ]);\n\n wbScriptFragments := wbStruct('Script Fragments', [\n wbInteger('Unknown', itS8),\n wbScriptEntry,\n wbArrayS('Fragments',\n wbStructSK([0], 'Fragment', [\n wbInteger('Fragment Index', itU16),\n wbInteger('Unknown', itS16),\n wbInteger('Unknown', itS8),\n wbLenString('scriptName', 2),\n wbLenString('fragmentName', 2)\n ]), -2)\n ]);\n\n {>>> http://www.uesp.net/wiki/Tes5Mod:Mod_File_Format/VMAD_Field <<<}\n\n wbVMAD := wbStruct(VMAD, 'Virtual Machine Adapter', [\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Scripts', wbScriptEntry, -2, cpNormal, False, nil, nil, nil, False)\n ]);\n\n wbVMADFragmentedPERK := wbStruct(VMAD, 'Virtual Machine Adapter', [\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Scripts', wbScriptEntry, -2, cpNormal, False, nil, nil, nil, False),\n wbScriptFragments\n ], cpNormal, False, nil, 3);\n\n wbVMADFragmentedPACK := wbStruct(VMAD, 'Virtual Machine Adapter', [\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Scripts', wbScriptEntry, -2, cpNormal, False, nil, nil, nil, False),\n wbScriptFragmentsPack\n ], cpNormal, False, nil, 3);\n\n wbVMADFragmentedQUST := wbStruct(VMAD, 'Virtual Machine Adapter', [\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Scripts', wbScriptEntry, -2, cpNormal, False, nil, nil, nil, False),\n wbScriptFragmentsQuest,\n wbArrayS('Aliases', wbStructSK([0], 'Alias', [\n wbScriptPropertyObject,\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Alias Scripts', wbScriptEntry, -2)\n ]), -2)\n ], cpNormal, False, nil, 3);\n\n wbVMADFragmentedSCEN := wbStruct(VMAD, 'Virtual Machine Adapter', [\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Scripts', wbScriptEntry, -2, cpNormal, False, nil, nil, nil, False),\n wbScriptFragmentsScen\n ], cpNormal, False, nil, 3);\n\n wbVMADFragmentedINFO := wbStruct(VMAD, 'Virtual Machine Adapter', [\n wbInteger('Version', itS16, nil, cpIgnore),\n wbInteger('Object Format', itS16, nil, cpIgnore),\n wbArrayS('Scripts', wbScriptEntry, -2, cpNormal, False, nil, nil, nil, False),\n wbScriptFragmentsInfo\n ], cpNormal, False, nil, 3);\n\n wbAttackData := wbRStructSK([1], 'Attack', [\n wbStruct(ATKD, 'Attack Data', [\n wbFloat('Damage Mult'),\n wbFloat('Attack Chance'),\n wbFormIDCk('Attack Spell', [SPEL, NULL]),\n wbInteger('Attack Flags', itU32, wbFlags([\n {0x00000001} 'Ignore Weapon',\n {0x00000002} 'Bash Attack',\n {0x00000004} 'Power Attack',\n {0x00000008} 'Charge Attack',\n {0x00000010} 'Rotating Attack',\n {0x00000020} 'Continuous Attack',\n {0x00000040} 'Unknown 6',\n {0x00000080} 'Unknown 7',\n {0x00000100} 'Unknown 8',\n {0x00000200} 'Unknown 9',\n {0x00000400} 'Unknown 10',\n {0x00000800} 'Unknown 11',\n {0x00001000} 'Unknown 12',\n {0x00002000} 'Unknown 13',\n {0x00004000} 'Unknown 14',\n {0x00008000} 'Unknown 15',\n {0x00010000} 'Unknown 16',\n {0x00020000} 'Unknown 17',\n {0x00040000} 'Unknown 18',\n {0x00080000} 'Unknown 19',\n {0x00100000} 'Unknown 20',\n {0x00200000} 'Unknown 21',\n {0x00400000} 'Unknown 22',\n {0x00800000} 'Unknown 23',\n {0x01000000} 'Unknown 24',\n {0x02000000} 'Unknown 25',\n {0x04000000} 'Unknown 26',\n {0x08000000} 'Unknown 27',\n {0x10000000} 'Unknown 28',\n {0x20000000} 'Unknown 29',\n {0x40000000} 'Unknown 30',\n {0x80000000} 'Override Data'\n ])),\n wbFloat('Attack Angle'),\n wbFloat('Strike Angle'),\n wbFloat('Stagger'),\n wbFloat('Knockdown'),\n wbFloat('Recovery Time'),\n wbFloat('Action Points Mult'),\n wbInteger('Stagger Offset', itS32)\n ]),\n wbString(ATKE, 'Attack Event'),\n wbFormIDCk(ATKW, 'Weapon Slot', [EQUP]),\n wbFormIDCk(ATKS, 'Required Slot', [EQUP]),\n wbString(ATKT, 'Description')\n ], []);\n\n wbLocationEnum := wbEnum([\n {0} 'Near reference', // string dump: '%s' in '%s' radius %u\n {1} 'In cell', // string dump: In cell '%s'\n {2} 'Near package start location', // string dump: Near package start location, radius %u\n {3} 'Near editor location', // string dump: Near editor location, radius %u\n {4} 'Object ID',\n {5} 'Object Type',\n {6} 'Near linked reference', // string dump: Near linked reference, radius %u%s%s\n {7} 'At package location', // string dump: At package location, radius %u\n {8} 'Alias (reference)', // string dump: Alias: %s [item #%u], radius %u\n {9} 'Alias (location)', // string dump: Alias: %s, radius %u\n {10} 'Target', // string dump: \n {11} 'Target (location)', // string dump: Target: %s, radius %u\n {12} 'Near self', // Near Self, radius %u\n {13} 'Near Editor Location Cell',\n {14} 'Alias (ref collection)'\n ]);\n\n wbObjectTypeEnum := wbEnum([\n { 0} ' NONE',\n { 1} 'Activators',\n { 2} 'Armor',\n { 3} 'Books',\n { 4} 'Containers',\n { 5} 'Doors',\n { 6} 'Ingredients',\n { 7} 'Lights',\n { 8} 'Miscellaneous',\n { 9} 'Flora',\n {10} 'Furniture',\n {11} 'Weapons: Any',\n {12} 'Ammo',\n {13} 'Keys',\n {14} 'Alchemy',\n {15} 'Food',\n {16} 'Clothing',\n {17} 'All: Wearable',\n {18} 'Weapons: NONE',\n {19} 'Weapons: Melee',\n {20} 'Weapons: Ranged',\n {21} 'Spells: Any',\n {22} 'Spells: Range Target',\n {23} 'Spells: Range Touch',\n {24} 'Spells: Range Self',\n {25} 'Actors: Any',\n {26} 'Furniture: Beds',\n {27} 'Furniture: Chairs',\n {28} 'Shouts',\n {29} 'Headtrack Markers'\n ]);\n\n wbPLDT := wbStruct(PLDT, 'Location', [\n wbInteger('Type', itS32, wbLocationEnum),\n wbUnion('Location Value', wbTypeDecider, [\n {0} wbFormIDCkNoReach('Reference', sigReferences),\n {1} wbFormIDCkNoReach('Cell', [NULL, CELL]),\n {2} wbByteArray('Near Package Start Location', 4, cpIgnore),\n {3} wbByteArray('Near Editor Location', 4, cpIgnore),\n {4} wbFormIDCkNoReach('Object ID', [NULL, ACTI, DOOR, STAT, MSTT, FURN, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, OMOD, BOOK, NOTE, KEYM, ALCH, INGR, LIGH, FACT, FLST, IDLM, TXST, PROJ]),\n {5} wbInteger('Object Type', itU32, wbObjectTypeEnum),\n {6} wbFormIDCk('Keyword', [NULL, KYWD]),\n {7} wbByteArray('Unused', 4, cpIgnore),\n {8} wbInteger('Ref Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias),\n {9} wbInteger('Loc Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias),\n {10} wbInteger('Interrupt Data', itU32),\n {11} wbInteger('Packdata Target', itU32),\n {12} wbByteArray('Unknown', 4, cpIgnore),\n {13} wbByteArray('Unknown', 4),\n {14} wbInteger('Ref Collection Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias)\n ]),\n wbInteger('Radius', itS32),\n wbInteger('Collection Index', itU32)\n ], cpNormal, False, nil, 3);\n\n wbPLVD := wbStruct(PLVD, 'Location', [\n wbInteger('Type', itS32, wbLocationEnum),\n wbUnion('Location Value', wbTypeDecider, [\n {0} wbFormIDCkNoReach('Reference', sigReferences),\n {1} wbFormIDCkNoReach('Cell', [NULL, CELL]),\n {2} wbByteArray('Near Package Start Location', 4, cpIgnore),\n {3} wbByteArray('Near Editor Location', 4, cpIgnore),\n {4} wbFormIDCkNoReach('Object ID', [NULL, ACTI, DOOR, STAT, MSTT, FURN, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, OMOD, BOOK, NOTE, KEYM, ALCH, INGR, LIGH, FACT, FLST, IDLM, TXST, PROJ]),\n {5} wbInteger('Object Type', itU32, wbObjectTypeEnum),\n {6} wbFormIDCk('Keyword', [NULL, KYWD]),\n {7} wbByteArray('Unused', 4, cpIgnore),\n {8} wbInteger('Ref Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias),\n {9} wbInteger('Loc Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias),\n {10} wbInteger('Interrupt Data', itU32),\n {11} wbInteger('Packdata Target', itU32),\n {12} wbByteArray('Unknown', 4, cpIgnore),\n {13} wbByteArray('Unknown', 4),\n {14} wbInteger('Ref Collection Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias)\n ]),\n wbInteger('Radius', itS32),\n wbInteger('Collection Index', itU32)\n ], cpNormal, False, nil, 3);\n\n wbTargetData := wbStruct('Target Data', [\n wbInteger('Type', itS32, wbEnum([\n {0} 'Specific Reference',\n {1} 'Object ID',\n {2} 'Object Type',\n {3} 'Linked Reference',\n {4} 'Ref Alias',\n {5} 'Interrupt Data',\n {6} 'Self',\n {7} 'Keyword',\n {8} 'Unknown 8'\n ]), cpNormal, False, nil, nil, 2),\n wbUnion('Target', wbTypeDecider, [\n {0} wbFormIDCkNoReach('Reference', sigReferences, True),\n {1} wbFormIDCkNoReach('Object ID', [NULL, ACTI, DOOR, STAT, MSTT, FURN, SPEL, NPC_, CONT, ARMO, AMMO, MISC, WEAP, OMOD, BOOK, NOTE, KEYM, ALCH, INGR, LIGH, FACT, FLST, IDLM, TXST, PROJ]),\n {2} wbInteger('Object Type', itU32, wbObjectTypeEnum),\n {3} wbFormIDCk('Keyword', [KYWD, NULL]),\n {4} wbInteger('Alias', itS32, wbPackageLocationAliasToStr, wbStrToAlias),\n {5} wbInteger('Interrupt Data', itU32),\n {6} wbByteArray('Unknown', 4, cpIgnore),\n {7} wbFormIDCk('Keyword', [KYWD, NULL]),\n {8} wbByteArray('Unknown', 4, cpIgnore)\n ]),\n wbInteger('Count / Distance', itS32)\n ]);\n\n wbEITM := wbFormIDCk(EITM, 'Object Effect', [ENCH, SPEL]);\n\n wbPosRot :=\n wbStruct('Position/Rotation', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ]);\n\n wbDATAPosRot :=\n wbStruct(DATA, 'Position/Rotation', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ])\n ], cpNormal, True);\n\n wbMODS := wbFormIDCk(MODS, 'Material Swap', [MSWP]);\n wbMO2S := wbFormIDCk(MO2S, 'Material Swap', [MSWP]);\n wbMO3S := wbFormIDCk(MO3S, 'Material Swap', [MSWP]);\n wbMO4S := wbFormIDCk(MO4S, 'Material Swap', [MSWP]);\n wbMO5S := wbFormIDCk(MO5S, 'Material Swap', [MSWP]);\n\n wbMODF := wbUnknown(MODF);\n wbMO2F := wbUnknown(MO2F);\n wbMO3F := wbUnknown(MO3F);\n wbMO4F := wbUnknown(MO4F);\n wbMO5F := wbUnknown(MO5F);\n\n wbMODC := wbFloat(MODC, 'Color Remapping Index');\n wbMO2C := wbFloat(MO2C, 'Color Remapping Index');\n wbMO3C := wbFloat(MO3C, 'Color Remapping Index');\n wbMO4C := wbFloat(MO4C, 'Color Remapping Index');\n wbMO5C := wbFloat(MO5C, 'Color Remapping Index');\n\n\twbMODT := wbByteArray(MODT, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow);\n\twbDMDT := wbByteArray(DMDT, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow);\n {wbMODT := wbStruct(MODT, 'Texture Files Hashes', [\n wbInteger('Number of headers', itU32),\n wbInteger('Textures count', itU32),\n wbByteArray('Unused', 4),\n wbInteger('Unique textures count', itU32),\n wbInteger('Materials count', itU32),\n wbArray('Hashes', wbStruct('Hash', [\n wbByteArray('Flags', 4),\n wbString('Type', 4),\n wbByteArray('Texture hash', 4)\n ]))\n ]);}\n\n wbMODL :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbMODT,\n wbMODS,\n wbMODC,\n wbMODF\n ], [], cpNormal, False, nil, True);\n\n wbMODLActor :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbMODT,\n wbMODS\n ], [], cpNormal, False, nil{wbActorTemplateUseModelAnimation}, True);\n\n wbMODLReq :=\n wbRStructSK([0], 'Model', [\n wbString(MODL, 'Model Filename', 0, cpNormal, True),\n wbMODT,\n wbMODS,\n wbMODC,\n wbMODF\n ], [], cpNormal, True, nil, True);\n\n wbDMDS := wbFormIDCk(DMDS, 'Material Swap', [MSWP]);\n wbDMDC := wbFloat(DMDC, 'Color Remapping Index');\n\n wbDEST := wbRStruct('Destructible', [\n wbStruct(DEST, 'Header', [\n wbInteger('Health', itS32),\n wbInteger('DEST Count', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'VATS Targetable',\n 'Large Actor Destroys'\n ])),\n wbByteArray('Unknown', 2)\n ]),\n wbArrayS(DAMC, 'Resistances', wbStructSK([0], 'Resistance', [\n wbFormIDCk('Damage Type', [DMGT]),\n wbInteger('Value', itU32)\n ])),\n wbRArray('Stages',\n wbRStruct('Stage', [\n wbStruct(DSTD, 'Destruction Stage Data', [\n wbInteger('Health %', itU8),\n wbInteger('Index', itU8),\n wbInteger('Model Damage Stage', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Cap Damage',\n 'Disable',\n 'Destroy',\n 'Ignore External Dmg',\n 'Becomes Dynamic'\n ])),\n wbInteger('Self Damage per Second', itS32),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Debris', [DEBR, NULL]),\n wbInteger('Debris Count', itS32)\n ], cpNormal, True),\n wbString(DSTA, 'Sequence Name'),\n wbRStructSK([0], 'Model', [\n wbString(DMDL, 'Model Filename', 0, cpNormal, True),\n wbDMDT,\n wbDMDC,\n wbDMDS\n ], [], cpNormal, False, nil, True),\n wbEmpty(DSTF, 'End Marker', cpNormal, True)\n ], [], cpNormal, False, nil)\n )\n ], [], cpNormal, False, nil);\n\n wbDESTActor := wbRStruct('Destructible', [\n wbStruct(DEST, 'Header', [\n wbInteger('Health', itS32),\n wbInteger('Count', itU8),\n wbInteger('VATS Targetable', itU8, wbBoolEnum),\n wbByteArray('Unknown', 2)\n ]),\n wbRArray('Stages', // Begin Stage Array\n wbRStruct('Stage', [ // Begin Stage RStruct\n wbStruct(DSTD, 'Destruction Stage Data', [ // Begin DSTD\n wbInteger('Health %', itU8),\n wbInteger('Index', itU8),\n wbInteger('Damage Stage', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Cap Damage',\n 'Disable',\n 'Destroy'\n ])),\n wbInteger('Self Damage per Second', itS32),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Debris', [DEBR, NULL]),\n wbInteger('Debris Count', itS32)\n ], cpNormal, True), // End DSTD\n wbRStructSK([0], 'Model', [ // Begin DMDL\n wbString(DMDL, 'Model Filename')\n ], []), // End DMDL\n wbDMDT,\n wbDMDC,\n wbDMDS,\n wbEmpty(DSTF, 'End Marker', cpNormal, True)\n ], []) // Begin Stage RStruct\n ) // End Stage Array\n ], [], cpNormal, False, nil{wbActorTemplateUseModelAnimation});\n\n wbXLOD := wbArray(XLOD, 'Distant LOD Data', wbFloat('Unknown'), 3);\n\n wbXESP := wbStruct(XESP, 'Enable Parent', [\n wbFormIDCk('Reference', sigReferences),\n wbInteger('Flags', itU8, wbFlags([\n 'Set Enable State to Opposite of Parent',\n 'Pop In'\n ])),\n wbByteArray('Unused', 3, cpIgnore)\n ]);\n\n wbPDTO :=\n wbStruct(PDTO, 'Topic Data', [\n wbInteger('Type', itU32, wbEnum([\n 'Topic Ref',\n 'Topic Subtype'\n ])),\n wbUnion('Data', wbTypeDecider, [\n wbFormIDCk('Topic', [DIAL, NULL]),\n wbString('Subtype', 4)\n ])\n ]);\n\n wbPDTOs := wbRArray('Topic', wbPDTO, cpNormal, False, nil);\n\n wbXLCM := wbInteger(XLCM, 'Level Modifier', itS32, wbEnum([\n 'Easy',\n 'Medium',\n 'Hard',\n 'Very Hard'\n ]));\n\n if wbSimpleRecords then begin\n wbMaxHeightDataCELL := wbByteArray(MHDT, 'Max Height Data', 0, cpNormal);\n wbMaxHeightDataWRLD := wbByteArray(MHDT, 'Max Height Data', 0, cpNormal);\n end\n else begin\n wbMaxHeightDataCELL := wbStruct(MHDT, 'Max Height Data', [\n wbFloat('Offset'),\n wbArray('Rows',\n wbByteArray('Columns', 32)\n // way too verbose for no practical use\n //wbStruct('Row', [ wbArray('Columns', wbInteger('Column', itU8), 32) ])\n , 32)\n ]);\n wbMaxHeightDataWRLD := wbStruct(MHDT, 'Max Height Data', [\n wbStruct('Min', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbStruct('Max', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbByteArray('Cell Data', 0)\n // way too verbose for no practical use\n {wbArray('Cell Data', wbStruct('Quad Height', [\n wbInteger('Bottom Left', itU8),\n wbInteger('Bottom Right', itU8),\n wbInteger('Top Left', itU8),\n wbInteger('Top Right', itU8)\n ]))}\n ]);\n end;\n\n if wbSimpleRecords then\n wbOFST := wbByteArray(OFST, 'Offset Data')\n else\n wbOFST := wbArray(OFST, 'Offset Data', wbArray('Rows', wbInteger('Offset', itU32), wbOffsetDataColsCounter), 0);\n\n wbXOWN := wbStruct(XOWN, 'Owner', [\n wbFormIDCkNoReach('Owner', [FACT, ACHR, NPC_]),\n wbByteArray('Unknown', 4),\n wbInteger('Flags', itU8, wbFlags(['No Crime'])),\n wbByteArray('Unknown', 3)\n ]);\n wbXRNK := wbInteger(XRNK, 'Owner Faction Rank', itS32);\n\n if wbSimpleRecords then\n wbNVNM := wbStruct(NVNM, 'Navmesh Geometry', [\n wbInteger('Version', itU32),\n wbByteArray('Magic', 4),\n wbFormIDCk('Parent Worldspace', [WRLD, NULL]),\n wbUnion('Parent', wbNVNMParentDecider, [\n wbStruct('Coordinates', [\n wbInteger('Grid Y', itS16),\n wbInteger('Grid X', itS16)\n ]),\n wbFormIDCk('Parent Cell', [CELL])\n ]),\n wbByteArray('Vertices and Triangles')\n ])\n else\n wbNVNM := wbStruct(NVNM, 'Navmesh Geometry', [\n wbInteger('Version', itU32), // Changes how the struct is loaded, should be 15 in FO4\n wbStruct('Pathing Cell', [\n wbInteger('Magic', itU32), // This looks like a magic number (always $A5E9A03C), loaded with the parents\n wbFormIDCk('Parent Worldspace', [WRLD, NULL]),\n wbUnion('Parent', wbNVNMParentDecider, [ // same as TES5 cell if worldspace is null or Grid X Y\n wbStruct('Coordinates', [\n wbInteger('Grid Y', itS16),\n wbInteger('Grid X', itS16)\n ]),\n wbFormIDCk('Parent Cell', [CELL])\n ])\n ]),\n wbArray('Vertices', wbStruct('Vertex', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]), -1),\n wbArray('Triangles',\n wbStruct('Triangle', [\n wbInteger('Vertex 0', itS16),\n wbInteger('Vertex 1', itS16),\n wbInteger('Vertex 2', itS16),\n wbInteger('Edge 0-1', itS16),\n wbInteger('Edge 1-2', itS16),\n wbInteger('Edge 2-0', itS16),\n wbFloat('Height'), // this and next if form ver > 57\n wbInteger('Unknown', itU8, wbFlags([])), // flags\n wbInteger('Unknown', itU32) // encoding or flags\n ])\n , -1),\n wbArray('Edge Links',\n wbStruct('Edge Link', [\n wbInteger('Unknown', itU32),\n wbFormIDCk('Mesh', [NAVM]), // those last three are a structure\n wbInteger('Triangle', itS16),\n wbInteger('Unknown', itU8) // if form ver > 127\n ])\n , -1),\n wbArray('Door Triangles',\n wbStruct('Door Triangle', [\n wbInteger('Triangle before door', itU16), // I would say itU16\n wbInteger('DTUnknown', itU32), // used as a key to lookup in a map of PathingDoor\n wbUnion('Door', wbDoorTriangleDoorTriangleDecider, [wbNull, wbFormIDCk('Door', [REFR])])\n ])\n , -1),\n wbArray('Unknown 5', // if navmesh version gt 12\n wbStruct('Unknown', [\n wbInteger('Unknown', itU16),\n wbInteger('Unknown', itU16),\n wbInteger('Unknown', itU32 {, wbFlags([]) ? })\n ])\n , -1),\n wbArray('Unknown 6',\n wbStruct('Uknown', [\n wbInteger('Unknown', itU16),\n wbInteger('Unknown', itU16)\n ])\n , -1),\n wbArray('Unknown 7', // if navmesh version gt 11\n wbStruct('Unknown', [\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbInteger('Unknown', itU16),\n wbInteger('Unknown', itU32)\n ])\n , -1),\n wbStruct('Navmesh Grid', [\n wbInteger('Navmesh Grid Size', itU32), // max 12\n wbFloat('Max X Distance'),\n wbFloat('Max Y Distance'),\n wbFloat('Min X'),\n wbFloat('Min Y'),\n wbFloat('Min Z'),\n wbFloat('Max X'),\n wbFloat('Max Y'),\n wbFloat('Max Z'),\n wbArray('NavMesh Grid Arrays', wbArray('NavMeshGridCell', wbInteger('Triangle', itS16), -1)) // There are NavMeshGridSize^2 arrays to load\n ])\n ]);\n\nend;\n\nprocedure DefineFO4b;\nbegin\n\n wbRecord(ACHR, 'Placed NPC',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000200} 9, 'Starts Dead',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x02000000} 25, 'No AI Acquire',\n {0x20000000} 29, 'Don''t Havok Settle'\n ], True, True)), [\n wbEDID,\n wbVMAD,\n wbFormIDCk(NAME, 'Base', [NPC_], False, cpNormal, True),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n {--- Ragdoll ---}\n wbXRGD,\n wbXRGB,\n\n {--- Patrol Data ---}\n wbRStruct('Patrol Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbPDTOs,\n wbFormIDCk(TNAM, 'Topic', [DIAL, NULL], False, cpNormal)\n ], []),\n\n {--- Leveled Actor ----}\n wbXLCM,\n\n {--- Extra ---}\n wbInteger(XCNT, 'Count', itS32),\n wbFloat(XRDS, 'Radius'),\n wbInteger(XHLT, 'Health %', itU32),\n\n wbRArrayS('Linked References', wbStructSK(XLKR, [0], 'Linked Reference', [\n wbFormIDCk('Keyword/Ref', [KYWD, PLYR, ACHR, REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA, NULL]),\n wbFormIDCk('Ref', sigReferences)\n ], cpNormal, False, nil, 1)),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', sigReferences),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbEmpty(XLKT, 'Linked Ref Transient'),\n wbFormIDCk(XRFG, 'Reference Group', [RFGP]),\n wbFormIDCk(XLYR, 'Layer', [LAYR]),\n wbFormIDCk(XMSP, 'Material Swap', [MSWP]),\n\n wbFormIDCk(XLCN, 'Persistent Location', [LCTN]),\n wbFormIDCk(XLRL, 'Location Reference', [LCRT, LCTN, NULL], False, cpBenignIfAdded),\n wbArray(XLRT, 'Location Ref Type', wbFormIDCk('Ref', [LCRT, NULL])),\n\n wbEmpty(XIS2, 'Ignored by Sandbox'),\n wbRArray('Spline Connection', wbStruct(XPLK, 'Link', [\n wbFormIDCk('Ref', [REFR, ACHR]),\n wbUnknown // always 00 00 00 00 so far in DLCWorkshop03.esm\n ])),\n wbFloat(XHTW, 'Head-Tracking Weight'),\n wbFloat(XFVC, 'Favor Cost'),\n\n {--- Enable Parent ---}\n wbXESP,\n\n {--- Ownership ---}\n wbXOWN,\n wbXRNK,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', sigReferences),\n\n {--- Flags ---}\n wbEmpty(XIBS, 'Ignored By Sandbox'),\n\n {--- 3D Data ---}\n wbXSCL,\n wbDATAPosRot,\n wbString(MNAM, 'Comments')\n ], True, wbPlacedAddInfo);\n\n wbVatsValueFunctionEnum :=\n wbEnum([\n { 0} 'Weapon Is',\n { 1} 'Weapon In List',\n { 2} 'Target Is',\n { 3} 'Target In List',\n { 4} 'Target Distance',\n { 5} 'Target Part',\n { 6} 'VATS Action',\n { 7} 'Is Success',\n { 8} 'Is Critical',\n { 9} 'Critical Effect Is',\n {10} 'Critical Effect In List',\n {11} 'Is Fatal',\n {12} 'Explode Part',\n {13} 'Dismember Part',\n {14} 'Cripple Part',\n {15} 'Weapon Type Is',\n {16} 'Is Stranger',\n {17} 'Is Paralyzing Palm',\n {18} 'Projectile Type Is',\n {19} 'Delivery Type Is',\n {20} 'Casting Type Is'\n ]);\n\n wbActorValueEnum :=\n wbEnum([\n {00} 'Aggression',\n {01} 'Confidence',\n {02} 'Energy',\n {03} 'Morality',\n {04} 'Mood',\n {05} 'Assistance',\n {06} 'One-Handed',\n {07} 'Two-Handed',\n {08} 'Archery',\n {09} 'Block',\n {10} 'Smithing',\n {11} 'Heavy Armor',\n {12} 'Light Armor',\n {13} 'Pickpocket',\n {14} 'Lockpicking',\n {15} 'Sneak',\n {16} 'Alchemy',\n {17} 'Speech',\n {18} 'Alteration',\n {19} 'Conjuration',\n {20} 'Destruction',\n {21} 'Illusion',\n {22} 'Restoration',\n {23} 'Enchanting',\n {24} 'Health',\n {25} 'Magicka',\n {26} 'Stamina',\n {27} 'Heal Rate',\n {28} 'Magicka Rate',\n {29} 'Stamina Rate',\n {30} 'Speed Mult',\n {31} 'Inventory Weight',\n {32} 'Carry Weight',\n {33} 'Critical Chance',\n {34} 'Melee Damage',\n {35} 'Unarmed Damage',\n {36} 'Mass',\n {37} 'Voice Points',\n {38} 'Voice Rate',\n {39} 'Damage Resist',\n {40} 'Poison Resist',\n {41} 'Resist Fire',\n {42} 'Resist Shock',\n {43} 'Resist Frost',\n {44} 'Resist Magic',\n {45} 'Resist Disease',\n {46} 'Unknown 46',\n {47} 'Unknown 47',\n {48} 'Unknown 48',\n {49} 'Unknown 49',\n {50} 'Unknown 50',\n {51} 'Unknown 51',\n {52} 'Unknown 52',\n {53} 'Paralysis',\n {54} 'Invisibility',\n {55} 'Night Eye',\n {56} 'Detect Life Range',\n {57} 'Water Breathing',\n {58} 'Water Walking',\n {59} 'Unknown 59',\n {60} 'Fame',\n {61} 'Infamy',\n {62} 'Jumping Bonus',\n {63} 'Ward Power',\n {64} 'Right Item Charge',\n {65} 'Armor Perks',\n {66} 'Shield Perks',\n {67} 'Ward Deflection',\n {68} 'Variable01',\n {69} 'Variable02',\n {70} 'Variable03',\n {71} 'Variable04',\n {72} 'Variable05',\n {73} 'Variable06',\n {74} 'Variable07',\n {75} 'Variable08',\n {76} 'Variable09',\n {77} 'Variable10',\n {78} 'Bow Speed Bonus',\n {79} 'Favor Active',\n {80} 'Favors Per Day',\n {81} 'Favors Per Day Timer',\n {82} 'Left Item Charge',\n {83} 'Absorb Chance',\n {84} 'Blindness',\n {85} 'Weapon Speed Mult',\n {86} 'Shout Recovery Mult',\n {87} 'Bow Stagger Bonus',\n {88} 'Telekinesis',\n {89} 'Favor Points Bonus',\n {90} 'Last Bribed Intimidated',\n {91} 'Last Flattered',\n {92} 'Movement Noise Mult',\n {93} 'Bypass Vendor Stolen Check',\n {94} 'Bypass Vendor Keyword Check',\n {95} 'Waiting For Player',\n {96} 'One-Handed Modifier',\n {97} 'Two-Handed Modifier',\n {98} 'Marksman Modifier',\n {99} 'Block Modifier',\n {100} 'Smithing Modifier',\n {101} 'Heavy Armor Modifier',\n {102} 'Light Armor Modifier',\n {103} 'Pickpocket Modifier',\n {104} 'Lockpicking Modifier',\n {105} 'Sneaking Modifier',\n {106} 'Alchemy Modifier',\n {107} 'Speechcraft Modifier',\n {108} 'Alteration Modifier',\n {109} 'Conjuration Modifier',\n {110} 'Destruction Modifier',\n {111} 'Illusion Modifier',\n {112} 'Restoration Modifier',\n {113} 'Enchanting Modifier',\n {114} 'One-Handed Skill Advance',\n {115} 'Two-Handed Skill Advance',\n {116} 'Marksman Skill Advance',\n {117} 'Block Skill Advance',\n {118} 'Smithing Skill Advance',\n {119} 'Heavy Armor Skill Advance',\n {120} 'Light Armor Skill Advance',\n {121} 'Pickpocket Skill Advance',\n {122} 'Lockpicking Skill Advance',\n {123} 'Sneaking Skill Advance',\n {124} 'Alchemy Skill Advance',\n {125} 'Speechcraft Skill Advance',\n {126} 'Alteration Skill Advance',\n {127} 'Conjuration Skill Advance',\n {128} 'Destruction Skill Advance',\n {129} 'Illusion Skill Advance',\n {130} 'Restoration Skill Advance',\n {131} 'Enchanting Skill Advance',\n {132} 'Left Weapon Speed Multiply',\n {133} 'Dragon Souls',\n {134} 'Combat Health Regen Multiply',\n {135} 'One-Handed Power Modifier',\n {136} 'Two-Handed Power Modifier',\n {137} 'Marksman Power Modifier',\n {138} 'Block Power Modifier',\n {139} 'Smithing Power Modifier',\n {140} 'Heavy Armor Power Modifier',\n {141} 'Light Armor Power Modifier',\n {142} 'Pickpocket Power Modifier',\n {143} 'Lockpicking Power Modifier',\n {144} 'Sneaking Power Modifier',\n {145} 'Alchemy Power Modifier',\n {146} 'Speechcraft Power Modifier',\n {147} 'Alteration Power Modifier',\n {148} 'Conjuration Power Modifier',\n {149} 'Destruction Power Modifier',\n {150} 'Illusion Power Modifier',\n {151} 'Restoration Power Modifier',\n {152} 'Enchanting Power Modifier',\n {153} 'Dragon Rend',\n {154} 'Attack Damage Mult',\n {155} 'Heal Rate Mult',\n {156} 'Magicka Rate Mult',\n {157} 'Stamina Rate Mult',\n {158} 'Werewolf Perks',\n {159} 'Vampire Perks',\n {160} 'Grab Actor Offset',\n {161} 'Grabbed',\n {162} 'Unknown 162',\n {163} 'Reflect Damage'\n ], [\n -1, 'None'\n ]);\n\n wbSkillEnum :=\n wbEnum([\n 'Unknown 1',\n 'Unknown 2',\n 'Unknown 3',\n 'Unknown 4',\n 'Unknown 5',\n 'Unknown 6',\n 'One Handed',\n 'Two Handed',\n 'Archery',\n 'Block',\n 'Smithing',\n 'Heavy Armor',\n 'Light Armor',\n 'Pickpocket',\n 'Lockpicking',\n 'Sneak',\n 'Alchemy',\n 'Speech',\n 'Alteration',\n 'Conjuration',\n 'Destruction',\n 'Illusion',\n 'Restoration',\n 'Enchanting'\n ], [\n -1, 'None'\n ]);\n\n wbCastEnum := wbEnum([\n {0} 'Constant Effect',\n {1} 'Fire and Forget',\n {2} 'Concentration',\n {3} 'Scroll'\n ]);\n\n wbTargetEnum := wbEnum([\n {0} 'Self',\n {1} 'Touch',\n {2} 'Aimed',\n {3} 'Target Actor',\n {4} 'Target Location'\n ]);\n\n wbCastingSourceEnum := wbEnum([\n 'Left',\n 'Right',\n 'Voice',\n 'Instant'\n ]);\n\n wbCrimeTypeEnum :=\n wbEnum([\n 'Steal',\n 'Pickpocket',\n 'Trespass',\n 'Attack',\n 'Murder',\n 'Escape Jail',\n 'Werewolf Transformation'\n ], [\n -1, 'None'\n ]);\n\n wbKeywordTypeEnum :=\n wbEnum([\n {00} 'None',\n {01} 'Component Tech Level',\n {02} 'Attach Point',\n {03} 'Component Property',\n {04} 'Instantiation Filter',\n {05} 'Mod Association',\n {06} 'Sound',\n {07} 'Anim Archetype',\n {08} 'Function Call',\n {09} 'Recipe Filter',\n {10} 'Attraction Type',\n {11} 'Dialogue Subtype',\n {12} 'Quest Target',\n {13} 'Anim Flavor',\n {14} 'Anim Gender',\n {15} 'Anim Face',\n {16} 'Quest Group',\n {17} 'Anim Injured',\n {18} 'Dispel Effect'\n ]);\n\n wbETYP := wbFormIDCk(ETYP, 'Equipment Type', [EQUP, NULL]);\n wbETYPReq := wbFormIDCk(ETYP, 'Equipment Type', [EQUP, NULL], False, cpNormal, True);\n\n wbFormTypeEnum := wbEnum([], [\n 0, 'Activator',\n 1, 'Armor',\n 2, 'Book',\n 3, 'Container',\n 4, 'Door',\n 5, 'Ingredient',\n 6, 'Light',\n 7, 'MiscItem',\n 8, 'Static',\n 9, 'Grass',\n 10, 'Tree',\n 12, 'Weapon',\n 13, 'Actor',\n 14, 'LeveledCharacter',\n 15, 'Spell',\n 16, 'Enchantment',\n 17, 'Potion',\n 18, 'LeveledItem',\n 19, 'Key',\n 20, 'Ammo',\n 21, 'Flora',\n 22, 'Furniture',\n 23, 'Sound Marker',\n 24, 'LandTexture',\n 25, 'CombatStyle',\n 26, 'LoadScreen',\n 27, 'LeveledSpell',\n 28, 'AnimObject',\n 29, 'WaterType',\n 30, 'IdleMarker',\n 31, 'EffectShader',\n 32, 'Projectile',\n 33, 'TalkingActivator',\n 34, 'Explosion',\n 35, 'TextureSet',\n 36, 'Debris',\n 37, 'MenuIcon',\n 38, 'FormList',\n 39, 'Perk',\n 40, 'BodyPartData',\n 41, 'AddOnNode',\n 42, 'MovableStatic',\n 43, 'CameraShot',\n 44, 'ImpactData',\n 45, 'ImpactDataSet',\n 46, 'Quest',\n 47, 'Package',\n 48, 'VoiceType',\n 49, 'Class',\n 50, 'Race',\n 51, 'Eyes',\n 52, 'HeadPart',\n 53, 'Faction',\n 54, 'Note',\n 55, 'Weather',\n 56, 'Climate',\n 57, 'ArmorAddon',\n 58, 'Global',\n 59, 'Imagespace',\n 60, 'Imagespace Modifier',\n 61, 'Encounter Zone',\n 62, 'Message',\n 63, 'Constructible Object',\n 64, 'Acoustic Space',\n 65, 'Ragdoll',\n 66, 'Script',\n 67, 'Magic Effect',\n 68, 'Music Type',\n 69, 'Static Collection',\n 70, 'Keyword',\n 71, 'Location',\n 72, 'Location Ref Type',\n 73, 'Footstep',\n 74, 'Footstep Set',\n 75, 'Material Type',\n 76, 'Actor Action',\n 77, 'Music Track',\n 78, 'Word of Power',\n 79, 'Shout',\n 80, 'Relationship',\n 81, 'Equip Slot',\n 82, 'Association Type',\n 83, 'Outfit',\n 84, 'Art Object',\n 85, 'Material Object',\n 87, 'Lighting Template',\n 88, 'Shader Particle Geometry',\n 89, 'Visual Effect',\n 90, 'Apparatus',\n 91, 'Movement Type',\n 92, 'Hazard',\n 93, 'SM Event Node',\n 94, 'Sound Descriptor',\n 95, 'Dual Cast Data',\n 96, 'Sound Category',\n 97, 'Soul Gem',\n 98, 'Sound Output Model',\n 99, 'Collision Layer',\n 100, 'Scroll',\n 101, 'ColorForm',\n 102, 'Reverb Parameters',\n 116, 'Terminal'\n ]);\n\n wbMiscStatEnum := wbEnum([], [\n Int64($1EE71DBC), 'Animals Friended',\n Int64($FCDD5011), 'Animals Killed',\n Int64($366D84CF), 'Armor Improved',\n Int64($8E20D7C9), 'Assaults',\n Int64($B9B50725), 'Backstabs',\n Int64($EA01A954), 'Bobbleheads Collected',\n Int64($6932624D), 'Bright Ideas',\n Int64($7FF0CC3B), 'Brotherhood of Steel Quests Completed',\n Int64($FEA920AA), 'Buildings',\n Int64($1F84743B), 'Caps Found',\n Int64($9360004C), 'Chems Crafted',\n Int64($B2A78B7A), 'Chems Taken',\n Int64($53D9E9B5), 'Chests Looted',\n Int64($1E258BEE), 'Computers Hacked',\n Int64($3DE99B41), 'Cores Ejected',\n Int64($737EAA97), 'Corpses Eaten',\n Int64($40B11EFE), 'Creatures Killed',\n Int64($4C4B8DF3), 'Creatures Killed DLC03',\n Int64($22D5BA38), 'Critical Strikes',\n Int64($3C626A90), 'Days Passed',\n Int64($C5A52FD0), 'Days Survived',\n Int64($45FDBB1C), 'DLC01 Quests Completed',\n Int64($FA7CC7F9), 'DLC03 Locations Discovered',\n Int64($AA444695), 'Dungeons Cleared',\n Int64($F4E8FFD6), 'Fatman Deaths',\n Int64($66DAF3CF), 'Fits of Rage',\n Int64($554E59D5), 'Food',\n Int64($E1EB3490), 'Food Cooked',\n Int64($9311B22B), 'Food Eaten',\n Int64($F947D866), 'Four Leaf Clovers',\n Int64($7C586E7A), 'Fusion Cores Consumed',\n Int64($2826309E), 'Game Difficulty',\n Int64($A5EA7ABC), 'Grand Slams',\n Int64($F5A36770), 'Grim Reaper Sprints',\n Int64($52984AA4), 'Happiness',\n Int64($FA024018), 'Hours Slept',\n Int64($CAD2ECA1), 'Hours Waiting',\n Int64($8CC5DAB6), 'HSAtomicCommand',\n Int64($A2E4C1F2), 'HSAutomatron',\n Int64($20F9993D), 'HSGrognak',\n Int64($8D882844), 'HSJangles',\n Int64($910B02C0), 'HSPipfall',\n Int64($860E0723), 'HSRedMenace',\n Int64($3FFA8658), 'HSZetaInvaders',\n Int64($40CA9C83), 'Institute Quests Completed',\n Int64($7D2E57C0), 'Intimidations',\n Int64($FFE8010B), 'Investments Made',\n Int64($9AF17D9D), 'Items Crafted DLC03',\n Int64($CF48C0B9), 'Items Scrapped',\n Int64($82F190C2), 'Items Stolen',\n Int64($6D8671DD), 'Junk Collected',\n Int64($110B8D2F), 'Legendary Enemies Killed',\n Int64($8A24FDE2), 'Locations Discovered',\n Int64($5829CC2E), 'Locks Picked',\n Int64($7EA26C2D), 'Main Quests Completed',\n Int64($493B803C), 'Mines Disarmed',\n Int64($B1511B82), 'Minuteman Quests Completed',\n Int64($98EE55DC), 'Misc Objectives Completed',\n Int64($0F3315AC), 'Money Shots',\n Int64($5E457DAC), 'Most Caps Carried',\n Int64($D37C6909), 'Murders',\n Int64($B91253A4), 'Mysterious Strabger Visits',\n Int64($1DEEA18A), 'Nuka Cola Flavors Created',\n Int64($9CE72536), 'Nuka World Creatures Killed',\n Int64($EB0D60AC), 'Objects Built',\n Int64($73AD915B), 'Pants Exploded',\n Int64($53706A04), 'Paralyzing Punches',\n Int64($9E78CEB3), 'People',\n Int64($F22A8133), 'People Killed',\n Int64($D3F632FF), 'Plants Harvested',\n Int64($856FA4C1), 'PlayedFutureRetroHolotape',\n Int64($F2BAC234), 'Pockets Picked',\n Int64($AC69D9B9), 'Power',\n Int64($0D7B8B16), 'Quests Completed',\n Int64($0580BB9F), 'RadAway Taken',\n Int64($D2960073), 'Rad-X Taken',\n Int64($FDE20426), 'Railroad Quests Completed',\n Int64($3CBF7E59), 'Ricochets',\n Int64($01E1BC85), 'Robots Disabled',\n Int64($2CA4ECC0), 'Robots Improved',\n Int64($C8BC93BE), 'Robots Killed',\n Int64($98D5710C), 'Sandman Kills',\n Int64($B1AE4792), 'Side Quests Completed',\n Int64($ACE470D7), 'Skill Books Read',\n Int64($B556CC52), 'Sneak Attacks',\n Int64($32D1B38F), 'Speach Successes',\n Int64($5D6B18F1), 'Stimpacks Taken',\n Int64($C5321BC5), 'Supply Lines Created',\n Int64($3869002E), 'Survival Denied',\n Int64($F9DEC209), 'Survival Level-Ups',\n Int64($69AF5B9A), 'Synths Killed',\n Int64($0A872FA3), 'Times Addicted',\n Int64($7AEA9C2B), 'Trespasses',\n Int64($13752285), 'Turrets Killed',\n Int64($0B479511), 'Wasteland Whispers',\n Int64($FCD0CCC3), 'Water',\n Int64($61A5C5A9), 'Weapons Disarmed',\n Int64($1D3BA844), 'Weapons Improved',\n Int64($60A11697), 'Workshops Unlocked'\n ]);\n\n wbAdvanceActionEnum := wbEnum([\n 'Normal Usage',\n 'Power Attack',\n 'Bash',\n 'Lockpick Success',\n 'Lockpick Broken'\n ]);\n\n wbAlignmentEnum :=\n wbEnum([\n 'Good',\n 'Neutral',\n 'Evil',\n 'Very Good',\n 'Very Evil'\n ]);\n\n wbAxisEnum :=\n wbEnum([], [\n 88, 'X',\n 89, 'Y',\n 90, 'Z'\n ]);\n\n wbCriticalStageEnum :=\n wbEnum([\n 'None',\n 'Goo Start',\n 'Goo End',\n 'Disintegrate Start',\n 'Disintegrate End'\n ]);\n\n wbStaggerEnum := wbEnum([\n 'None',\n 'Small',\n 'Medium',\n 'Large',\n 'Extra Large'\n ]);\n\n wbSexEnum := wbEnum(['Male','Female']);\n\n wbEFID := wbFormIDCk(EFID, 'Base Effect', [MGEF]);\n\n wbEFIT :=\n wbStructSK(EFIT, [3, 4], '', [\n wbFloat('Magnitude', cpNormal, True),\n wbInteger('Area', itU32),\n wbInteger('Duration', itU32)\n ], cpNormal, True, nil, -1, wbEFITAfterLoad);\n\n wbCTDA := wbRStruct('Condition', [\n wbStruct(CTDA, '', [\n wbInteger('Type', itU8, wbCtdaTypeToStr, wbCtdaTypeToInt, cpNormal, False, nil, wbCtdaTypeAfterSet),\n wbByteArray('Unused', 3, cpIgnore, False, wbNeverShow),\n wbUnion('Comparison Value', wbCTDACompValueDecider, [\n wbFloat('Comparison Value - Float'),\n wbFormIDCk('Comparison Value - Global', [GLOB])\n ]),\n wbInteger('Function', itU16, wbCTDAFunctionToStr, wbCTDAFunctionToInt),\n wbByteArray('Unused', 2, cpIgnore, False, wbNeverShow),\n wbUnion('Parameter #1', wbCTDAParam1Decider, [\n { unknown }\n wbByteArray('Unknown', 4),\n { 0 ptNone}\n wbByteArray('None', 4, cpIgnore),\n { 1 ptInteger}\n wbInteger('Integer', itS32),\n { 2 ptFloat}\n wbFloat('Float'),\n { 3 ptActor}\n wbFormIDCkNoReach('Actor', [NULL, PLYR, ACHR, REFR]),\n { 4 ptActorBase}\n wbFormIDCkNoReach('Actor Base', [NPC_]),\n { 5 ptActorValue}\n wbActorValue,\n { 6 ptAdvanceAction}\n wbInteger('Player Action', itU32, wbAdvanceActionEnum),\n { 7 ptAlias}\n wbInteger('Alias', itS32, wbConditionAliasToStr, wbStrToAlias),\n { 8 ptAlignment}\n wbInteger('Alignment', itU32, wbAlignmentEnum),\n { 9 ptAssociationType}\n wbFormIDCk('Association Type', [ASTP]),\n {10 ptAxis}\n wbInteger('Axis', itU32, wbAxisEnum),\n {11 ptCastingSource}\n wbInteger('Casting Type', itU32, wbCastingSourceEnum),\n {12 ptCell}\n wbFormIDCkNoReach('Cell', [CELL]),\n {13 ptClass}\n wbFormIDCkNoReach('Class', [CLAS]),\n {14 ptCrimeType}\n wbInteger('Crime Type', itU32, wbCrimeTypeEnum),\n {15 ptCriticalStage}\n wbInteger('Critical Stage', itU32, wbCriticalStageEnum),\n {16 ptEncounterZone}\n wbFormIDCkNoReach('Encounter Zone', [ECZN]),\n {17 ptEquipType}\n wbFormIDCkNoReach('Equip Type', [EQUP]),\n {18 ptEvent}\n wbInteger('Event', itU32, wbEventFunctionAndMemberToStr, wbEventFunctionAndMemberToInt),\n {19 ptEventData}\n wbFormID('Event Data'),\n {20 ptFaction}\n wbFormIDCkNoReach('Faction', [FACT]),\n {21 ptFormList}\n wbFormIDCkNoReach('Form List', [FLST]),\n {22 ptFormType}\n wbInteger('Form Type', itU32, wbFormTypeEnum),\n {23 ptFurniture}\n wbFormIDCkNoReach('Furniture', [FURN, FLST]),\n {24 ptFurnitureAnim}\n wbInteger('Furniture Anim', itU32, wbFurnitureAnimTypeEnum),\n {25 ptFurnitureEntry}\n wbInteger('Furniture Entry', itU32, wbEnum([], [$010000, 'Front', $020000, 'Behind', $040000, 'Right', $80000, 'Left', $100000, 'Up'])),\n {26 ptGlobal}\n wbFormIDCkNoReach('Global', [GLOB]),\n {27 ptIdleForm}\n wbFormIDCkNoReach('Idle', [IDLE]),\n {28 ptInventoryObject}\n wbFormIDCkNoReach('Inventory Object', sigBaseObjects),\n {29 ptKeyword}\n wbFormIDCkNoReach('Keyword', [KYWD, FLST, NULL]),\n {30 ptLocation}\n wbFormIDCkNoReach('Location', [LCTN]),\n {31 ptMagicEffect}\n wbFormIDCkNoReach('Base Effect', [MGEF]),\n {32 ptMagicItem}\n wbFormIDCkNoReach('Effect Item', [SPEL, ENCH, ALCH, INGR, SCRL]),\n {33 ptMiscStat}\n wbInteger('Misc Stat', itU32, wbMiscStatEnum),\n {34 ptObjectReference}\n wbFormIDCkNoReach('Object Reference', sigReferences),\n {35 ptOwner}\n wbFormIDCkNoReach('Owner', [NULL, FACT, NPC_]),\n {36 ptPackage}\n wbFormIDCkNoReach('Package', [PACK]),\n {37 ptPackdata}\n wbInteger('Packdata ID', itU32),\n {38 ptPerk}\n wbFormIDCkNoReach('Perk', [PERK]),\n {39 ptQuest}\n wbFormIDCkNoReach('Quest', [QUST]),\n {40 ptQuestStage}\n wbInteger('Quest Stage', itU32, wbCTDAParam2QuestStageToStr, wbCTDAParam2QuestStageToInt),\n {41 ptRace}\n wbFormIDCkNoReach('Race', [RACE]),\n {42 ptReferencableObject}\n wbFormIDCkNoReach('Referenceable Object', sigBaseObjects),\n {43 ptRefType}\n wbFormIDCkNoReach('Location Ref Type', [LCRT]),\n {44 ptRegion}\n wbFormIDCkNoReach('Region', [REGN]),\n {45 ptScene}\n wbFormIDCk('Scene', [NULL, SCEN]),\n {46 ptSex}\n wbInteger('Sex', itU32, wbSexEnum),\n {47 ptShout}\n wbFormIDCkNoReach('Shout', [SHOU]),\n {48 ptVariableName}\n wbByteArray('Variable Name (unused)', 4, cpIgnore),\n {49 ptVATSValueFunction}\n wbInteger('VATS Value Function', itU32, wbVATSValueFunctionEnum),\n {50 ptVATSValueParam}\n wbInteger('VATS Value Param (unused)', itU32),\n {51 ptVoiceType}\n wbFormIDCkNoReach('Voice Type', [VTYP, FLST]),\n {52 ptWardState}\n wbInteger('Ward State', itU32, wbWardStateEnum),\n {53 ptWeather}\n wbFormIDCkNoReach('Weather', [WTHR]),\n {54 ptWorldspace}\n wbFormIDCkNoReach('Worldspace', [WRLD, FLST]),\n {55 ptDamageType}\n wbFormIDCkNoReach('Damage Type', [DMGT, FLST])\n ]),\n\n wbUnion('Parameter #2', wbCTDAParam2Decider, [\n { unknown }\n wbByteArray('Unknown', 4),\n { 0 ptNone}\n wbByteArray('None', 4, cpIgnore),\n { 1 ptInteger}\n wbInteger('Integer', itS32),\n { 2 ptFloat}\n wbFloat('Float'),\n { 3 ptActor}\n wbFormIDCkNoReach('Actor', [NULL, PLYR, ACHR, REFR]),\n { 4 ptActorBase}\n wbFormIDCkNoReach('Actor Base', [NPC_]),\n { 5 ptActorValue}\n wbActorValue,\n { 6 ptAdvanceAction}\n wbInteger('Player Action', itU32, wbAdvanceActionEnum),\n { 7 ptAlias}\n wbInteger('Alias', itS32, wbConditionAliasToStr, wbStrToAlias),\n { 8 ptAlignment}\n wbInteger('Alignment', itU32, wbAlignmentEnum),\n { 9 ptAssociationType}\n wbFormIDCk('Association Type', [ASTP]),\n {10 ptAxis}\n wbInteger('Axis', itU32, wbAxisEnum),\n {11 ptCastingSource}\n wbInteger('Casting Type', itU32, wbCastingSourceEnum),\n {12 ptCell}\n wbFormIDCkNoReach('Cell', [CELL]),\n {13 ptClass}\n wbFormIDCkNoReach('Class', [CLAS]),\n {14 ptCrimeType}\n wbInteger('Crime Type', itU32, wbCrimeTypeEnum),\n {15 ptCriticalStage}\n wbInteger('Critical Stage', itU32, wbCriticalStageEnum),\n {16 ptEncounterZone}\n wbFormIDCkNoReach('Encounter Zone', [ECZN]),\n {17 ptEquipType}\n wbFormIDCkNoReach('Equip Type', [EQUP]),\n {18 ptEvent}\n wbInteger('Event', itU32, wbEventFunctionAndMemberToStr, wbEventFunctionAndMemberToInt),\n {19 ptEventData}\n wbFormID('Event Data'),\n {20 ptFaction}\n wbFormIDCkNoReach('Faction', [FACT]),\n {21 ptFormList}\n wbFormIDCkNoReach('Form List', [FLST]),\n {22 ptFormType}\n wbInteger('Form Type', itU32, wbFormTypeEnum),\n {23 ptFurniture}\n wbFormIDCkNoReach('Furniture', [FURN, FLST]),\n {24 ptFurnitureAnim}\n wbInteger('Furniture Anim', itU32, wbFurnitureAnimTypeEnum),\n {25 ptFurnitureEntry}\n wbInteger('Furniture Entry', itU32, wbEnum([], [$010000, 'Front', $020000, 'Behind', $040000, 'Right', $80000, 'Left', $100000, 'Up'])),\n {26 ptGlobal}\n wbFormIDCkNoReach('Global', [GLOB]),\n {27 ptIdleForm}\n wbFormIDCkNoReach('Idle', [IDLE]),\n {28 ptInventoryObject}\n wbFormIDCkNoReach('Inventory Object', sigBaseObjects),\n {29 ptKeyword}\n wbFormIDCkNoReach('Keyword', [KYWD, FLST, NULL]),\n {30 ptLocation}\n wbFormIDCkNoReach('Location', [LCTN]),\n {31 ptMagicEffect}\n wbFormIDCkNoReach('Base Effect', [MGEF]),\n {32 ptMagicItem}\n wbFormIDCkNoReach('Effect Item', [SPEL, ENCH, ALCH, INGR, SCRL]),\n {33 ptMiscStat}\n wbInteger('Misc Stat', itU32, wbMiscStatEnum),\n {34 ptObjectReference}\n wbFormIDCkNoReach('Object Reference', sigReferences),\n {35 ptOwner}\n wbFormIDCkNoReach('Owner', [NULL, FACT, NPC_]),\n {36 ptPackage}\n wbFormIDCkNoReach('Package', [PACK]),\n {37 ptPackdata}\n wbInteger('Packdata ID', itU32),\n {38 ptPerk}\n wbFormIDCkNoReach('Perk', [PERK]),\n {39 ptQuest}\n wbFormIDCkNoReach('Quest', [QUST]),\n {40 ptQuestStage}\n wbInteger('Quest Stage', itU32, wbCTDAParam2QuestStageToStr, wbCTDAParam2QuestStageToInt),\n {41 ptRace}\n wbFormIDCkNoReach('Race', [RACE]),\n {42 ptReferencableObject}\n wbFormIDCkNoReach('Referenceable Object', sigBaseObjects),\n {43 ptRefType}\n wbFormIDCkNoReach('Location Ref Type', [LCRT]),\n {44 ptRegion}\n wbFormIDCkNoReach('Region', [REGN]),\n {45 ptScene}\n wbFormIDCk('Scene', [NULL, SCEN]),\n {46 ptSex}\n wbInteger('Sex', itU32, wbSexEnum),\n {47 ptShout}\n wbFormIDCkNoReach('Shout', [SHOU]),\n {48 ptVariableName}\n wbByteArray('Variable Name (unused)', 4, cpIgnore),\n {49 ptVATSValueFunction}\n wbInteger('VATS Value Function', itU32, wbVATSValueFunctionEnum),\n {50 ptVATSValueParam}\n wbUnion('VATS Value Param', wbCTDAParam2VATSValueParamDecider, [\n { 0} wbFormIDCkNoReach('Weapon', [WEAP]),\n { 1} wbFormIDCkNoReach('Weapon List', [FLST], [WEAP]),\n { 2} wbFormIDCkNoReach('Target', [NPC_]),\n { 3} wbFormIDCkNoReach('Target List', [FLST], [NPC_]),\n { 4} wbByteArray('Unknown', 4, cpIgnore),\n { 5} wbInteger('Target Part', itS32, wbActorValueEnum),\n { 6} wbInteger('VATS Action', itU32, wbEnum([\n 'Unarmed Attack',\n 'One Hand Melee Attack',\n 'Two Hand Melee Attack',\n 'Magic Attack',\n 'Ranged Attack',\n 'Reload',\n 'Crouch',\n 'Stand',\n 'Switch Weapon',\n 'Toggle Weapon Drawn',\n 'Heal',\n 'Player Death'\n ])),\n { 7} wbByteArray('Unknown', 4, cpIgnore),\n { 8} wbByteArray('Unknown', 4, cpIgnore),\n { 9} wbFormIDCkNoReach('Critical Effect', [SPEL]),\n {10} wbFormIDCkNoReach('Critical Effect List', [FLST], [SPEL]),\n {11} wbByteArray('Unknown', 4, cpIgnore),\n {12} wbByteArray('Unknown', 4, cpIgnore),\n {13} wbByteArray('Unknown', 4, cpIgnore),\n {14} wbByteArray('Unknown', 4, cpIgnore),\n {15} wbInteger('Weapon Type', itU32, wbWeaponAnimTypeEnum),\n {16} wbByteArray('Unknown', 4, cpIgnore),\n {17} wbByteArray('Unknown', 4, cpIgnore),\n {18} wbInteger('Projectile Type', itU32, wbEnum([\n 'Missile',\n 'Lobber',\n 'Beam',\n 'Flame',\n 'Cone',\n 'Barrier',\n 'Arrow'\n ])),\n {19} wbInteger('Delivery Type', itU32, wbTargetEnum),\n {20} wbInteger('Casting Type', itU32, wbCastEnum)\n ]),\n {51 ptVoiceType}\n wbFormIDCkNoReach('Voice Type', [VTYP, FLST]),\n {52 ptWardState}\n wbInteger('Ward State', itU32, wbWardStateEnum),\n {53 ptWeather}\n wbFormIDCkNoReach('Weather', [WTHR]),\n {54 ptWorldspace}\n wbFormIDCkNoReach('Worldspace', [WRLD, FLST]),\n {55 ptDamageType}\n wbFormIDCkNoReach('Damage Type', [DMGT, FLST])\n ]),\n wbInteger('Run On', itU32, wbEnum([\n { 0} 'Subject',\n { 1} 'Target',\n { 2} 'Reference',\n { 3} 'Combat Target',\n { 4} 'Linked Reference',\n { 5} 'Quest Alias',\n { 6} 'Package Data',\n { 7} 'Event Data',\n { 9} 'Command Target',\n {10} 'Event Camera Ref',\n {11} 'My Killer'\n ]), cpNormal, False, nil, wbCTDARunOnAfterSet),\n wbUnion('Reference', wbCTDAReferenceDecider, [\n wbInteger('Unused', itU32, nil, cpIgnore),\n wbFormIDCkNoReach('Reference', sigReferences, False)\n ]),\n wbInteger('Parameter #3', itS32, nil, cpNormal, False, nil, nil, -1)\n ], cpNormal, False{, nil, 0, wbCTDAAfterLoad}),\n wbString(CIS1, 'Parameter #1'),\n wbString(CIS2, 'Parameter #2')\n ], [], cpNormal);\n\n wbCTDAs := wbRArray('Conditions', wbCTDA, cpNormal, False);\n wbCTDAsCount := wbRArray('Conditions', wbCTDA, cpNormal, False, nil, wbCTDAsAfterSet);\n wbCTDAsReq := wbRArray('Conditions', wbCTDA, cpNormal, True);\n wbCTDAsReqCount := wbRArray('Conditions', wbCTDA, cpNormal, True, nil, wbCTDAsAfterSet);\n\n wbICON := wbString(ICON, 'Inventory Image');\n wbMICO := wbString(MICO, 'Message Icon');\n wbPTRN := wbFormIDCk(PTRN, 'Preview Transform', [TRNS]);\n wbNTRM := wbFormIDCk(NTRM, 'Native Terminal', [TERM]);\n wbYNAM := wbFormIDCk(YNAM, 'Sound - Pick Up', [SNDR]);\n wbZNAM := wbFormIDCk(ZNAM, 'Sound - Put Down', [SNDR]);\n wbCUSD := wbFormIDCk(CUSD, 'Sound - Crafting', [SNDR]);\n wbINRD := wbFormIDCk(INRD, 'Instance Naming', [INNR]);\n wbPRPS := wbArrayS(PRPS, 'Properties', wbStructSK([0], 'Property', [\n wbActorValue,\n wbFloat('Value')\n ]));\n wbFLTR := wbString(FLTR, 'Filter');\n wbAPPR := wbArray(APPR, 'Attach Parent Slots', wbFormIDCk('Keyword', [KYWD]));\n wbFTYP := wbFormIDCk(FTYP, 'Forced Loc Ref Type', [LCRT]);\n wbATTX := wbLString(ATTX, 'Activate Text Override', 0, cpTranslate);\n\n wbMNAMFurnitureMarker := wbInteger(MNAM, 'Active Markers / Flags', itU32, wbFlags([\n {0x00000001} 'Interaction Point 0',\n {0x00000002} 'Interaction Point 1',\n {0x00000004} 'Interaction Point 2',\n {0x00000008} 'Interaction Point 3',\n {0x00000010} 'Interaction Point 4',\n {0x00000020} 'Interaction Point 5',\n {0x00000040} 'Interaction Point 6',\n {0x00000080} 'Interaction Point 7',\n {0x00000100} 'Interaction Point 8',\n {0x00000200} 'Interaction Point 9',\n {0x00000400} 'Interaction Point 10',\n {0x00000800} 'Interaction Point 11',\n {0x00001000} 'Interaction Point 12',\n {0x00002000} 'Interaction Point 13',\n {0x00004000} 'Interaction Point 14',\n {0x00008000} 'Interaction Point 15',\n {0x00010000} 'Interaction Point 16',\n {0x00020000} 'Interaction Point 17',\n {0x00040000} 'Interaction Point 18',\n {0x00080000} 'Interaction Point 19',\n {0x00100000} 'Interaction Point 20',\n {0x00200000} 'Interaction Point 21',\n {0x00400000} 'Allow Awake Sound',\n {0x00800000} 'Enter With Weapon Drawn',\n {0x01000000} 'Play Anim When Full',\n {0x02000000} 'Disables Activation',\n {0x04000000} 'Is Perch',\n {0x08000000} 'Must Exit to Talk',\n {0x10000000} 'Use Static Avoid Node',\n {0x20000000} 'Unknown 29',\n {0x40000000} 'Has Model?',\n {0x80000000} 'Unknown 31'\n ]));\n\n wbSNAMMarkerParams :=\n wbArray(SNAM, 'Marker Paramaters', wbStruct('Marker', [\n wbFloat('Offset X'),\n wbFloat('Offset Y'),\n wbFloat('Offset Z'),\n wbFloat('Rotation Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFormIDCk('Keyword', [KYWD, NULL]),\n wbInteger('Entry Types', itU8, wbFlags([\n 'Front',\n 'Rear',\n 'Right',\n 'Left',\n 'Other',\n 'Unused 5',\n 'Unused 6',\n 'Unused 7'\n ])),\n wbByteArray('Unknown', 3)\n ], cpNormal, False, nil, 4));\n\n wbArmorPropertyEnum := wbEnum([\n { 0} 'Enchantments',\n { 1} 'BashImpactDataSet',\n { 2} 'BlockMaterial',\n { 3} 'Keywords',\n { 4} 'Weight',\n { 5} 'Value',\n { 6} 'Rating',\n { 7} 'AddonIndex',\n { 8} 'BodyPart',\n { 9} 'DamageTypeValue',\n {10} 'ActorValues',\n {11} 'Health',\n {12} 'ColorRemappingIndex',\n {13} 'MaterialSwaps'\n ]);\n\n wbActorPropertyEnum := wbEnum([\n { 0} 'Keywords',\n { 1} 'ForcedInventory',\n { 2} 'XPOffset',\n { 3} 'Enchantments',\n { 4} 'ColorRemappingIndex',\n { 5} 'MaterialSwaps'\n ]);\n\n wbWeaponPropertyEnum := wbEnum([\n { 0} 'Speed',\n { 1} 'Reach',\n { 2} 'MinRange',\n { 3} 'MaxRange',\n { 4} 'AttackDelaySec',\n { 5} 'Unknown 5',\n { 6} 'OutOfRangeDamageMult',\n { 7} 'SecondaryDamage',\n { 8} 'CriticalChargeBonus',\n { 9} 'HitBehaviour',\n {10} 'Rank',\n {11} 'Unknown 11',\n {12} 'AmmoCapacity',\n {13} 'Unknown 13',\n {14} 'Unknown 14',\n {15} 'Type',\n {16} 'IsPlayerOnly',\n {17} 'NPCsUseAmmo',\n {18} 'HasChargingReload',\n {19} 'IsMinorCrime',\n {20} 'IsFixedRange',\n {21} 'HasEffectOnDeath',\n {22} 'HasAlternateRumble',\n {23} 'IsNonHostile',\n {24} 'IgnoreResist',\n {25} 'IsAutomatic',\n {26} 'CantDrop',\n {27} 'IsNonPlayable',\n {28} 'AttackDamage',\n {29} 'Value',\n {30} 'Weight',\n {31} 'Keywords',\n {32} 'AimModel',\n {33} 'AimModelMinConeDegrees',\n {34} 'AimModelMaxConeDegrees',\n {35} 'AimModelConeIncreasePerShot',\n {36} 'AimModelConeDecreasePerSec',\n {37} 'AimModelConeDecreaseDelayMs',\n {38} 'AimModelConeSneakMultiplier',\n {39} 'AimModelRecoilDiminishSpringForce',\n {40} 'AimModelRecoilDiminishSightsMult',\n {41} 'AimModelRecoilMaxDegPerShot',\n {42} 'AimModelRecoilMinDegPerShot',\n {43} 'AimModelRecoilHipMult',\n {44} 'AimModelRecoilShotsForRunaway',\n {45} 'AimModelRecoilArcDeg',\n {46} 'AimModelRecoilArcRotateDeg',\n {47} 'AimModelConeIronSightsMultiplier',\n {48} 'HasScope',\n {49} 'ZoomDataFOVMult',\n {50} 'FireSeconds',\n {51} 'NumProjectiles',\n {52} 'AttackSound',\n {53} 'AttackSound2D',\n {54} 'AttackLoop',\n {55} 'AttackFailSound',\n {56} 'IdleSound',\n {57} 'EquipSound',\n {58} 'UnEquipSound',\n {59} 'SoundLevel',\n {50} 'ImpactDataSet',\n {61} 'Ammo',\n {62} 'CritEffect',\n {63} 'BashImpactDataSet',\n {64} 'BlockMaterial',\n {65} 'Enchantments',\n {66} 'AimModelBaseStability',\n {67} 'ZoomData',\n {68} 'ZoomDataOverlay',\n {69} 'ZoomDataImageSpace',\n {70} 'ZoomDataCameraOffsetX',\n {71} 'ZoomDataCameraOffsetY',\n {72} 'ZoomDataCameraOffsetZ',\n {73} 'EquipSlot',\n {74} 'SoundLevelMult',\n {75} 'NPCAmmoList',\n {76} 'ReloadSpeed',\n {77} 'DamageTypeValues',\n {78} 'AccuracyBonus',\n {79} 'AttackActionPointCost',\n {80} 'OverrideProjectile',\n {81} 'HasBoltAction',\n {82} 'StaggerValue',\n {83} 'SightedTransitionSeconds',\n {84} 'FullPowerSeconds',\n {85} 'HoldInputToPower',\n {86} 'HasRepeatableSingleFire',\n {87} 'MinPowerPerShot',\n {88} 'ColorRemappingIndex',\n {89} 'MaterialSwaps',\n {90} 'CriticalDamageMult',\n {91} 'FastEquipSound',\n {92} 'DisableShells',\n {93} 'HasChargingAttack',\n {94} 'ActorValues'\n ]);\n\n wbObjectModProperties :=\n wbArrayS('Properties', wbStructSK([4], 'Property', [\n wbInteger('Value Type', itU8, wbEnum([\n {0} 'Int',\n {1} 'Float',\n {2} 'Bool',\n {3} 'Unknown 3',\n {4} 'FormID,Int',\n {5} 'Enum',\n {6} 'FormID,Float'\n ])),\n wbByteArray('Unused', 3, cpIgnore),\n wbUnion('Function Type', wbOMODDataFunctionTypeDecider, [\n { Float } wbInteger('Function Type', itU8, wbEnum(['SET', 'MUL+ADD', 'ADD'])),\n { Bool } wbInteger('Function Type', itU8, wbEnum(['SET', 'AND', 'OR'])),\n { Enum } wbInteger('Function Type', itU8, wbEnum(['SET'])),\n { FormID } wbInteger('Function Type', itU8, wbEnum(['SET', 'REM', 'ADD']))\n ]),\n wbByteArray('Unused', 3, cpIgnore),\n wbInteger('Property', itU16, wbObjectModPropertyToStr, wbObjectModPropertyToInt),\n wbByteArray('Unused', 2, cpIgnore),\n wbUnion('Value 1', wbOMODDataPropertyValue1Decider, [\n { 0} wbByteArray('Value 1 - Unknown', 4),\n { 1} wbInteger('Value 1 - Int', itU32),\n { 2} wbFloat('Value 1 - Float'),\n { 3} wbInteger('Value 1 - Bool', itU32, wbBoolEnum),\n { 4} wbFormID('Value 1 - FormID'),\n { 5} wbInteger('Value 1 - Enum', itU32),\n { 6} wbInteger('Sound Level', itU32, wbSoundLevelEnum),\n { 7} wbInteger('Stagger Value', itU32, wbStaggerEnum),\n { 8} wbInteger('Hit Behaviour', itU32, wbHitBehaviourEnum)\n ]),\n wbUnion('Value 2', wbOMODDataPropertyValue2Decider, [\n wbByteArray('Unused', 4, cpIgnore),\n wbInteger('Value 2 - Int', itU32),\n wbFloat('Value 2 - Float'),\n wbInteger('Value 2 - Bool', itU32, wbBoolEnum)\n ]),\n wbFloat('Step')\n ]), wbOMODDataPropertyCounter, cpNormal, False, nil, wbOMODpropertyAfterSet);\n\n wbOBTSReq := wbStruct(OBTS, 'Object Mod Template Item', [\n wbInteger('Include Count', itU32), // fixed name for wbOMOD* handlers\n wbInteger('Property Count', itU32), // fixed name for wbOMOD* handlers\n wbInteger('Level Min', itU8),\n wbByteArray('Unused', 1),\n wbInteger('Level Max', itU8),\n wbByteArray('Unused', 1),\n wbInteger('ID', itS16),\n wbInteger('Default', itU8, wbBoolEnum),\n wbArray('Keywords', wbFormIDCk('Keyword', [KYWD, NULL]), -4),\n wbInteger('Min Level For Ranks', itU8),\n wbInteger('Alt Levels Per Tier', itU8),\n wbArray('Includes', wbStruct('Include', [\n wbFormIDCk('Mod', [OMOD]),\n wbInteger('Attach Point Index', itU8),\n wbInteger('Optional', itU8, wbBoolEnum),\n wbInteger('Don''t Use All', itU8, wbBoolEnum)\n ]), wbOMODDataIncludeCounter, cpNormal, False, nil, wbOMODincludeAfterSet),\n wbObjectModProperties\n ], cpNormal, True);\n\n wbObjectTemplate := wbRStruct('Object Template', [\n wbInteger(OBTE, 'Count', itU32, nil, cpBenign),\n wbRArray('Combinations',\n wbRStruct('Combination', [\n wbEmpty(OBTF, 'Editor Only'),\n wbFULL,\n wbOBTSReq\n ], [], cpNormal, False, nil, True),\n cpNormal, False, nil, wbOBTSCombinationsAfterSet),\n wbEmpty(STOP, 'Marker', cpNormal, True)\n ], []);\n\n wbBSMPSequence := wbRStructs('Bone Data', 'Data', [\n wbInteger(BSMP, 'Gender', itU32, wbEnum(['Male', 'Female'])),\n // should not be sorted!!!\n wbRArray('Bones',\n wbRStruct('Bone', [\n wbString(BSMB, 'Name'),\n wbArray(BSMS, 'Values', wbFloat('Value')),\n wbUnknown(BMMP)\n ], [])\n )\n ], []);\n\n wbEffectsReq :=\n wbRStructs('Effects', 'Effect', [\n wbEFID,\n wbEFIT,\n wbCTDAs\n ], [], cpNormal, True);\n\n wbRecord(ACTI, 'Activator',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000002} 2, 'Never Fades',\n {0x00000004} 4, 'Non Occluder',\n {0x00000040} 6, 'Unknown 6',\n {0x00000080} 7, 'Heading Marker',\n {0x00000100} 8, 'Must Update Anims',\n {0x00000200} 9, 'Hidden From Local Map',\n {0x00000400} 10, 'Headtrack Marker',\n {0x00000800} 11, 'Used as Platform',\n {0x00001000} 13, 'Pack-In Use Only',\n {0x00008000} 15, 'Has Distant LOD',\n {0x00010000} 16, 'Random Anim Start',\n {0x00020000} 17, 'Dangerous',\n {0x00100000} 20, 'Ignore Object Interaction',\n {0x00800000} 23, 'Is Marker',\n {0x02000000} 25, 'Obstacle',\n {0x04000000} 26, 'NavMesh Generation - Filter',\n {0x08000000} 27, 'NavMesh Generation - Bounding Box',\n {0x20000000} 29, 'Child Can Use',\n {0x40000000} 30, 'NavMesh Generation - Ground'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFormIDCk(STCP, 'Sound', [STAG]),\n wbFULL,\n wbMODL,\n wbDEST,\n wbKSIZ,\n wbKWDAs,\n wbPRPS,\n wbNTRM,\n wbFTYP,\n wbStruct(PNAM, 'Marker Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbInteger('Unused', itU8)\n ]),\n wbFormIDCk(SNAM, 'Sound - Looping', [SNDR]),\n wbFormIDCk(VNAM, 'Sound - Activation', [SNDR]),\n wbFormIDCk(WNAM, 'Water Type', [WATR]),\n wbATTX,\n wbInteger(FNAM, 'Flags', itU16, wbFlags([\n 'No Displacement',\n 'Ignored by Sandbox',\n 'Unknown 2',\n 'Unknown 3',\n 'Is a Radio'\n ])),\n wbFormIDCk(KNAM, 'Interaction Keyword', [KYWD]),\n wbStruct(RADR, 'Radio Receiver', [\n wbFormIDCk('Sound Model', [SOPM, NULL]),\n wbFloat('Frequency'),\n wbFloat('Volume'),\n wbInteger('Starts Active', itU8, wbBoolEnum),\n wbInteger('No Signal Static', itU8, wbBoolEnum)\n ], cpNormal, False, nil, 4),\n wbCITC,\n wbCTDAs,\n wbNVNM\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n wbRecord(TACT, 'Talking Activator',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000200} 9, 'Hidden From Local Map',\n {0x00010000} 16, 'Random Anim Start',\n {0x00020000} 17, 'Radio Station'\n ]), [17]), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbDEST,\n wbKSIZ,\n wbKWDAs,\n wbUnknown(PNAM, cpIgnore, True),\n wbFormIDCk(SNAM, 'Looping Sound', [SNDR]),\n wbUnknown(FNAM, cpIgnore, True),\n wbFormIDCk(VNAM, 'Voice Type', [VTYP])\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n wbRecord(ALCH, 'Ingestible',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x20000000} 29, 'Medicine'\n ])), [\n wbEDID,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbKSIZ,\n wbKWDAs,\n wbMODL,\n wbICON,\n wbMICO,\n wbYNAM,\n wbZNAM,\n wbETYP,\n wbCUSD,\n wbDEST,\n wbDESC,\n wbFloat(DATA, 'Weight', cpNormal, True),\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Value', itS32),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'No Auto-Calc',\n {0x00000002} 'Food Item',\n {0x00000004} 'Unknown 3',\n {0x00000008} 'Unknown 4',\n {0x00000010} 'Unknown 5',\n\t\t\t\t{0x00000020} 'Unknown 6',\n\t\t\t\t{0x00000040} 'Unknown 7',\n\t\t\t\t{0x00000080} 'Unknown 8',\n\t\t\t\t{0x00000100} 'Unknown 9',\n\t\t\t\t{0x00000200} 'Unknown 10',\n\t\t\t\t{0x00000400} 'Unknown 11',\n\t\t\t\t{0x00000800} 'Unknown 12',\n\t\t\t\t{0x00001000} 'Unknown 13',\n\t\t\t\t{0x00002000} 'Unknown 14',\n\t\t\t\t{0x00004000} 'Unknown 15',\n\t\t\t\t{0x00008000} 'Unknown 16',\n\t\t\t\t{0x00010000} 'Medicine',\n\t\t\t\t{0x00020000} 'Poison'\n ])),\n wbFormID('Addiction'),\n wbFloat('Addiction Chance'),\n wbFormIDCk('Sound - Consume', [SNDR, NULL])\n ], cpNormal, True),\n wbLString(DNAM, 'Addiction Name', 0, cpTranslate),\n wbEffectsReq\n ], False, nil, cpNormal, False, wbRemoveEmptyKWDA, wbKeywordsAfterSet);\n\n wbRecord(AMMO, 'Ammunition',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Non-Playable'\n ])), [\n wbEDID,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbDESC,\n wbKSIZ,\n wbKWDAs,\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ], cpNormal, True, nil, 1),\n wbStruct(DNAM, '', [\n wbFormIDCk('Projectile', [PROJ, NULL]),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Ignores Normal Weapon Resistance',\n {0x02} 'Non-Playable',\n {0x04} 'Has Count Based 3D'\n ])),\n wbByteArray('Unused', 3),\n wbFloat('Damage'),\n wbInteger('Health', itU32)\n ], cpNormal, True),\n wbLStringKC(ONAM, 'Short Name', 0, cpTranslate),\n wbString(NAM1, 'Casing Model'),\n wbByteArray(NAM2, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow)\n ], False, nil, cpNormal, False, wbRemoveEmptyKWDA, wbKeywordsAfterSet);\n\n wbRecord(ANIO, 'Animated Object',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000200} 9, 'Unknown 9'\n ]), [9]), [\n wbEDID,\n wbMODL,\n wbString(BNAM, 'Unload Event')\n ]);\n\n wbRecord(ARMO, 'Armor',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Non-Playable',\n {0x00000040} 6, 'Shield',\n {0x00000400} 10, 'Unknown 10',\n {0x00008000} 15, 'Unknown 15'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbEITM,\n wbRStruct('Male world model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO2S\n ], []),\n wbString(ICON, 'Male Inventory Image'),\n wbString(MICO, 'Male Message Icon'),\n wbRStruct('Female world model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO4S\n ], []),\n wbString(ICO2, 'Female Inventory Image'),\n wbString(MIC2, 'Female Message Icon'),\n wbBOD2,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbETYP,\n wbFormIDCk(BIDS, 'Block Bash Impact Data Set', [IPDS, NULL]),\n wbFormIDCk(BAMT, 'Alternate Block Material', [MATT, NULL]),\n wbFormIDCk(RNAM, 'Race', [RACE]),\n wbKSIZ,\n wbKWDAs,\n wbDESC,\n wbINRD,\n wbRArray('Models',\n wbRStruct('Model', [\n wbInteger(INDX, 'Addon Index', itU16),\n wbFormIDCk(MODL, 'Armor Addon', [ARMA])\n ], [])\n ),\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight'),\n wbInteger('Health', itU32)\n ], cpNormal, True),\n wbStruct(FNAM, '', [\n wbInteger('Armor Rating', itU16),\n wbInteger('Base Addon Index', itU16),\n wbInteger('Stagger Rating', itU8, wbStaggerEnum),\n wbUnknown\n ]),\n wbArrayS(DAMA, 'Resistances', wbStructSK([0], 'Resistance', [\n wbFormIDCk('Damage Type', [DMGT]),\n wbInteger('Value', itU32)\n ])),\n wbFormIDCk(TNAM, 'Template Armor', [ARMO]),\n wbAPPR,\n wbObjectTemplate\n ], False, nil, cpNormal, False, wbARMOAfterLoad, wbKeywordsAfterSet);\n\n wbRecord(ARMA, 'Armor Addon',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000040} 6, 'No Underarmor Scaling',\n {0x00000200} 9, 'Unknown 9',\n {0x40000000} 30, 'Hi-Res 1st Person Only'\n ])), [\n wbEDID,\n wbBOD2,\n wbFormIDCk(RNAM, 'Race', [RACE]),\n wbStruct(DNAM, 'Data', [\n wbInteger('Male Priority', itU8),\n wbInteger('Female Priority', itU8),\n // essentialy a number of world models for different weights (Enabled = 2 models _0.nif and _1.nif)\n wbInteger('Weight slider - Male', itU8, wbFlags([\n {0x01} 'Unknown 0',\n {0x02} 'Enabled'\n ])),\n wbInteger('Weight slider - Female', itU8, wbFlags([\n {0x01} 'Unknown 0',\n {0x02} 'Enabled'\n ])),\n wbByteArray('Unknown', 2),\n wbInteger('Detection Sound Value', itU8),\n wbByteArray('Unknown', 1),\n wbFloat('Weapon Adjust')\n ], cpNormal, True),\n wbRStruct('Male world model', [\n wbString(MOD2, 'Model Filename'),\n wbByteArray(MO2T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO2S,\n wbMO2C,\n wbMO2F\n ], [], cpNormal, False),\n wbRStruct('Female world model', [\n wbString(MOD3, 'Model Filename'),\n wbByteArray(MO3T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO3S,\n wbMO3C,\n wbMO3F\n ], []),\n wbRStruct('Male 1st Person', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO4S,\n wbMO4C,\n wbMO4F\n ], []),\n wbRStruct('Female 1st Person', [\n wbString(MOD5, 'Model Filename'),\n wbByteArray(MO5T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO5S,\n wbMO5C,\n wbMO5F\n ], []),\n wbFormIDCK(NAM0, 'Male Skin Texture', [TXST, NULL]),\n wbFormIDCK(NAM1, 'Female Skin Texture', [TXST, NULL]),\n wbFormIDCK(NAM2, 'Male Skin Texture Swap List', [FLST, NULL]),\n wbFormIDCK(NAM3, 'Female Skin Texture Swap List', [FLST, NULL]),\n wbRArrayS('Additional Races', wbFormIDCK(MODL, 'Race', [RACE, NULL])),\n wbFormIDCk(SNDD, 'Footstep Sound', [FSTS, NULL]),\n wbFormIDCk(ONAM, 'Art Object', [ARTO]),\n wbBSMPSequence\n ], False, nil, cpNormal, False, wbARMAAfterLoad);\n\n wbRecord(BOOK, 'Book', [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbICON,\n wbMICO,\n wbDESCreq,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbKSIZ,\n wbKWDAs,\n wbFormIDCk(FIMD, 'Featured Item Message', [MESG]),\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbStruct(DNAM, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Advance Actor Value',\n {0x02} 'Can''t be Taken',\n {0x04} 'Add Spell',\n {0x08} 'Unknown 3',\n {0x10} 'Add Perk'\n ])),\n wbUnion('Teaches', wbBOOKTeachesDecider, [\n wbByteArray('Unused', 4),\n wbFormIDCk('Actor Value', [AVIF, NULL]),\n wbFormIDCk('Spell', [SPEL, NULL]),\n wbFormIDCk('Perk', [PERK, NULL])\n ]),\n wbStruct('Text Offset' , [\n wbInteger('X', itU32),\n wbInteger('Y', itU32)\n ])\n ], cpNormal, True),\n wbLString(CNAM, 'Description', 0, cpTranslate),\n wbFormIDCk(INAM, 'Inventory Art', [STAT])\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\nend;\n\nprocedure DefineFO4c;\n\n procedure ReferenceRecord(aSignature: TwbSignature; const aName: string);\n begin\n wbRecord(aSignature, aName,\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000080} 7, 'Turn Off Fire',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn'\n ], True, True)), [\n wbEDID,\n wbVMAD,\n wbFormIDCk(NAME, 'Projectile', [PROJ, HAZD]),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbFloat(XHTW, 'Head-Tracking Weight'),\n wbFloat(XFVC, 'Favor Cost'),\n wbRArrayS('Reflected/Refracted By',\n wbStructSK(XPWR, [0], 'Water', [\n wbFormIDCk('Reference', [REFR]),\n wbInteger('Type', itU32, wbFlags([\n 'Reflection',\n 'Refraction'\n ]))\n ], cpNormal, False, nil, 1)\n ),\n wbRArrayS('Linked References', wbStructSK(XLKR, [0], 'Linked Reference', [\n wbFormIDCk('Keyword/Ref', [KYWD, PLYR, ACHR, REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA, NULL]),\n wbFormIDCk('Ref', sigReferences)\n ], cpNormal, False, nil, 1)),\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', sigReferences),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbFormIDCk(XASP, 'Unknown', [REFR]),\n wbUnknown(XATP),\n wbInteger(XAMC, 'Ammo Count', itU32),\n wbEmpty(XLKT, 'Linked Ref Transient'),\n wbFormIDCk(XLYR, 'Layer', [LAYR]),\n wbFormIDCk(XMSP, 'Material Swap', [MSWP]),\n wbFormIDCk(XRFG, 'Reference Group', [RFGP]),\n wbUnknown(XCVR),\n wbXESP,\n wbXOWN,\n wbXRNK,\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n wbEmpty(XIS2, 'Ignored by Sandbox'),\n wbArray(XLRT, 'Location Ref Type', wbFormIDCk('Ref', [LCRT, NULL])),\n wbFormIDCk(XLRL, 'Location Reference', [LCRT, LCTN, NULL], False, cpBenignIfAdded),\n wbXSCL,\n wbXLOD,\n wbDataPosRot,\n wbString(MNAM, 'Comments')\n ], True, wbPlacedAddInfo);\n end;\n\nbegin\n{>>>\n Skrim has its own ref record for every projectile type\n PARW 'Arrow'\n PBEA 'Beam'\n PFLA 'Flame'\n PCON 'Cone' (voice)\n PBAR 'Barrier'\n PGRE 'Traps'\n PHZD 'Hazards'\n I guess all of them have the same structure\n<<<}\n ReferenceRecord(PARW, 'Placed Arrow');\n ReferenceRecord(PBAR, 'Placed Barrier');\n ReferenceRecord(PBEA, 'Placed Beam');\n ReferenceRecord(PCON, 'Placed Cone/Voice');\n ReferenceRecord(PFLA, 'Placed Flame');\n ReferenceRecord(PGRE, 'Placed Projectile');\n ReferenceRecord(PHZD, 'Placed Hazard');\n ReferenceRecord(PMIS, 'Placed Missile');\n\n wbRecord(CELL, 'Cell',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000400} 7, 'No Pre Vis',\n {0x00000400} 10, 'Persistent',\n {0x00020000} 17, 'Off Limits',\n {0x00040000} 18, 'Compressed',\n {0x00080000} 19, 'Can''t Wait'\n ]), [18]), [\n wbEDID,\n wbFULL,\n wbInteger(DATA, 'Flags', itU16, wbFlags([\n {0x0001} 'Is Interior Cell',\n {0x0002} 'Has Water',\n {0x0004} 'Can''t Travel From Here',\n {0x0008} 'No LOD Water',\n {0x0010} 'Unknown 5',\n {0x0020} 'Public Area',\n {0x0040} 'Hand Changed',\n {0x0080} 'Show Sky',\n {0x0100} 'Use Sky Lighting',\n {0x0200} 'Unknown 10',\n {0x0400} 'Unknown 11',\n {0x0800} 'Sunlight Shadows',\n {0x1000} 'Distant LOD only',\n {0x2000} 'Player Followers Can''t Travel Here',\n {0x4000} 'Unknown 15',\n {0x8000} 'Unknown 16'\n ]), cpNormal, True, False, nil, wbCELLDATAAfterSet),\n wbStruct(XCLC, 'Grid', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32),\n wbInteger('Force Hide Land', itU32, wbFlags([\n 'Quad 1',\n 'Quad 2',\n 'Quad 3',\n 'Quad 4'\n ], True))\n ], cpNormal, False, nil, 2),\n\n wbByteArray(VISI, 'PreVis Files Timestamp', 2),\n wbFormIDCk(RVIS, 'In PreVis File Of', [CELL]),\n wbByteArray(PCMB, 'PreCombined Files Timestamp', 2),\n\n wbStruct(XCLL, 'Lighting', [\n wbByteColors('Ambient Color'),\n wbByteColors('Directional Color'),\n wbByteColors('Fog Color Near'),\n wbFloat('Fog Near'),\n wbFloat('Fog Far'),\n wbInteger('Directional Rotation XY', itS32),\n wbInteger('Directional Rotation Z', itS32),\n wbFloat('Directional Fade'),\n wbFloat('Fog Clip Distance'),\n wbFloat('Fog Power'),\n wbAmbientColors,\n wbByteColors('Fog Color Far'),\n wbFloat('Fog Max'),\n wbFloat('Light Fade Begin'),\n wbFloat('Light Fade End'),\n wbInteger('Inherits', itU32, wbFlags([\n {0x00000001} 'Ambient Color',\n {0x00000002} 'Directional Color',\n {0x00000004} 'Fog Color',\n {0x00000008} 'Fog Near',\n {0x00000010} 'Fog Far',\n {0x00000020} 'Directional Rotation',\n {0x00000040} 'Directional Fade',\n {0x00000080} 'Clip Distance',\n {0x00000100} 'Fog Power',\n {0x00000200} 'Fog Max',\n {0x00000400} 'Light Fade Distances'\n ])),\n wbFloat('Near Height Mid'),\n wbFloat('Near Height Range'),\n wbByteColors('Fog Color High Near'),\n wbByteColors('Fog Color High Far'),\n wbFloat('High Density Scale'),\n wbFloat('Fog Near Scale'),\n wbFloat('Fog Far Scale'),\n wbFloat('Fog High Near Scale'),\n wbFloat('Fog High Far Scale'),\n wbFloat('Far Height Mid'),\n wbFloat('Far Height Range')\n ], cpNormal, False, nil, 11),\n\n wbInteger(CNAM, 'Precombined Object Level XY', itU8),\n wbInteger(ZNAM, 'Precombined Object Level Z', itU8),\n wbByteArray(TVDT, 'Unknown', 0, cpNormal),\n wbMaxHeightDataCELL,\n wbFormIDCk(LTMP, 'Lighting Template', [LGTM, NULL], False, cpNormal, True),\n\n {>>> XCLW sometimes has $FF7FFFFF and causes invalid floation point <<<}\n wbFloat(XCLW, 'Water Height', cpNormal, False, 1, -1, nil, nil, 0, wbCELLXCLWGetConflictPriority),\n wbArrayS(XCLR, 'Regions', wbFormIDCk('Region', [REGN])),\n wbFormIDCk(XLCN, 'Location', [LCTN]),\n wbByteArray(XWCN, 'Unknown', 0, cpIgnore), // leftover\n wbStruct(XWCU, 'Water Velocity', [\n wbFloat('X Offset'),\n wbFloat('Y Offset'),\n wbFloat('Z Offset'),\n wbByteArray('Unknown', 4),\n wbFloat('X Angle'),\n wbFloat('Y Angle'),\n wbFloat('Z Angle'),\n wbByteArray('Unknown', 0)\n ]),\n wbFormIDCk(XCWT, 'Water', [WATR]),\n\n {--- Ownership ---}\n wbXOWN,\n wbXRNK,\n\n wbFormIDCk(XILL, 'Lock List', [FLST, NPC_]),\n\n wbStruct(XILW, 'Exterior LOD', [\n wbFormIDCk('Worldspace', [WRLD]),\n wbFloat('Offset X'),\n wbFloat('Offset Y'),\n wbFloat('Offset Z')\n ]),\n wbString(XWEM, 'Water Environment Map'),\n wbFormIDCk(XCCM, 'Sky/Weather from Region', [REGN]),\n wbFormIDCk(XCAS, 'Acoustic Space', [ASPC]),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n wbFormIDCk(XCMO, 'Music Type', [MUSC]),\n wbFormIDCk(XCIM, 'Image Space', [IMGS]),\n wbFormIDCk(XGDR, 'God Rays', [GDRY]),\n\n // those can be sorted I think, but makes copying records very slow since some cells have over 22000+ entries\n // DLC01Lair01 \"The Mechanist's Lair\" [CELL:010008A3]\n wbArrayS(XPRI, 'Physics References', wbFormIDCk('Reference', [REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA])),\n wbStruct(XCRI, 'Combined References', [\n wbInteger('Meshes Count', itU32),\n wbInteger('References Count', itU32),\n wbArrayS('Meshes', wbInteger('Combined Mesh', itU32, wbCombinedMeshIDToStr, wbCombinedMeshIDToInt), wbCELLCombinedMeshesCounter, cpNormal, False, nil, wbCELLCombinedMeshesAfterSet),\n wbArrayS('References', wbStructSK([1, 0], 'Reference', [\n wbFormIDCk('Reference', [REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA]),\n wbInteger('Combined Mesh', itU32, wbCombinedMeshIDToStr, wbCombinedMeshIDToInt)\n ]), wbCELLCombinedRefsCounter, cpNormal, False, nil, wbCELLCombinedRefsAfterSet)\n ])\n ], True, wbCellAddInfo, cpNormal, False{, wbCELLAfterLoad});\n\n wbRecord(CLAS, 'Class', [\n wbEDID,\n wbFULLReq,\n wbDESCReq,\n wbICON,\n wbPRPS,\n wbStruct(DATA, 'Data', [\n wbByteArray('Unknown', 4),\n wbFloat('Bleedout Default')\n ])\n ]);\n\n wbRecord(CLMT, 'Climate', [\n wbEDID,\n wbArrayS(WLST, 'Weather Types', wbStructSK([0], 'Weather Type', [\n wbFormIDCk('Weather', [WTHR, NULL]),\n wbInteger('Chance', itS32),\n wbFormIDCk('Global', [GLOB, NULL])\n ])),\n wbString(FNAM, 'Sun Texture'),\n wbString(GNAM, 'Sun Glare Texture'),\n wbMODL,\n wbStruct(TNAM, 'Timing', [\n wbStruct('Sunrise', [\n wbInteger('Begin', itU8, wbClmtTime),\n wbInteger('End', itU8, wbClmtTime)\n ]),\n wbStruct('Sunset', [\n wbInteger('Begin', itU8, wbClmtTime),\n wbInteger('End', itU8, wbClmtTime)\n ]),\n wbInteger('Volatility', itU8),\n wbInteger('Moons / Phase Length', itU8, wbClmtMoonsPhaseLength)\n ], cpNormal, True)\n ]);\n\n wbRecord(SPGD, 'Shader Particle Geometry', [\n wbEDID,\n wbStruct(DATA, 'Data', [\n wbFloat('Gravity Velocity'),\n wbByteArray('Unknown', 4),\n wbFloat('Rotation Velocity'),\n wbByteArray('Unknown', 4),\n wbFloat('Particle Size X'),\n wbFloat('Center Offset Min'),\n wbFloat('Particle Size Y'),\n wbByteArray('Unknown', 4),\n wbFloat('Center Offset Min'),\n wbByteArray('Unknown', 4),\n wbFloat('Center Offset Max'),\n wbByteArray('Unknown', 4),\n wbFloat('Initial Rotation'),\n wbByteArray('Unknown', 4),\n wbInteger('# of Subtextures X', itU32),\n wbByteArray('Unknown', 4),\n wbInteger('# of Subtextures Y', itU32),\n wbByteArray('Unknown', 4),\n wbInteger('Type', itU32, wbEnum([\n 'Rain',\n 'Snow'\n ])),\n wbByteArray('Unknown', 4),\n wbInteger('Box Size', itU32),\n wbByteArray('Unknown', 4),\n wbFloat('Particle Density'),\n wbUnknown\n ], cpNormal, True, nil, 10),\n wbString(MNAM, 'Particle Texture')\n ]);\n\n wbRecord(RFCT, 'Visual Effect', [\n wbEDID,\n wbStruct(DATA, 'Effect Data', [\n\t\t\twbFormIDCK('Effect Art', [ARTO, NULL]),\n wbFormIDCK('Shader', [EFSH, NULL]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Rotate to Face Target',\n {0x00000002} 'Attach to Camera',\n {0x00000004} 'Inherit Rotation'\n ]))\n ], cpNormal, True)\n ]);\n\n wbRecord(CONT, 'Container',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00008000} 15, 'Has Distant LOD',\n {0x00010000} 16, 'Random Anim Start',\n {0x02000000} 25, 'Obstacle',\n {0x04000000} 26, 'NavMesh Generation - Filter',\n {0x08000000} 27, 'NavMesh Generation - Bounding Box',\n {0x40000000} 30, 'NavMesh Generation - Ground'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbCOCT,\n wbCNTOs,\n wbDEST,\n wbStruct(DATA, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Allow Sounds When Animation',\n {0x02} 'Respawns',\n {0x04} 'Show Owner'\n ])),\n wbFloat('Weight')\n ], cpNormal, True),\n wbKSIZ,\n wbKWDAs,\n wbFTYP,\n wbPRPS,\n wbNTRM,\n wbFormIDCk(SNAM, 'Sound - Open', [SNDR]),\n wbFormIDCk(QNAM, 'Sound - Close', [SNDR]),\n wbFormIDCk(TNAM, 'Sound - Take All', [SNDR]),\n wbFormIDCk(ONAM, 'Filter List', [FLST])\n ], True, nil, cpNormal, False, nil, wbContainerAfterSet);\n\n wbAIDT :=\n wbStruct(AIDT, 'AI Data', [\n {00} wbInteger('Aggression', itU8, wbEnum([\n 'Unaggressive',\n 'Aggressive',\n 'Very Aggressive',\n 'Frenzied'\n ])),\n {01} wbInteger('Confidence', itU8, wbEnum([\n 'Cowardly',\n 'Cautious',\n 'Average',\n 'Brave',\n 'Foolhardy'\n ])),\n {02} wbInteger('Energy Level', itU8),\n {03} wbInteger('Responsibility', itU8, wbEnum([\n 'Any crime',\n 'Violence against enemies',\n 'Property crime only',\n 'No crime'\n ])),\n {04} wbInteger('Mood', itU8, wbEnum([\n 'Neutral',\n 'Angry',\n 'Fear',\n 'Happy',\n 'Sad',\n 'Surprised',\n 'Puzzled',\n 'Disgusted'\n ])),\n wbInteger('Assistance', itU8, wbEnum([\n 'Helps Nobody',\n 'Helps Allies',\n 'Helps Friends and Allies'\n ])),\n wbStruct('Aggro', [\n wbInteger('Aggro Radius Behavior', itU8, wbBoolEnum),\n wbInteger('Unknown', itU8),\n wbInteger('Warn', itU32),\n wbInteger('Warn/Attack', itU32),\n wbInteger('Attack', itU32)\n ]),\n wbByteArray('Unknown', 4)\n ], cpNormal, True, nil{wbActorTemplateUseAIData});\n\n wbRecord(CSTY, 'Combat Style',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00080000} 19, 'Allow Dual Wielding'\n ])), [\n wbEDID,\n wbStruct(CSGD, 'General', [\n wbFloat('Offensive Mult'),\n wbFloat('Defensive Mult'),\n wbFloat('Group Offensive Mult'),\n wbFloat('Equipment Score Mult - Melee'),\n wbFloat('Equipment Score Mult - Magic'),\n wbFloat('Equipment Score Mult - Ranged'),\n wbFloat('Equipment Score Mult - Shout'),\n wbFloat('Equipment Score Mult - Unarmed'),\n wbFloat('Equipment Score Mult - Staff'),\n wbFloat('Avoid Threat Chance'),\n wbFloat('Dodge Threat Chance'),\n wbFloat('Evade Threat Chance')\n ], cpNormal, True),\n wbUnknown(CSMD, cpIgnore),\n wbStruct(CSME, 'Melee', [\n wbFloat('Attack Staggered Mult'),\n wbFloat('Power Attack Staggered Mult'),\n wbFloat('Power Attack Blocking Mult'),\n wbFloat('Bash Mult'),\n wbFloat('Bash Recoil Mult'),\n wbFloat('Bash Attack Mult'),\n wbFloat('Bash Power Attack Mult'),\n wbFloat('Special Attack Mult'),\n wbFloat('Block When Staggered Mult'),\n wbFloat('Attack When Staggered Mult')\n ], cpNormal, True, nil, 9),\n wbFloat(CSRA, 'Ranged Accuracy Mult', cpNormal, True),\n wbStruct(CSCR, 'Close Range', [\n wbFloat('Dueling - Circle Mult'),\n wbFloat('Dueling - Fallback Mult'),\n wbFloat('Flanking - Flank Distance'),\n wbFloat('Flanking - Stalk Time'),\n wbFloat('Charging - Charge Distance'),\n wbFloat('Charging - Throw Probability'),\n wbFloat('Charging - Sprint Fast Probability'),\n wbFloat('Charging - Sideswipe Probability'),\n wbFloat('Charging - Disengane Probability'),\n wbInteger('Charging - Throw Max Targets', itU32),\n wbFloat('Flanking - Flank Variance')\n ], cpNormal, True),\n wbStruct(CSLR, 'Long Range', [\n wbFloat('Strafe Mult'),\n wbFloat('Adjust Range Mult'),\n wbFloat('Crouch Mult'),\n wbFloat('Wait Mult'),\n wbFloat('Range Mult')\n ], cpNormal, True, nil, 3),\n wbFloat(CSCV, 'Cover Search Distance Mult', cpNormal, True),\n wbStruct(CSFL, 'Flight', [\n wbFloat('Hover Chance'),\n wbFloat('Dive Bomb Chance'),\n wbFloat('Ground Attack Chance'),\n wbFloat('Hover Time'),\n wbFloat('Ground Attack Time'),\n wbFloat('Perch Attack Chance'),\n wbFloat('Perch Attack Time'),\n wbFloat('Flying Attack Chance')\n ], cpNormal, True),\n wbInteger(DATA, 'Flags', itU32, wbFlags([\n {0x01} 'Dueling',\n {0x02} 'Flanking',\n {0x04} 'Allow Dual Wielding',\n {0x08} 'Charging',\n {0x10} 'Retarget Any Nearby Melee Target',\n {0x20} 'Unknown 5'\n ]), cpNormal, True)\n ]);\nend;\n\nprocedure DefineFO4d;\nbegin\n wbRecord(DIAL, 'Dialog Topic', [\n wbEDID,\n wbFULL,\n wbFloat(PNAM, 'Priority', cpNormal, True, 1, -1, nil, nil, 50.0),\n wbFormIDCk(BNAM, 'Branch', [DLBR]),\n wbFormIDCk(QNAM, 'Quest', [QUST], False, cpNormal, False),\n wbFormIDCk(KNAM, 'Keyword', [KYWD]),\n wbStruct(DATA, 'Data', [\n // this should not be named Flags since TwbFile.BuildReachable\n // expects Top-Level flag here from FNV\n wbInteger('Topic Flags', itU8, wbFlags([\n 'Do All Before Repeating',\n 'Unknown 1',\n 'Unknown 2'\n ]), cpNormal, True),\n wbInteger('Category', itU8, wbEnum([\n {0} 'Player',\n {1} 'Command',\n {2} 'Scene',\n {3} 'Combat',\n {4} 'Favor',\n {5} 'Detection',\n {6} 'Service',\n {7} 'Miscellaneous'\n ])),\n wbInteger('Subtype', itU16, wbEnum([\n { 0} 'Custom',\n { 1} 'ForceGreet',\n { 2} 'Rumors',\n { 3} 'Custom',\n { 4} 'Call',\n { 5} 'Follow',\n { 6} 'Move',\n { 7} 'Attack',\n { 8} 'Inspect',\n { 9} 'Retrieve',\n {10} 'Stay',\n {11} 'Release',\n {12} 'ShowRelationships',\n {13} 'Reject',\n {14} 'Heal',\n {15} 'Assign',\n {16} 'Enter',\n {17} 'Custom',\n {18} 'Show',\n {19} 'Agree',\n {20} 'Refuse',\n {21} 'ExitFavorState',\n {22} 'MoralRefusal',\n {23} 'Trade',\n {24} 'PathingRefusal',\n {25} 'Attack',\n {26} 'PowerAttack',\n {27} 'Bash',\n {28} 'Hit',\n {29} 'Flee',\n {30} 'BleedOut',\n {31} 'AvoidThreat',\n {32} 'Death',\n {33} 'Block',\n {34} 'Taunt',\n {35} 'ThrowGrenade',\n {36} 'AllyKilled',\n {37} 'OrderFallback',\n {38} 'OrderMoveUp',\n {39} 'OrderFlank',\n {40} 'OrderTakeCover',\n {41} 'Retreat',\n {42} 'CoverMe',\n {43} 'SuppressiveFire',\n {44} 'CrippledLimb',\n {45} 'PairedAttack',\n {46} 'Steal',\n {47} 'Yield',\n {48} 'AcceptYield',\n {49} 'PickpocketCombat',\n {50} 'Assault',\n {51} 'Murder',\n {52} 'AssaultNC',\n {53} 'MurderNC',\n {54} 'PickpocketNC',\n {55} 'StealFromNC',\n {56} 'TrespassAgainstNC',\n {57} 'Trespass',\n {58} 'UNUSED01',\n {59} 'VoicePowerStartShort',\n {60} 'VoicePowerStartLong',\n {61} 'VoicePowerEndShort',\n {62} 'VoicePowerEndLong',\n {63} 'AlertIdle',\n {64} 'LostIdle',\n {65} 'NormalToAlert',\n {66} 'NormalToCombat',\n {67} 'NormalToLost',\n {68} 'AlertToNormal',\n {69} 'AlertToCombat',\n {70} 'CombatToNormal',\n {71} 'CombatToLost',\n {72} 'LostToNormal',\n {73} 'LostToCombat',\n {74} 'DetectFriendDie',\n {75} 'ServiceRefusal',\n {76} 'Repair',\n {77} 'Travel',\n {78} 'Training',\n {79} 'BarterExit',\n {80} 'RepairExit',\n {81} 'Recharge',\n {82} 'RechargeExit',\n {83} 'TrainingExit',\n {84} 'ObserveCombat',\n {85} 'NoticeCorpse',\n {86} 'TimeToGo',\n {87} 'Goodbye',\n {88} 'Hello',\n {89} 'SwingMeleeWeapon',\n {90} 'ShootBow',\n {91} 'ZKeyObject',\n {92} 'Jump',\n {93} 'KnockOverObject',\n {94} 'DestroyObject',\n {95} 'StandonFurniture',\n {96} 'LockedObject',\n {97} 'PickpocketTopic',\n {98} 'PursueIdleTopic',\n {99} 'SharedInfo',\n {100} 'SceneChoice',\n {101} 'PlayerCastProjectileSpell',\n {102} 'PlayerCastSelfSpell',\n {103} 'PlayerShout',\n {104} 'Idle',\n {105} 'EnterSprintBreath',\n {106} 'EnterBowZoomBreath',\n {107} 'ExitBowZoomBreath',\n {108} 'ActorCollidewithActor',\n {109} 'PlayerinIronSights',\n {110} 'OutofBreath',\n {111} 'CombatGrunt',\n {112} 'LeaveWaterBreath',\n {113} 'ImpatientPostitive',\n {114} 'ImpatientNegative',\n {115} 'ImpatientNeutral',\n {116} 'ImpatientQuestion',\n {117} 'WaitingForPlayerInput',\n {118} 'Greeting',\n {119} 'PlayerActivateDoor',\n {120} 'PlayerActivateTerminals',\n {121} 'PlayerActivateFurniture',\n {122} 'PlayerActivateActivators',\n {123} 'PlayerActivateContainer',\n {124} 'PlayerAquireFeaturedItem'\n ]))\n ]),\n wbString(SNAM, 'Subtype Name', 4),\n wbInteger(TIFC, 'Info Count', itU32, nil, cpBenign)\n ]);\n\n wbRecord(DOOR, 'Door',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000010} 4, 'Non Occluder',\n {0x00008000} 15, 'Has Distant LOD',\n {0x00010000} 16, 'Random Anim Start',\n {0x00800000} 23, 'Is Marker'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbDEST,\n wbKSIZ,\n wbKWDAs,\n wbNTRM,\n wbFormIDCk(SNAM, 'Sound - Open', [SNDR]),\n wbFormIDCk(ANAM, 'Sound - Close', [SNDR]),\n wbFormIDCk(BNAM, 'Sound - Loop', [SNDR]),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n '',\n 'Automatic',\n 'Hidden',\n 'Minimal Use',\n 'Sliding',\n 'Do Not Open in Combat Search',\n 'No \"To\" Text'\n ]), cpNormal, True),\n wbLStringKC(ONAM, 'Alternate Text - Open', 0, cpTranslate),\n wbLStringKC(CNAM, 'Alternate Text - Close', 0, cpTranslate)\n ]);\n\n wbBlendModeEnum := wbEnum([\n '',\n 'Zero',\n 'One',\n 'Source Color',\n 'Source Inverse Color',\n 'Source Alpha',\n 'Source Inverted Alpha',\n 'Dest Alpha',\n 'Dest Inverted Alpha',\n 'Dest Color',\n 'Dest Inverse Color',\n 'Source Alpha SAT'\n ]);\n\n wbBlendOpEnum := wbEnum([\n '',\n 'Add',\n 'Subtract',\n 'Reverse Subtract',\n 'Minimum',\n 'Maximum'\n ]);\n\n wbZTestFuncEnum := wbEnum([\n '',\n '',\n '',\n 'Equal To',\n '',\n 'Greater Than',\n '',\n 'Greater Than or Equal To'\n ]);\n\n wbRecord(EFSH, 'Effect Shader', [\n wbEDID,\n wbString(ICON, 'Fill Texture'),\n wbString(ICO2, 'Particle Shader Texture'),\n wbString(NAM7, 'Holes Texture'),\n wbString(NAM8, 'Membrane Palette Texture'),\n wbString(NAM9, 'Particle Palette Texture'),\n wbUnknown(DATA), // if form version < 62, ignored otherwise\n // format depends on Form Version (appear with form version 62, changed in form version 106), different for older records starting from the first field\n wbUnion(DNAM, '', wbEFSHFormatDecider, [\n wbStruct('Data', [\n wbInteger('Membrane Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Membrane Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Membrane Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbByteColors('Fill/Texture Effect - Color Key 1'),\n wbFloat('Fill/Texture Effect - Alpha Fade In Time'),\n wbFloat('Fill/Texture Effect - Full Alpha Time'),\n wbFloat('Fill/Texture Effect - Alpha Fade Out Time'),\n wbFloat('Fill/Texture Effect - Presistent Alpha Ratio'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Amplitude'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Frequency'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (U)'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (V)'),\n wbFloat('Edge Effect - Fall Off'),\n wbByteColors('Edge Effect - Color'),\n wbFloat('Edge Effect - Alpha Fade In Time'),\n wbFloat('Edge Effect - Full Alpha Time'),\n wbFloat('Edge Effect - Alpha Fade Out Time'),\n wbFloat('Edge Effect - Persistent Alpha Ratio'),\n wbFloat('Edge Effect - Alpha Pulse Amplitude'),\n wbFloat('Edge Effect - Alpha Pulse Frequency'),\n wbFloat('Fill/Texture Effect - Full Alpha Ratio'),\n wbFloat('Edge Effect - Full Alpha Ratio'),\n wbInteger('Membrane Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbFloat('Holes Animation - Start Time'),\n wbFloat('Holes Animation - End Time'),\n wbFloat('Holes Animation - Start Value'),\n wbFloat('Holes Animation - End Value'),\n wbFormIDCk('Ambient Sound', [SNDR, NULL]),\n wbByteColors('Fill/Texture Effect - Color Key 2'),\n wbByteColors('Fill/Texture Effect - Color Key 3'),\n wbInteger('Unknown', itU8),\n wbStruct('Fill/Texture Effect - Color Key Scale/Time', [\n wbFloat('Color Key 1 - Scale'),\n wbFloat('Color Key 2 - Scale'),\n wbFloat('Color Key 3 - Scale'),\n wbFloat('Color Key 1 - Time'),\n wbFloat('Color Key 2 - Time'),\n wbFloat('Color Key 3 - Time')\n ]),\n wbInteger('Flags', itU32, wbFlags([\n 'No Membrane Shader',\n 'Membrane Grayscale Color',\n 'Membrane Grayscale Alpha',\n 'No Particle Shader',\n 'Edge Effect - Inverse',\n 'Affect Skin Only',\n 'Texture Effect - Ignore Alpha',\n 'Texture Effect - Project UVs',\n 'Ignore Base Geometry Alpha',\n 'Texture Effect - Lighting',\n 'Texture Effect - No Weapons',\n 'Use Alpha Sorting',\n 'Prefer Dismembered Limbs',\n 'Unknown 13',\n 'Unknown 14',\n 'Particle Animated',\n 'Particle Grayscale Color',\n 'Particle Grayscale Alpha',\n 'Unknown 18',\n 'Unknown 19',\n 'Unknown 20',\n 'Unknown 21',\n 'Unknown 22',\n 'Unknown 23',\n 'Use Blood Geometry (Weapons Only)'\n ])),\n wbFloat('Fill/Texture Effect - Texture Scale (U)'),\n wbFloat('Fill/Texture Effect - Texture Scale (V)')\n ]),\n wbStruct('Data (old format)', [\n wbByteArray('Unknown', 1),\n wbInteger('Membrane Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Membrane Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Membrane Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbByteColors('Fill/Texture Effect - Color Key 1'),\n wbFloat('Fill/Texture Effect - Alpha Fade In Time'),\n wbFloat('Fill/Texture Effect - Full Alpha Time'),\n wbFloat('Fill/Texture Effect - Alpha Fade Out Time'),\n wbFloat('Fill/Texture Effect - Presistent Alpha Ratio'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Amplitude'),\n wbFloat('Fill/Texture Effect - Alpha Pulse Frequency'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (U)'),\n wbFloat('Fill/Texture Effect - Texture Animation Speed (V)'),\n wbFloat('Edge Effect - Fall Off'),\n wbByteColors('Edge Effect - Color'),\n wbFloat('Edge Effect - Alpha Fade In Time'),\n wbFloat('Edge Effect - Full Alpha Time'),\n wbFloat('Edge Effect - Alpha Fade Out Time'),\n wbFloat('Edge Effect - Persistent Alpha Ratio'),\n wbFloat('Edge Effect - Alpha Pulse Amplitude'),\n wbFloat('Edge Effect - Alpha Pulse Frequency'),\n wbFloat('Fill/Texture Effect - Full Alpha Ratio'),\n wbFloat('Edge Effect - Full Alpha Ratio'),\n wbInteger('Membrane Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Particle Shader - Source Blend Mode', itU32, wbBlendModeEnum),\n wbInteger('Particle Shader - Blend Operation', itU32, wbBlendOpEnum),\n wbInteger('Particle Shader - Z Test Function', itU32, wbZTestFuncEnum),\n wbInteger('Particle Shader - Dest Blend Mode', itU32, wbBlendModeEnum),\n wbFloat('Particle Shader - Particle Birth Ramp Up Time'),\n wbFloat('Particle Shader - Full Particle Birth Time'),\n wbFloat('Particle Shader - Particle Birth Ramp Down Time'),\n wbFloat('Particle Shader - Full Particle Birth Ratio'),\n wbFloat('Particle Shader - Persistant Particle Count'),\n wbFloat('Particle Shader - Particle Lifetime'),\n wbFloat('Particle Shader - Particle Lifetime +/-'),\n wbFloat('Particle Shader - Initial Speed Along Normal'),\n wbFloat('Particle Shader - Acceleration Along Normal'),\n wbFloat('Particle Shader - Initial Velocity #1'),\n wbFloat('Particle Shader - Initial Velocity #2'),\n wbFloat('Particle Shader - Initial Velocity #3'),\n wbFloat('Particle Shader - Acceleration #1'),\n wbFloat('Particle Shader - Acceleration #2'),\n wbFloat('Particle Shader - Acceleration #3'),\n wbFloat('Particle Shader - Scale Key 1'),\n wbFloat('Particle Shader - Scale Key 2'),\n wbFloat('Particle Shader - Scale Key 1 Time'),\n wbFloat('Particle Shader - Scale Key 2 Time'),\n wbByteColors('Color Key 1 - Color'),\n wbByteColors('Color Key 2 - Color'),\n wbByteColors('Color Key 3 - Color'),\n wbFloat('Color Key 1 - Color Alpha'),\n wbFloat('Color Key 2 - Color Alpha'),\n wbFloat('Color Key 3 - Color Alpha'),\n wbFloat('Color Key 1 - Color Key Time'),\n wbFloat('Color Key 2 - Color Key Time'),\n wbFloat('Color Key 3 - Color Key Time'),\n wbFloat('Particle Shader - Initial Speed Along Normal +/-'),\n wbFloat('Particle Shader - Initial Rotation (deg)'),\n wbFloat('Particle Shader - Initial Rotation (deg) +/-'),\n wbFloat('Particle Shader - Rotation Speed (deg/sec)'),\n wbFloat('Particle Shader - Rotation Speed (deg/sec) +/-'),\n wbFormIDCk('Addon Models', [DEBR, NULL]),\n wbFloat('Holes - Start Time'),\n wbFloat('Holes - End Time'),\n wbFloat('Holes - Start Val'),\n wbFloat('Holes - End Val'),\n wbFloat('Edge Width (alpha units)'),\n wbByteColors('Edge Color'),\n wbFloat('Explosion Wind Speed'),\n wbInteger('Texture Count U', itU32),\n wbInteger('Texture Count V', itU32),\n wbFloat('Addon Models - Fade In Time'),\n wbFloat('Addon Models - Fade Out Time'),\n wbFloat('Addon Models - Scale Start'),\n wbFloat('Addon Models - Scale End'),\n wbFloat('Addon Models - Scale In Time'),\n wbFloat('Addon Models - Scale Out Time'),\n wbFormIDCk('Ambient Sound', [SNDR, NULL]),\n wbByteColors('Fill/Texture Effect - Color Key 2'),\n wbByteColors('Fill/Texture Effect - Color Key 3'),\n wbStruct('Fill/Texture Effect - Color Key Scale/Time', [\n wbFloat('Color Key 1 - Scale'),\n wbFloat('Color Key 2 - Scale'),\n wbFloat('Color Key 3 - Scale'),\n wbFloat('Color Key 1 - Time'),\n wbFloat('Color Key 2 - Time'),\n wbFloat('Color Key 3 - Time')\n ]),\n wbFloat('Color Scale'),\n wbFloat('Birth Position Offset'),\n wbFloat('Birth Position Offset Range +/-'),\n wbStruct('Particle Shader Animated', [\n wbInteger('Start Frame', itU32),\n wbInteger('Start Frame Variation', itU32),\n wbInteger('End Frame', itU32),\n wbInteger('Loop Start Frame', itU32),\n wbInteger('Loop Start Variation', itU32),\n wbInteger('Frame Count', itU32),\n wbInteger('Frame Count Variation', itU32)\n ]),\n wbInteger('Flags', itU32, wbFlags([\n 'No Membrane Shader',\n 'Membrane Grayscale Color',\n 'Membrane Grayscale Alpha',\n 'No Particle Shader',\n 'Edge Effect Inverse',\n 'Affect Skin Only',\n 'Ignore Alpha',\n 'Project UVs',\n 'Ignore Base Geometry Alpha',\n 'Lighting',\n 'No Weapons',\n 'Unknown 11',\n 'Unknown 12',\n 'Unknown 13',\n 'Unknown 14',\n 'Particle Animated',\n 'Particle Grayscale Color',\n 'Particle Grayscale Alpha',\n 'Unknown 18',\n 'Unknown 19',\n 'Unknown 20',\n 'Unknown 21',\n 'Unknown 22',\n 'Unknown 23',\n 'Use Blood Geometry'\n ])),\n wbFloat('Fill/Texture Effect - Texture Scale (U)'),\n wbFloat('Fill/Texture Effect - Texture Scale (V)'),\n wbInteger('Scene Graph Emit Depth Limit (unused)', itU16)\n ])\n ], cpNormal, True),\n wbMODL\n ]);\n\n wbRecord(ENCH, 'Object Effect', [\n wbEDID,\n wbOBNDReq,\n wbFULL,\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Enchantment Cost', itS32),\n wbInteger('Flags', itU32, wbFlags([\n 'No Auto-Calc',\n '',\n 'Extend Duration On Recast'\n ])),\n wbInteger('Cast Type', itU32, wbCastEnum),\n wbInteger('Enchantment Amount', itS32),\n wbInteger('Target Type', itU32, wbTargetEnum),\n wbInteger('Enchant Type', itU32, wbEnum([], [\n $06, 'Enchantment',\n $0C, 'Staff Enchantment'\n ])),\n wbFloat('Charge Time'),\n wbFormIDCk('Base Enchantment', [ENCH, NULL]),\n wbFormIDCk('Worn Restrictions', [FLST, NULL])\n ], cpNormal, True, nil, 8),\n wbEffectsReq\n ]);\n\n {wbRecord(EYES, 'Eyes', [\n wbEDID\n ]);}\n\n wbRecord(FACT, 'Faction', [\n wbEDID,\n wbFULL,\n wbRArrayS('Relations',\n wbStructSK(XNAM, [0], 'Relation', [\n wbFormIDCkNoReach('Faction', [FACT, RACE]),\n wbInteger('Modifier', itS32),\n wbInteger('Group Combat Reaction', itU32, wbEnum([\n {0x00000001} 'Neutral',\n {0x00000002} 'Enemy',\n {0x00000004} 'Ally',\n {0x00000008} 'Friend'\n ]))\n ])),\n wbStruct(DATA, 'Flags', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Hidden From NPC',\n {0x00000002} 'Special Combat',\n {0x00000004} 'Unknown 3',\n {0x00000008} 'Unknown 4',\n {0x00000010} 'Unknown 5',\n {0x00000020} 'Unknown 6',\n {0x00000040} 'Track Crime',\n {0x00000080} 'Ignore Crimes: Murder',\n {0x00000100} 'Ignore Crimes: Assault',\n {0x00000200} 'Ignore Crimes: Stealing',\n {0x00000400} 'Ignore Crimes: Trespass',\n {0x00000800} 'Do Not Report Crimes Against Members',\n {0x00001000} 'Crime Gold - Use Defaults',\n {0x00002000} 'Ignore Crimes: Pickpocket',\n {0x00004000} 'Vendor',\n {0x00008000} 'Can Be Owner',\n {0x00010000} 'Ignore Crimes: Werewolf (unused)'\n ]))\n ], cpNormal, True, nil, 1),\n wbFormIDCk(JAIL, 'Exterior Jail Marker', [REFR]),\n wbFormIDCk(WAIT, 'Follower Wait Marker', [REFR]),\n wbFormIDCk(STOL, 'Stolen Goods Container', [REFR]),\n wbFormIDCk(PLCN, 'Player Inventory Container', [REFR]),\n wbFormIDCk(CRGR, 'Shared Crime Faction List', [FLST]),\n wbFormIDCk(JOUT, 'Jail Outfit', [OTFT]),\n wbStruct(CRVA, 'Crime Values', [\n wbInteger('Arrest', itU8, wbBoolEnum),\n wbInteger('Attack On Sight', itU8, wbBoolEnum),\n wbInteger('Murder', itU16),\n wbInteger('Assault', itU16),\n wbInteger('Trespass', itU16),\n wbInteger('Pickpocket', itU16),\n wbInteger('Unknown', itU16),\n wbFloat('Steal Multiplier'),\n wbInteger('Escape', itU16),\n wbInteger('Werewolf (unused)', itU16)\n ], cpNormal, False, nil, 7),\n wbRStructsSK('Ranks', 'Rank', [0], [\n wbInteger(RNAM, 'Rank#', itU32),\n wbLString(MNAM, 'Male Title', 0, cpTranslate),\n wbLString(FNAM, 'Female Title', 0, cpTranslate),\n wbString(INAM, 'Insignia (unused)')\n ], []),\n wbFormIDCk(VEND, 'Vendor Buy/Sell List', [FLST]),\n wbFormIDCk(VENC, 'Merchant Container', [REFR]),\n wbStruct(VENV, 'Vendor Values', [\n wbInteger('Start Hour', itU16),\n wbInteger('End Hour', itU16),\n wbInteger('Radius', itU16),\n wbByteArray('Unknown 1', 2),\n wbInteger('Buys Stolen Items', itU8, wbBoolEnum),\n wbInteger('Buy/Sell Everything Not In List?', itU8, wbBoolEnum),\n wbInteger('Buys NonStolen Items', itU8, wbBoolEnum),\n wbInteger('Unknown', itU8)\n ]),\n wbPLVD,\n wbCITC,\n wbCTDAsCount\n ], False, nil, cpNormal, False, nil {wbFACTAfterLoad}, wbConditionsAfterSet);\n\n wbRecord(FURN, 'Furniture',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Unknown 2',\n {0x00000010} 4, 'Unknown 4',\n {0x00000080} 7, 'Is Perch',\n {0x00002000} 13, 'Unknown 13',\n {0x00008000} 15, 'Has Distant LOD',\n {0x00010000} 16, 'Random Anim Start',\n {0x00800000} 23, 'Is Marker',\n {0x02000000} 25, 'Power Armor',\n {0x10000000} 28, 'Must Exit To Talk',\n {0x20000000} 29, 'Child Can Use'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbDEST,\n wbKSIZ,\n wbKWDAs,\n wbPRPS,\n wbNTRM,\n wbFTYP,\n wbUnknown(PNAM),\n wbFormIDCk(WNAM, 'Drinking Water Type', [WATR]),\n wbATTX,\n wbInteger(FNAM, 'Flags', itU16, wbFlags([\n {0x0001} 'Unknown 0',\n {0x0002} 'Ignored By Sandbox'\n ])),\n wbCITC,\n wbCTDAsCount,\n wbCOCT,\n wbCNTOs,\n wbMNAMFurnitureMarker,\n wbStruct(WBDT, 'Workbench Data', [\n wbInteger('Bench Type', itU8, wbEnum([\n {0} 'None',\n {1} 'Create Object', // used only for MS11Workbench [FURN:00091FD5]\n {2} 'Weapons', // used for the Weapons (plural) workbench\n {3} 'Enchanting (unused)', // not used\n {4} 'Enchanting Experiment (unused)', // not used\n {5} 'Alchemy', // used for Chemistry and Cooking, so Alchemy is probably okay\n {6} 'Alchemy Experiment (unused)', // not used\n {7} 'Armor', // FO4 calls this the Armor workbench, no mention of Smithing\n {8} 'Power Armor', // used for Power Armor stations\n {9} 'Robot Mod' // used for Robot stations\n ])),\n wbInteger('Uses Skill', itS8, wbSkillEnum)\n ], cpNormal, True, nil, 1),\n wbFormIDCk(NAM1, 'Associated Form', [ARMO, WEAP, PERK, SPEL, HAZD]),\n wbRArray('Markers', wbRStruct('Marker', [\n wbInteger(ENAM, 'Marker Index', itS32),\n wbStruct(NAM0, 'Disabled Entry Points', [\n wbByteArray('Unknown', 2),\n wbInteger('Disabled Points', itU16, wbFurnitureEntryTypeFlags)\n ])\n //wbFormIDCk(FNMK, 'Marker Keyword', [KYWD, NULL])\n ], [])),\n wbRArray('Marker Entry Points', wbStruct(FNPR, 'Marker', [\n wbInteger('Type', itU16, wbFurnitureAnimTypeEnum),\n wbInteger('Entry Points', itU16, wbFurnitureEntryTypeFlags)\n ])),\n wbString(XMRK, 'Marker Model'),\n wbSNAMMarkerParams,\n wbNVNM,\n wbAPPR,\n wbObjectTemplate\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n wbRecord(GLOB, 'Global',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000040} 6, 'Constant'\n ])), [\n wbEDID,\n wbInteger(FNAM, 'Type', itU8, wbEnum([], [\n 0, 'Unknown 0',\n Ord('s'), 'Short',\n Ord('l'), 'Long',\n Ord('f'), 'Float',\n Ord('b'), 'Boolean'\n ]), cpNormal, True),\n wbFloat(FLTV, 'Value', cpNormal, True)\n ]);\n\n wbRecord(GMST, 'Game Setting', [\n wbString(EDID, 'Editor ID', 0, cpCritical, True, nil, wbGMSTEDIDAfterSet),\n wbUnion(DATA, 'Value', wbGMSTUnionDecider, [\n wbLString('Name', 0, cpTranslate),\n wbInteger('Int', itS32),\n wbFloat('Float'),\n wbInteger('Bool', itU32, wbBoolEnum)\n ], cpNormal, True)\n ]);\n\n wbRecord(KYWD, 'Keyword',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00080000} {15} 15, 'Restricted'\n ])), [\n wbEDID,\n wbCNAM,\n wbString(DNAM, 'Notes'),\n wbInteger(TNAM, 'Type', itU32, wbKeywordTypeEnum),\n wbFormIDCk(DATA, 'Attraction Rule', [AORU]),\n wbFULL,\n wbString(NNAM, 'Display Name') {Legacy record replaced with FULL}\n ]);\nend;\n\nprocedure DefineFO4e;\nbegin\n wbRecord(LCRT, 'Location Reference Type', [\n wbEDID,\n wbCNAM,\n wbUnknown(TNAM)\n ]);\n\n wbRecord(AACT, 'Action',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00080000} {15} 15, 'Restricted'\n ])), [\n wbEDID,\n wbCNAM,\n wbString(DNAM, 'Notes'),\n wbInteger(TNAM, 'Type', itU32, wbKeywordTypeEnum),\n wbFormIDCk(DATA, 'Attraction Rule', [AORU]),\n wbFULL\n ]);\n\n wbRecord(TXST, 'Texture Set', [\n wbEDID,\n wbOBNDReq,\n wbRStruct('Textures (RGB/A)', [\n wbString(TX00, 'Difuse'),\n wbString(TX01, 'Normal/Gloss'),\n wbString(TX03, 'Glow'),\n wbString(TX04, 'Height'),\n wbString(TX05, 'Environment'),\n wbString(TX02, 'Wrinkles'), {TX05 TX02 TX06 Yes this has to go here}\n wbString(TX06, 'Multilayer'),\n wbString(TX07, 'Smooth Spec')\n ], []),\n wbDODT,\n wbInteger(DNAM, 'Flags', itU16, wbFlags([\n {0x0001} 'No Specular Map',\n {0x0002} 'Facegen Textures',\n {0x0004} 'Has Model Space Normal Map'\n ]), cpNormal, True),\n wbString(MNAM, 'Material')\n ]);\n\n wbRecord(HDPT, 'Head Part',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Non-Playable'\n ])), [\n wbEDID,\n wbFULL,\n wbMODL,\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n {0x01} 'Playable',\n {0x02} 'Male',\n {0x04} 'Female',\n {0x10} 'Is Extra Part',\n {0x20} 'Use Solid Tint',\n {0x40} 'Uses Body Texture'\n ]), cpNormal, True),\n wbInteger(PNAM, 'Type', itU32, wbEnum([\n 'Misc',\n 'Face',\n 'Eyes',\n 'Hair',\n 'Facial Hair',\n 'Scar',\n 'Eyebrows',\n 'Meatcaps',\n 'Teeth',\n 'Head Rear'\n ])),\n wbRArrayS('Extra Parts',\n wbFormIDCk(HNAM, 'Part', [HDPT])\n ),\n wbRStructs('Parts', 'Part', [\n wbInteger(NAM0, 'Part Type', itU32, wbEnum([\n 'Race Morph',\n 'Tri',\n 'Chargen Morph'\n ])),\n wbString(NAM1, 'Filename', 0, cpTranslate, True)\n ], []),\n wbFormIDCk(TNAM, 'Texture Set', [TXST]),\n wbFormIDCk(CNAM, 'Color', [CLFM]),\n wbFormIDCk(RNAM, 'Valid Races', [FLST]),\n wbCTDAs\n ]);\n\n wbRecord(ASPC, 'Acoustic Space', [\n wbEDID,\n wbOBNDReq,\n wbFormIDCk(SNAM, 'Looping Sound', [SNDR]),\n wbFormIDCk(RDAT, 'Use Sound from Region (Interiors Only)', [REGN]),\n wbFormIDCk(BNAM, 'Environment Type', [REVB]),\n wbInteger(XTRI, 'Is Interior', itU8, wbBoolEnum, cpNormal, True),\n wbInteger(WNAM, 'Weather Attenuation (dB)', itU16, wbDiv(100))\n ]);\n\n wbRecord(MSTT, 'Moveable Static',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000100} 8, 'Must Update Anims',\n {0x00000200} 9, 'Hidden From Local Map',\n {0x00000800} 11, 'Used As Platform',\n {0x00002000} 13, 'Pack-In Use Only',\n {0x00008000} 15, 'Has Distant LOD',\n {0x00010000} 16, 'Random Anim Start',\n {0x00080000} 19, 'Has Currents',\n {0x02000000} 25, 'Obstacle',\n {0x04000000} 26, 'NavMesh Generation - Filter',\n {0x08000000} 27, 'NavMesh Generation - Bounding Box',\n {0x40000000} 30, 'NavMesh Generation - Ground'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbDEST,\n wbKSIZ,\n wbKWDAs,\n wbPRPS,\n wbInteger(DATA, 'On Local Map', itU8, wbBoolEnum, cpNormal, True),\n wbFormIDCk(SNAM, 'Looping Sound', [SNDR])\n ]);\nend;\n\nprocedure DefineFO4f;\nbegin\n wbRecord(IDLM, 'Idle Marker',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x20000000} 29, 'Child Can Use'\n ])), [\n wbEDID,\n wbOBNDReq,\n wbKSIZ,\n wbKWDAs,\n wbInteger(IDLF, 'Flags', itU8, wbFlags([\n 'Run in Sequence',\n 'Unknown 1',\n 'Do Once',\n 'Unknown 3',\n 'Ignored by Sandbox'\n ]), cpNormal, False),\n wbInteger(IDLC, 'Animation Count', itU8, nil, cpBenign),\n wbFloat(IDLT, 'Idle Timer Setting', cpNormal, False),\n wbArray(IDLA, 'Animations', wbFormIDCk('Animation', [IDLE]), 0, nil, wbIDLAsAfterSet, cpNormal, False),\n wbFormIDCk(QNAM, 'Unknown', [KYWD]),\n wbMODL\n ], False, nil, cpNormal, False, nil, wbAnimationsAfterSet);\n\n wbRecord(PROJ, 'Projectile', [\n wbEDID,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbDEST,\n wbByteArray(DATA, 'Unused', 0, cpIgnore),\n wbStruct(DNAM, 'Data', [\n wbInteger('Flags', itU16, wbFlags([\n {0x00001} 'Hitscan',\n {0x00002} 'Explosion',\n {0x00004} 'Alt. Trigger',\n {0x00008} 'Muzzle Flash',\n {0x00010} 'Unknown 4',\n {0x00020} 'Can Be Disabled',\n {0x00040} 'Can Be Picked Up',\n {0x00080} 'Supersonic',\n {0x00100} 'Pins Limbs',\n {0x00200} 'Pass Through Small Transparent',\n {0x00400} 'Disable Combat Aim Correction',\n {0x00800} 'Penetrates Geometry',\n {0x01000} 'Continuous Update',\n {0x02000} 'Seeks Target'\n ])),\n wbInteger('Type', itU16, wbEnum([], [\n $01, 'Missile',\n $02, 'Lobber',\n $04, 'Beam',\n $08, 'Flame',\n $10, 'Cone',\n $20, 'Barrier',\n $40, 'Arrow'\n ])),\n wbFloat('Gravity'),\n wbFloat('Speed'),\n wbFloat('Range'),\n wbFormIDCk('Light', [LIGH, NULL]),\n wbFormIDCk('Muzzle Flash - Light', [LIGH, NULL]),\n wbFloat('Explosion - Alt. Trigger - Proximity'),\n wbFloat('Explosion - Alt. Trigger - Timer'),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbFormIDCk('Sound', [SNDR, NULL]),\n wbFloat('Muzzle Flash - Duration'),\n wbFloat('Fade Duration'),\n wbFloat('Impact Force'),\n wbFormIDCk('Sound - Countdown', [SNDR, NULL]),\n wbFormIDCk('Sound - Disable', [SNDR, NULL]),\n wbFormIDCk('Default Weapon Source', [WEAP, NULL]),\n wbFloat('Cone Spread'),\n wbFloat('Collision Radius'),\n wbFloat('Lifetime'),\n wbFloat('Relaunch Interval'),\n wbFormIDCk('Decal Data', [TXST, NULL]),\n wbFormIDCk('Collision Layer', [COLL, NULL]),\n wbInteger('Tracer Frequency', itU8),\n wbFormIDCk('VATS Projectile', [PROJ, NULL])\n ]),\n wbRStructSK([0], 'Muzzle Flash Model', [\n wbString(NAM1, 'Model Filename'),\n wbByteArray(NAM2, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow)\n ], [], cpNormal, True),\n wbInteger(VNAM, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True)\n ]);\n\n wbRecord(HAZD, 'Hazard', [\n wbEDID,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD, NULL]),\n wbStruct(DNAM, 'Data', [\n wbInteger('Limit', itU32),\n wbFloat('Radius'),\n wbFloat('Lifetime'),\n wbFloat('Image Space Radius'),\n wbFloat('Target Interval'),\n wbInteger('Flags', itU32, wbFlags([\n {0x01} 'Affects Player Only',\n {0x02} 'Inherit Duration from Spawn Spell',\n {0x04} 'Align to Impact Normal',\n {0x08} 'Inherit Radius from Spawn Spell',\n {0x10} 'Drop to Ground',\n {0x20} 'Taper Effectiveness by Proximity'\n ])),\n wbFormIDCk('Effect', [SPEL, ENCH, NULL]),\n wbFormIDCk('Light', [LIGH, NULL]),\n wbFormIDCk('Impact Data Set', [IPDS, NULL]),\n wbFormIDCk('Sound', [SNDR, NULL]),\n wbStruct('Taper Effectiveness', [\n wbFloat('Full Effect Radius'),\n wbFloat('Taper Weight'),\n wbFloat('Taper Curse')\n ])\n ])\n ]);\n\n wbSoulGemEnum := wbEnum([\n {0} 'None',\n {1} 'Petty',\n {2} 'Lesser',\n {3} 'Common',\n {4} 'Greater',\n {5} 'Grand'\n ]);\n\n {wbRecord(SLGM, 'Soul Gem', [\n wbEDID\n ]);}\n\n if wbSimpleRecords then begin\n\n wbRecord(NAVI, 'Navigation Mesh Info Map', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbRArray('Navigation Map Infos',\n wbStruct(NVMI, 'Navigation Map Info', [\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbByteArray('Data', 20),\n wbArray('Merged To', wbFormIDCk('Mesh', [NAVM]), -1),\n wbArray('Preferred Merges', wbFormIDCk('Mesh', [NAVM]), -1),\n wbArray('Linked Doors', wbStruct('Door', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Door Ref', [REFR])\n ]), -1),\n wbInteger('Is Island', itU8, wbBoolEnum),\n wbUnion('Island', wbNAVIIslandDataDecider, [\n wbNull,\n wbStruct('Island Data', [\n wbByteArray('Unknown', 24),\n wbArray('Triangles', wbByteArray('Triangle', 6), -1),\n wbArray('Vertices', wbByteArray('Vertex', 12), -1)\n ])\n ]),\n wbByteArray('Unknown', 4),\n wbFormIDCk('Parent Worldspace', [WRLD, NULL]),\n wbUnion('Parent', wbNAVIParentDecider, [\n wbStruct('Coordinates', [\n wbInteger('Grid Y', itS16),\n wbInteger('Grid X', itS16)\n ]),\n wbFormIDCk('Parent Cell', [CELL])\n ])\n ])\n ),\n wbStruct(NVPP, 'Preferred Pathing', [\n wbArray('NavMeshes', wbArray('Set', wbFormIDCk('', [NAVM]), -1), -1),\n wbArray('NavMesh Tree?', wbStruct('', [\n wbFormIDCk('NavMesh', [NAVM]),\n wbInteger('Index/Node', itU32)\n ]), -1)\n ]),\n //wbArray(NVSI, 'Unknown', wbFormIDCk('Navigation Mesh', [NAVM]))\n wbUnknown(NVSI)\n ]);\n\n wbRecord(NAVM, 'Navigation Mesh',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00040000} 18, 'Compressed',\n {0x04000000} 26, 'AutoGen',\n {0x80000000} 31, 'Unknown 31'\n ]), [18]), [\n wbEDID,\n wbNVNM,\n// wbStruct(NVNM, 'Geometry', [\n// wbByteArray('Unknown', 8),\n// wbFormIDCk('Parent Worldspace', [WRLD, NULL]),\n// wbUnion('Parent', wbNVNMParentDecider, [\n// wbStruct('Coordinates', [\n// wbInteger('Grid Y', itS16),\n// wbInteger('Grid X', itS16)\n// ]),\n// wbFormIDCk('Parent Cell', [CELL])\n// ]),\n// wbArray('Vertices', wbByteArray('Vertex', 12), -1),\n// wbArray('Triangles', wbByteArray('Triangle', 21), -1),\n// wbArray('Edge Links',\n// wbStruct('Edge Link', [\n// wbByteArray('Unknown', 4),\n// wbFormIDCk('Mesh', [NAVM]),\n// wbInteger('Triangle', itS16),\n// wbInteger('Unknown', itU8)\n// ])\n// , -1),\n// wbArray('Door Triangles',\n// wbStruct('Door Triangle', [\n// wbInteger('Triangle before door', itS16),\n// wbByteArray('Unknown', 4),\n// wbFormIDCk('Door', [REFR])\n// ])\n// , -1),\n// wbUnknown\n// ]),\n wbUnknown(ONAM),\n wbUnknown(NNAM),\n wbUnknown(MNAM)\n ], False, wbNAVMAddInfo);\n\n end else begin\n\n wbRecord(NAVI, 'Navigation Mesh Info Map', [\n wbEDID,\n wbInteger(NVER, 'Version', itU32),\n wbRArray('Navigation Map Infos',\n wbStruct(NVMI, 'Navigation Map Info', [\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbByteArray('Unknown', 4),\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z'),\n wbInteger('Preferred Merges Flag', itU32),\n wbArray('Merged To', wbFormIDCk('Mesh', [NAVM]), -1),\n wbArray('Preferred Merges', wbFormIDCk('Mesh', [NAVM]), -1),\n wbArray('Linked Doors', wbStruct('Door', [\n wbByteArray('Unknown', 4),\n wbFormIDCk('Door Ref', [REFR])\n ]), -1),\n wbInteger('Is Island', itU8, wbBoolEnum),\n wbUnion('Island', wbNAVIIslandDataDecider, [\n wbNull,\n wbStruct('Island Data', [\n wbFloat('Min X'),\n wbFloat('Min Y'),\n wbFloat('Min Z'),\n wbFloat('Max X'),\n wbFloat('Max Y'),\n wbFloat('Max Z'),\n wbArray('Triangles',\n wbStruct('Triangle', [\n wbArray('Vertices', wbInteger('Vertex', itS16), 3)\n ])\n , -1),\n wbArray('Vertices', wbStruct('Vertex', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]), -1)\n ])\n ]),\n wbByteArray('Unknown', 4),\n wbFormIDCk('Parent Worldspace', [WRLD, NULL]),\n wbUnion('Parent', wbNAVIParentDecider, [\n wbStruct('Coordinates', [\n wbInteger('Grid Y', itS16),\n wbInteger('Grid X', itS16)\n ]),\n wbFormIDCk('Parent Cell', [CELL])\n ])\n ])\n ),\n wbStruct(NVPP, 'Preferred Pathing', [\n wbArray('NavMeshes', wbArray('Set', wbFormIDCk('', [NAVM]), -1), -1),\n wbArray('NavMesh Tree?', wbStruct('', [\n wbFormIDCk('NavMesh', [NAVM]),\n wbInteger('Index/Node', itU32)\n ]), -1)\n ]),\n wbArray(NVSI, 'Unknown', wbFormIDCk('Navigation Mesh', [NAVM]))\n ]);\n\n wbRecord(NAVM, 'Navigation Mesh',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00040000} 18, 'Compressed',\n {0x04000000} 26, 'AutoGen'\n ]), [18]), [\n wbEDID,\n wbNVNM,\n// wbStruct(NVNM, 'Geometry', [\n// wbInteger('Unknown', itU32),\n// wbByteArray('Unknown', 4),\n// wbFormIDCk('Parent Worldspace', [WRLD, NULL]),\n// wbUnion('Parent', wbNVNMParentDecider, [\n// wbStruct('Coordinates', [\n// wbInteger('Grid Y', itS16),\n// wbInteger('Grid X', itS16)\n// ]),\n// wbFormIDCk('Parent Cell', [CELL])\n// ]),\n// wbArray('Vertices', wbStruct('Vertex', [\n// wbFloat('X'),\n// wbFloat('Y'),\n// wbFloat('Z')\n// ]), -1),\n// wbArray('Triangles',\n// wbStruct('Triangle', [\n// wbInteger('Vertex 0', itS16),\n// wbInteger('Vertex 1', itS16),\n// wbInteger('Vertex 2', itS16),\n// wbInteger('Edge 0-1', itS16),\n// wbInteger('Edge 1-2', itS16),\n// wbInteger('Edge 2-0', itS16),\n// wbFloat('Height'),\n// wbByteArray('Unknown', 5)\n// ])\n// , -1),\n// wbArray('Edge Links',\n// wbStruct('Edge Link', [\n// wbByteArray('Unknown', 4),\n// wbFormIDCk('Mesh', [NAVM]),\n// wbInteger('Triangle', itS16),\n// wbInteger('Unknown', itU8)\n// ])\n// , -1),\n// wbArray('Door Triangles',\n// wbStruct('Door Triangle', [\n// wbInteger('Triangle before door', itS16),\n// wbByteArray('Unknown', 4),\n// wbFormIDCk('Door', [REFR])\n// ])\n// , -1),\n// wbUnknown\n// ]),\n wbFormID(ONAM),\n wbArray(NNAM, 'Unknown', wbInteger('Unknown', itU16)),\n wbUnion(MNAM, 'Unknown', wbSubrecordSizeDecider, [wbNull,\n wbStruct('Unknown', [\n wbFormID('Unknown'),\n wbInteger('Unknown', itU16),\n wbInteger('Unused', itU16),\n wbUnknown\n ])\n ])\n ], False, wbNAVMAddInfo);\n\n end;\n\nend;\n\nprocedure DefineFO4g;\nbegin\n\n wbRecord(EXPL, 'Explosion', [\n wbEDID,\n wbOBNDReq,\n wbFULL,\n wbMODL,\n wbEITM,\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD]),\n wbStruct(DATA, 'Data', [\n wbFormIDCk('Light', [LIGH, NULL]),\n wbFormIDCk('Sound 1', [SNDR, NULL]),\n wbFormIDCk('Sound 2', [SNDR, NULL]),\n wbFormIDCk('Impact Data Set', [IPDS, NULL]),\n wbFormID('Placed Object'),\n wbFormIDCk('Spawn Projectile', [PROJ, NULL]),\n wbFloat('Force'),\n wbFloat('Damage'),\n wbFloat('Inner Radius'),\n wbFloat('Outer Radius'),\n wbFloat('IS Radius'),\n wbUnion('Vertical Offset Mult', wbDeciderFormVersion99, [\n wbByteArray('Unknown', 4),\n wbFloat('Vertical Offset Mult')\n ]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Unknown 0',\n {0x00000002} 'Always Uses World Orientation',\n {0x00000004} 'Knock Down - Always',\n {0x00000008} 'Knock Down - By Formula',\n {0x00000010} 'Ignore LOS Check',\n {0x00000020} 'Push Explosion Source Ref Only',\n {0x00000040} 'Ignore Image Space Swap',\n {0x00000080} 'Chain',\n {0x00000100} 'No Controller Vibration',\n {0x00000200} 'Placed Object Persists',\n {0x00000400} 'Skip Underwater Tests'\n ])),\n wbInteger('Sound Level', itU32, wbSoundLevelEnum),\n wbFloat('Placed Object AutoFade Delay'),\n wbInteger('Stagger', itU32, wbEnum([\n 'None',\n 'Small',\n 'Medium',\n 'Large',\n 'Extra Large'\n ])),\n wbStruct('Spawn', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z'),\n wbFloat('Spread Degrees'),\n wbInteger('Count', itU32)\n ])\n ], cpNormal, True, nil, 13)\n ]);\n\n wbRecord(DEBR, 'Debris', [\n wbEDID,\n wbRStructs('Models', 'Model', [\n wbStruct(DATA, 'Data', [\n wbInteger('Percentage', itU8),\n wbString('Model Filename'),\n wbInteger('Flags', itU8, wbFlags([\n 'Has Collision Data'\n ]))\n ], cpNormal, True),\n wbMODT\n ], [], cpNormal, True)\n ]);\n\n wbRecord(IMGS, 'Image Space', [\n wbEDID,\n wbByteArray(ENAM, 'Unused', 0, cpIgnore),\n wbStruct(HNAM, 'HDR', [\n wbFloat('Eye Adapt Speed'),\n wbFloat('Tonemap E'),\n wbFloat('Bloom Threshold'),\n wbFloat('Bloom Scale'),\n wbFloat('Auto Exposure Max'),\n wbFloat('Auto Exposure Min'),\n wbFloat('Sunlight Scale'),\n wbFloat('Sky Scale'),\n wbFloat('Middle Gray')\n ], cpNormal, True),\n wbStruct(CNAM, 'Cinematic', [\n wbFloat('Saturation'),\n wbFloat('Brightness'),\n wbFloat('Contrast')\n ], cpNormal, True),\n wbStruct(TNAM, 'Tint', [\n wbFloat('Amount'),\n wbFloatColors('Color')\n ], cpNormal, True),\n wbStruct(DNAM, 'Depth of Field', [\n wbFloat('Strength'),\n wbFloat('Distance'),\n wbFloat('Range'),\n wbByteArray('Unused', 2, cpIgnore),\n wbInteger('Sky / Blur Radius', itU16, wbEnum([], [\n 16384, 'Radius 0',\n 16672, 'Radius 1',\n 16784, 'Radius 2',\n 16848, 'Radius 3',\n 16904, 'Radius 4',\n 16936, 'Radius 5',\n 16968, 'Radius 6',\n 17000, 'Radius 7',\n 16576, 'No Sky, Radius 0',\n 16736, 'No Sky, Radius 1',\n 16816, 'No Sky, Radius 2',\n 16880, 'No Sky, Radius 3',\n 16920, 'No Sky, Radius 4',\n 16952, 'No Sky, Radius 5',\n 16984, 'No Sky, Radius 6',\n 17016, 'No Sky, Radius 7'\n ])),\n wbFloat('Vignette Radius'),\n wbFloat('Vignette Strength')\n ], cpNormal, True, nil, 5),\n wbString(TX00, 'LUT')\n ]);\n\n wbTimeInterpolator := wbStruct('Data', [\n wbFloat('Time'),\n wbFloat('Value')\n ]);\n\n wbColorInterpolator := wbStruct('Data', [\n wbFloat('Time'),\n wbFloat('Red', cpNormal, False, 255, 0),\n wbFloat('Green', cpNormal, False, 255, 0),\n wbFloat('Blue', cpNormal, False, 255, 0),\n wbFloat('Alpha', cpNormal, False, 255, 0)\n ]);\n\n wbRecord(IMAD, 'Image Space Adapter', [\n wbEDID,\n wbStruct(DNAM, 'Data Count', [\n wbInteger('Flags', itU32, wbFlags(['Animatable'])),\n wbFloat('Duration'),\n wbStruct('HDR', [\n wbInteger('Eye Adapt Speed Mult', itU32),\n wbInteger('Eye Adapt Speed Add', itU32),\n wbInteger('Bloom Blur Radius Mult', itU32),\n wbInteger('Bloom Blur Radius Add', itU32),\n wbInteger('Bloom Threshold Mult', itU32),\n wbInteger('Bloom Threshold Add', itU32),\n wbInteger('Bloom Scale Mult', itU32),\n wbInteger('Bloom Scale Add', itU32),\n wbInteger('Target Lum Min Mult', itU32),\n wbInteger('Target Lum Min Add', itU32),\n wbInteger('Target Lum Max Mult', itU32),\n wbInteger('Target Lum Max Add', itU32),\n wbInteger('Sunlight Scale Mult', itU32),\n wbInteger('Sunlight Scale Add', itU32),\n wbInteger('Sky Scale Mult', itU32),\n wbInteger('Sky Scale Add', itU32)\n ]),\n wbInteger('Unknown08 Mult', itU32),\n wbInteger('Unknown48 Add', itU32),\n wbInteger('Unknown09 Mult', itU32),\n wbInteger('Unknown49 Add', itU32),\n wbInteger('Unknown0A Mult', itU32),\n wbInteger('Unknown4A Add', itU32),\n wbInteger('Unknown0B Mult', itU32),\n wbInteger('Unknown4B Add', itU32),\n wbInteger('Unknown0C Mult', itU32),\n wbInteger('Unknown4C Add', itU32),\n wbInteger('Unknown0D Mult', itU32),\n wbInteger('Unknown4D Add', itU32),\n wbInteger('Unknown0E Mult', itU32),\n wbInteger('Unknown4E Add', itU32),\n wbInteger('Unknown0F Mult', itU32),\n wbInteger('Unknown4F Add', itU32),\n wbInteger('Unknown10 Mult', itU32),\n wbInteger('Unknown50 Add', itU32),\n wbStruct('Cinematic', [\n wbInteger('Saturation Mult', itU32),\n wbInteger('Saturation Add', itU32),\n wbInteger('Brightness Mult', itU32),\n wbInteger('Brightness Add', itU32),\n wbInteger('Contrast Mult', itU32),\n wbInteger('Contrast Add', itU32)\n ]),\n wbInteger('Unknown14 Mult', itU32),\n wbInteger('Unknown54 Add', itU32),\n wbInteger('Tint Color', itU32),\n wbInteger('Blur Radius', itU32),\n wbInteger('Double Vision Strength', itU32),\n wbInteger('Radial Blur Strength', itU32),\n wbInteger('Radial Blur Ramp Up', itU32),\n wbInteger('Radial Blur Start', itU32),\n wbInteger('Radial Blur Flags', itU32, wbFlags(['Use Target'])),\n wbFloat('Radial Blur Center X'),\n wbFloat('Radial Blur Center Y'),\n wbInteger('DoF Strength', itU32),\n wbInteger('DoF Distance', itU32),\n wbInteger('DoF Range', itU32),\n wbInteger('DoF Flags', itU32, wbFlags([\n {0x00000001} 'Use Target',\n {0x00000002} 'Unknown 2',\n {0x00000004} 'Unknown 3',\n {0x00000008} 'Unknown 4',\n {0x00000010} 'Unknown 5',\n {0x00000020} 'Unknown 6',\n {0x00000040} 'Unknown 7',\n {0x00000080} 'Unknown 8',\n {0x00000100} 'Mode - Front',\n {0x00000200} 'Mode - Back',\n {0x00000400} 'No Sky',\n {0x00000800} 'Blur Radius Bit 2',\n {0x00001000} 'Blur Radius Bit 1',\n {0x00002000} 'Blur Radius Bit 0'\n ])),\n wbInteger('Radial Blur Ramp Down', itU32),\n wbInteger('Radial Blur Down Start', itU32),\n wbInteger('Fade Color', itU32),\n wbInteger('Motion Blur Strength', itU32),\n wbUnknown\n ]),\n wbArray(BNAM, 'Blur Radius', wbTimeInterpolator),\n wbArray(VNAM, 'Double Vision Strength', wbTimeInterpolator),\n wbArray(TNAM, 'Tint Color', wbColorInterpolator),\n wbArray(NAM3, 'Fade Color', wbColorInterpolator),\n wbRStruct('Radial Blur', [\n wbArray(RNAM, 'Strength', wbTimeInterpolator),\n wbArray(SNAM, 'RampUp', wbTimeInterpolator),\n wbArray(UNAM, 'Start', wbTimeInterpolator),\n wbArray(NAM1, 'RampDown', wbTimeInterpolator),\n wbArray(NAM2, 'DownStart', wbTimeInterpolator)\n ], []),\n wbRStruct('Depth of Field', [\n wbArray(WNAM, 'Strength', wbTimeInterpolator),\n wbArray(XNAM, 'Distance', wbTimeInterpolator),\n wbArray(YNAM, 'Range', wbTimeInterpolator),\n wbArray(NAM5, 'Vignette Radius', wbTimeInterpolator),\n wbArray(NAM6, 'Vignette Strength', wbTimeInterpolator)\n ], []),\n wbArray(NAM4, 'Motion Blur Strength', wbTimeInterpolator),\n wbRStruct('HDR', [\n wbArray(_00_IAD, 'Eye Adapt Speed Mult', wbTimeInterpolator),\n wbArray(_40_IAD, 'Eye Adapt Speed Add', wbTimeInterpolator),\n wbArray(_01_IAD, 'Bloom Blur Radius Mult', wbTimeInterpolator),\n wbArray(_41_IAD, 'Bloom Blur Radius Add', wbTimeInterpolator),\n wbArray(_02_IAD, 'Bloom Threshold Mult', wbTimeInterpolator),\n wbArray(_42_IAD, 'Bloom Threshold Add', wbTimeInterpolator),\n wbArray(_03_IAD, 'Bloom Scale Mult', wbTimeInterpolator),\n wbArray(_43_IAD, 'Bloom Scale Add', wbTimeInterpolator),\n wbArray(_04_IAD, 'Target Lum Min Mult', wbTimeInterpolator),\n wbArray(_44_IAD, 'Target Lum Min Add', wbTimeInterpolator),\n wbArray(_05_IAD, 'Target Lum Max Mult', wbTimeInterpolator),\n wbArray(_45_IAD, 'Target Lum Max Add', wbTimeInterpolator),\n wbArray(_06_IAD, 'Sunlight Scale Mult', wbTimeInterpolator),\n wbArray(_46_IAD, 'Sunlight Scale Add', wbTimeInterpolator),\n wbArray(_07_IAD, 'Sky Scale Mult', wbTimeInterpolator),\n wbArray(_47_IAD, 'Sky Scale Add', wbTimeInterpolator)\n ], []),\n wbUnknown(_08_IAD),\n wbUnknown(_48_IAD),\n wbUnknown(_09_IAD),\n wbUnknown(_49_IAD),\n wbUnknown(_0A_IAD),\n wbUnknown(_4A_IAD),\n wbUnknown(_0B_IAD),\n wbUnknown(_4B_IAD),\n wbUnknown(_0C_IAD),\n wbUnknown(_4C_IAD),\n wbUnknown(_0D_IAD),\n wbUnknown(_4D_IAD),\n wbUnknown(_0E_IAD),\n wbUnknown(_4E_IAD),\n wbUnknown(_0F_IAD),\n wbUnknown(_4F_IAD),\n wbUnknown(_10_IAD),\n wbUnknown(_50_IAD),\n wbRStruct('Cinematic', [\n wbArray(_11_IAD, 'Saturation Mult', wbTimeInterpolator),\n wbArray(_51_IAD, 'Saturation Add', wbTimeInterpolator),\n wbArray(_12_IAD, 'Brightness Mult', wbTimeInterpolator),\n wbArray(_52_IAD, 'Brightness Add', wbTimeInterpolator),\n wbArray(_13_IAD, 'Contrast Mult', wbTimeInterpolator),\n wbArray(_53_IAD, 'Contrast Add', wbTimeInterpolator)\n ], []),\n wbUnknown(_14_IAD),\n wbUnknown(_54_IAD)\n ]);\n\n wbRecord(FLST, 'FormID List', [\n wbString(EDID, 'Editor ID', 0, cpBenign, True, nil, wbFLSTEDIDAfterSet),\n wbFULL,\n wbRArrayS('FormIDs', wbFormID(LNAM, 'FormID'), cpNormal, False, nil, nil, nil, wbFLSTLNAMIsSorted)\n ]);\n\n wbRecord(PERK, 'Perk',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Non-Playable'\n ])), [\n wbEDID,\n wbVMADFragmentedPERK,\n wbFULL,\n wbDESCReq,\n wbString(ICON, 'Image'),\n wbCTDAs,\n wbStruct(DATA, 'Data', [\n wbInteger('Trait', itU8, wbBoolEnum),\n wbInteger('Level', itU8),\n wbInteger('Num Ranks', itU8),\n wbInteger('Playable', itU8, wbBoolEnum),\n wbInteger('Hidden', itU8, wbBoolEnum)\n ], cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SNDR]),\n wbFormIDCK(NNAM, 'Next Perk', [PERK, NULL]),\n wbString(FNAM, 'SWF'),\n\n wbRStructsSK('Effects', 'Effect', [0, 1], [\n wbStructSK(PRKE, [1, 2, 0], 'Header', [\n wbInteger('Type', itU8, wbEnum([\n 'Quest + Stage',\n 'Ability',\n 'Entry Point'\n ]), cpNormal, False, nil, wbPERKPRKETypeAfterSet),\n wbInteger('Rank', itU8),\n wbInteger('Priority', itU8)\n ]),\n wbUnion(DATA, 'Effect Data', wbPerkDATADecider, [\n wbStructSK([0, 1], 'Quest + Stage', [\n wbFormIDCk('Quest', [QUST]),\n wbInteger('Quest Stage', itU16, wbPerkDATAQuestStageToStr, wbCTDAParam2QuestStageToInt),\n wbByteArray('Unused', 2)\n ]),\n wbFormIDCk('Ability', [SPEL]),\n wbStructSK([0, 1], 'Entry Point', [\n wbInteger('Entry Point', itU8, wbEntryPointsEnum, cpNormal, True, nil{, wbPERKEntryPointAfterSet}),\n wbInteger('Function', itU8, wbEnum([\n {0} 'Unknown 0',\n {1} 'Set Value', // EPFT=1\n {2} 'Add Value', // EPFT=1\n {3} 'Multiply Value', // EPFT=1\n {4} 'Add Range To Value', // EPFT=2\n {5} 'Add Actor Value Mult', // EPFT=2\n {6} 'Absolute Value', // no params\n {7} 'Negative Absolute Value', // no params\n {8} 'Add Leveled List', // EPFT=3\n {9} 'Add Activate Choice', // EPFT=4\n {10} 'Select Spell', // EPFT=5\n {11} 'Select Text', // EPFT=6\n {12} 'Set to Actor Value Mult', // EPFT=2\n {13} 'Multiply Actor Value Mult', // EPFT=2\n {14} 'Multiply 1 + Actor Value Mult', // EPFT=2\n {15} 'Set Text' // EPFT=7\n ])),\n wbInteger('Perk Condition Tab Count', itU8, nil, cpIgnore)\n ])\n ], cpNormal, True),\n\n wbRStructsSK('Perk Conditions', 'Perk Condition', [0], [\n wbInteger(PRKC, 'Run On (Tab Index)', itS8{, wbPRKCToStr, wbPRKCToInt}),\n wbCTDAsReq\n ], [], cpNormal, False{, nil, nil, wbPERKPRKCDontShow}),\n\n wbRStruct('Function Parameters', [\n wbInteger(EPFT, 'Type', itU8, wbEnum([\n {0} 'None',\n {1} 'Float',\n {2} 'Float/AV,Float',\n {3} 'LVLI',\n {4} 'SPEL,lstring,flags',\n {5} 'SPEL',\n {6} 'string',\n {7} 'lstring',\n {8} 'AVIF'\n ])),\n // case(EPFT) of\n // 1: EPFD=float\n // 2: EPFD=float,float\n // 3: EPFD=LVLI\n // 4: EPFD=SPEL, EPF2=lstring, EPF3=int32 flags\n // 5: EPFD=SPEL\n // 6: EPFD=string\n // 7: EPFD=lstring\n\n wbInteger(EPFB, 'Perk Entry ID (unique)', itU16),\n wbLString(EPF2, 'Button Label', 0, cpTranslate),\n wbStruct(EPF3, 'Script Flags', [\n wbInteger('Script Flags', itU8, wbFlags([\n 'Run Immediately',\n 'Replace Default'\n ])),\n wbByteArray('Unknown', 1)\n ]),\n wbUnion(EPFD, 'Data', wbEPFDDecider, [\n {0} wbByteArray('Unknown'),\n {1} wbFloat('Float'),\n {2} wbStruct('Float, Float', [\n wbFloat('Float 1'),\n wbFloat('Float 2')\n ]),\n {3} wbFormIDCk('Leveled Item', [LVLI]),\n {4} wbFormIDCk('Spell', [SPEL]),\n {5} wbFormIDCk('Spell', [SPEL]),\n {6} wbString('Text', 0, cpTranslate),\n {7} wbLString('Text', 0, cpTranslate),\n {8} wbStruct('Actor Value, Float', [\n wbActorValue, // wbInteger('Actor Value', itU32, wbEPFDActorValueToStr, wbEPFDActorValueToInt),\n wbFloat('Float')\n ])\n ], cpNormal, False{, wbEPFDDontShow})\n ], [], cpNormal, False{, wbPERKPRKCDontShow}),\n wbEmpty(PRKF, 'End Marker', cpIgnore, True)\n ], [])\n ]);\n\n wbRecord(BPTD, 'Body Part Data', [\n wbEDID,\n wbMODL,\n wbRArrayS('Body Parts',\n wbRStructSK([1], 'Body Part', [\n wbLString(BPTN, 'Part Name', 0, cpTranslate), // optional\n wbString(BPNN, 'Part Node', 0, cpNormal, True),\n wbString(BPNT, 'VATS Target', 0, cpNormal, True),\n wbStruct(BPND, '', [\n wbFloat('Damage Mult'),\n wbFormIDCk('Explodable - Debris', [DEBR, NULL]),\n wbFormIDCk('Explodable - Explosion', [EXPL, NULL]),\n wbFloat('Explodable - Debris Scale'),\n wbFormIDCk('Severable - Debris', [DEBR, NULL]),\n wbFormIDCk('Severable - Explosion', [EXPL, NULL]),\n wbFloat('Severable - Debris Scale'),\n wbFloat('Cut - Min'),\n wbFloat('Cut - Max'),\n wbFloat('Cut - Radius'),\n wbFloat('Gore Effects - Local Rotate X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Gore Effects - Local Rotate Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Cut - Tesselation'),\n wbFormIDCk('Severable - Impact DataSet', [IPDS, NULL]),\n wbFormIDCk('Explodable - Impact DataSet', [IPDS, NULL]),\n wbFloat('Explodable - Limb Replacement Scale'),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Severable',\n {0x02} 'Hit Reaction',\n {0x04} 'Hit Reaction - Default',\n {0x08} 'Explodable',\n {0x10} 'Cut - Meat Cap Sever',\n {0x20} 'On Cripple',\n {0x40} 'Explodable - Absolute Chance',\n {0x80} 'Show Cripple Geometry'\n ])),\n wbInteger('Part Type', itU8, wbEnum([\n { 0} 'Torso',\n { 1} 'Head1',\n { 2} 'Eye',\n { 3} 'LookAt',\n { 4} 'Fly Grab',\n { 5} 'Head2',\n { 6} 'LeftArm1',\n { 7} 'LeftArm2',\n { 8} 'RightArm1',\n { 9} 'RightArm2',\n {10} 'LeftLeg1',\n {11} 'LeftLeg2',\n {12} 'LeftLeg3',\n {13} 'RightLeg1',\n {14} 'RightLeg2',\n {15} 'RightLeg3',\n {16} 'Brain',\n {17} 'Weapon',\n {18} 'Root',\n {19} 'COM',\n {20} 'Pelvis',\n {21} 'Camera',\n {22} 'Offset Root',\n {23} 'Left Foot',\n {24} 'Right Foot',\n {25} 'Face Target Source'\n ])),\n wbInteger('Health Percent', itU8),\n wbFormIDCk('Actor Value', [AVIF, NULL]),\n wbInteger('To Hit Chance', itU8),\n wbInteger('Explodable - Explosion Chance %', itU8),\n wbInteger('Non-Lethal Dismemberment Chance', itU8),\n wbInteger('Severable - Debris Count', itU8),\n wbInteger('Explodable - Debris Count', itU8),\n wbInteger('Severable - Decal Count', itU8),\n wbInteger('Explodable - Decal Count', itU8),\n wbInteger('Geometry Segment Index', itU8),\n wbFormIDCk('On Cripple - Art Object', [ARTO, NULL]),\n wbFormIDCk('On Cripple - Debris', [DEBR, NULL]),\n wbFormIDCk('On Cripple - Explosion', [EXPL, NULL]),\n wbFormIDCk('On Cripple - Impact DataSet', [IPDS, NULL]),\n wbFloat('On Cripple - Debris Scale'),\n wbInteger('On Cripple - Debris Count', itU8),\n wbInteger('On Cripple - Decal Count', itU8)\n ], cpNormal, True),\n wbString(NAM1, 'Limb Replacement Model', 0, cpNormal, True),\n wbString(NAM4, 'Gore Effects - Target Bone', 0, cpNormal, True),\n wbByteArray(NAM5, 'Texture Files Hashes', 0, cpNormal),\n wbString(ENAM, 'Hit Reaction - Start'),\n wbString(FNAM, 'Hit Reaction - End'),\n wbFormIDCk(BNAM, 'Gore Effects - Dismember Blood Art', [ARTO]),\n wbFormIDCk(INAM, 'Gore Effects - Blood Impact Material Type', [MATT]),\n wbFormIDCk(JNAM, 'On Cripple - Blood Impact Material Type', [MATT]),\n wbFormIDCk(CNAM, 'Meat Cap TextureSet', [TXST]),\n wbFormIDCk(NAM2, 'Collar TextureSet', [TXST]),\n wbString(DNAM, 'Twist Variable Prefix')\n ], [], cpNormal, False, nil, True)\n )\n ]);\n\n wbRecord(ADDN, 'Addon Node', [\n wbEDID,\n wbOBNDReq,\n wbMODL,\n wbInteger(DATA, 'Node Index', itS32, nil, cpNormal, True),\n wbFormIDCk(SNAM, 'Sound', [SNDR]),\n wbFormIDCk(LNAM, 'Light', [LIGH]),\n wbStruct(DNAM, 'Data', [\n wbInteger('Master Particle System Cap', itU16),\n wbInteger('Flags', itU16, wbEnum([\n 'No Master Particle System',\n 'Master Particle System',\n 'Always Loaded',\n 'Master Particle System and Always Loaded'\n ]))\n ], cpNormal, True)\n ]);\nend;\n\nprocedure DefineFO4h;\nbegin\n wbRecord(AVIF, 'Actor Value Information', [\n wbEDID,\n wbFULL,\n wbDESCReq,\n wbLString(ANAM, 'Abbreviation', 0, cpTranslate),\n wbFloat(NAM0, 'Default Value'), // Prior to form version 81, it was either 0.0, 1.0 or 100.0, so scale or multiplier ?\n wbInteger(AVFL, 'Flags', itU32, wbFlags([ // 32 bits Flags, it used to impact NAM0 loading (bits 10, 11, 12) (even though it loads later :) )\n 'Unknown 1',\n 'Unknown 2',\n 'Unknown 3',\n 'Unknown 4',\n 'Unknown 5',\n 'Unknown 6',\n 'Unknown 7',\n 'Unknown 8',\n 'Unknown 9',\n 'Unknown 10',\n 'Unknown 11',\n 'Unknown 12',\n 'Unknown 13',\n 'Unknown 14',\n 'Unknown 15',\n 'Unknown 16',\n 'Unknown 17',\n 'Unknown 18',\n 'Unknown 19',\n 'Unknown 20',\n 'Minimum 1',\n 'Maximum 10',\n 'Maximum 100',\n 'Multiply By 100',\n 'Percentage',\n 'Unknown 26',\n 'Damage Is Positive',\n 'God Mode Immune',\n 'Unknown 29',\n 'Unknown 30',\n 'Unknown 31',\n 'Hardcoded'\n ])),\n wbInteger(NAM1, 'Type', itU32, wbEnum([\n 'Derived Attribute',\n 'Special (Attribute)',\n 'Skill',\n 'AI Attribute',\n 'Resistance',\n 'Condition',\n 'Charge',\n 'Int Value',\n 'Variable',\n 'Resource'\n ]))\n ]); // S.P.E.C.I.A.L start at index 5, so FormID 0x2bc+5 to 0x2bc+11, RadResistIngestion at index 0x29\n\n wbRecord(CAMS, 'Camera Shot', [\n wbEDID,\n wbMODL,\n wbCTDAs,\n wbStruct(DATA, 'Data', [\n wbInteger('Action', itU32, wbEnum([\n {0} 'Shoot',\n {1} 'Fly',\n {2} 'Hit',\n {3} 'Zoom'\n ])),\n wbInteger('Location', itU32, wbEnum([\n {0} 'Attacker',\n {1} 'Projectile',\n {2} 'Target',\n {3} 'Lead Actor'\n ])),\n wbInteger('Target', itU32, wbEnum([\n {0} 'Attacker',\n {1} 'Projectile',\n {2} 'Target',\n {3} 'Lead Actor'\n ])),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Position Follows Location',\n {0x00000002} 'Rotation Follows Target',\n {0x00000004} 'Don''t Follow Bone',\n {0x00000008} 'First Person Camera',\n {0x00000010} 'No Tracer',\n {0x00000020} 'Start At Time Zero',\n {0x00000040} 'Don''t Reset Location Spring',\n {0x00000080} 'Don''t Reset Target Spring'\n ])),\n wbStruct('Time Multipliers', [\n wbFloat('Player'),\n wbFloat('Target'),\n wbFloat('Global')\n ]),\n wbFloat('Max Time'),\n wbFloat('Min Time'),\n wbFloat('Target % Between Actors'),\n wbFloat('Near Target Distance'),\n wbFloat('Location Spring'),\n wbFloat('Target Spring'),\n wbStruct('Rotation Offset', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ])\n ], cpNormal, True, nil, 9),\n wbFormIDCk(MNAM, 'Image Space Modifier', [IMAD])\n ]);\n\n wbRecord(CPTH, 'Camera Path', [\n wbEDID,\n wbCTDAs,\n wbArray(ANAM, 'Related Camera Paths', wbFormIDCk('Related Camera Path', [CPTH, NULL]), ['Parent', 'Previous Sibling'], cpNormal, True),\n wbInteger(DATA, 'Camera Zoom / Flags', itU8, wbFlags([\n {0x01} 'Disable',\n {0x02} 'Shot List',\n {0x04} 'Dynamic Camera Times',\n {0x08} 'Unknown 3',\n {0x10} 'Unknown 4',\n {0x20} 'Unknown 5',\n {0x40} 'Randomize Paths',\n {0x80} 'Not Must Have Camera Shots'\n ]), cpNormal, True),\n wbRArray('Camera Shots', wbFormIDCk(SNAM, 'Camera Shot', [CAMS]))\n ]);\n\n wbRecord(VTYP, 'Voice Type', [\n wbEDID,\n wbInteger(DNAM, 'Flags', itU8, wbFlags([\n 'Allow Default Dialog',\n 'Female'\n ]), cpNormal, True)\n ]);\n\n wbRecord(MATT, 'Material Type', [\n wbEDID,\n wbFormIDCk(PNAM, 'Material Parent', [MATT, NULL]),\n wbString(MNAM, 'Material Name'),\n wbStruct(CNAM, 'Havok Display Color', [\n wbFloat('Red', cpNormal, True, 255, 0),\n wbFloat('Green', cpNormal, True, 255, 0),\n wbFloat('Blue', cpNormal, True, 255, 0)\n ]),\n wbFloat(BNAM, 'Buoyancy'),\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n 'Stair Material',\n 'Arrows Stick',\n 'Can Tunnel'\n ], False)),\n wbFormIDCk(HNAM, 'Havok Impact Data Set', [IPDS]),\n wbString(ANAM, 'Breakable FX'),\n wbMODT\n ]);\n\n wbRecord(IPCT, 'Impact', [\n wbEDID,\n wbMODL,\n wbStruct(DATA, '', [\n wbFloat('Effect - Duration'),\n wbInteger('Effect - Orientation', itU32, wbEnum([\n 'Surface Normal',\n 'Projectile Vector',\n 'Projectile Reflection'\n ])),\n wbFloat('Angle Threshold'),\n wbFloat('Placement Radius'),\n wbInteger('Sound Level', itU32, wbSoundLevelEnum),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'No Decal Data'\n ])),\n wbInteger('Impact Result', itU8, wbEnum([\n {0} 'Default',\n {1} 'Destroy',\n {2} 'Bounce',\n {3} 'Impale',\n {4} 'Stick'\n ])),\n wbByteArray('Unknown', 2)\n ], cpNormal, True),\n wbDODT,\n wbFormIDCk(DNAM, 'Texture Set', [TXST]),\n wbFormIDCk(ENAM, 'Secondary Texture Set', [TXST]),\n wbFormIDCk(SNAM, 'Sound 1', [SNDR]),\n wbFormIDCk(NAM1, 'Sound 2', [SNDR]),\n wbFormIDCk(NAM3, 'Footstep Explosion', [EXPL]),\n wbFormIDCk(NAM2, 'Hazard', [HAZD]),\n wbFloat(FNAM, 'Footstep Particle Max Dist')\n ]);\n\n wbRecord(IPDS, 'Impact Data Set', [\n wbEDID,\n wbRArrayS('Data', wbStructSK(PNAM, [0], '', [\n wbFormIDCk('Material', [MATT]),\n wbFormIDCk('Impact', [IPCT])\n ]))\n ]);\n\n wbRecord(ECZN, 'Encounter Zone', [\n wbEDID,\n wbStruct(DATA, '', [\n wbFormIDCkNoReach('Owner', [NPC_, FACT, NULL]),\n wbFormIDCk('Location', [LCTN, NULL]),\n wbInteger('Rank', itS8),\n wbInteger('Min Level', itS8),\n wbInteger('Flags', itU8, wbFlags([\n 'Never Resets',\n 'Match PC Below Minimum Level',\n 'Disable Combat Boundary',\n 'Workshop'\n ])),\n wbInteger('Max Level', itS8)\n ], cpNormal, True)\n ]);\n\n wbRecord(LCTN, 'Location', [\n wbEDID,\n\n wbArray(ACPR, 'Actor Cell Persistent Reference', wbStruct('', [\n wbFormIDCk('Actor', sigReferences, False, cpBenign),\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ])),\n wbArray(LCPR, 'Location Cell Persistent Reference', wbStruct('', [\n wbFormIDCk('Actor', sigReferences, False, cpBenign),\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ])),\n wbArray(RCPR, 'Reference Cell Persistent Reference', wbFormIDCk('Ref', [ACHR, REFR], False, cpBenign)),\n\n wbArray(ACUN, 'Actor Cell Unique', wbStruct('', [\n wbFormIDCk('Actor', [NPC_], False, cpBenign),\n wbFormIDCk('Ref', [ACHR], False, cpBenign),\n wbFormIDCk('Location', [LCTN, NULL], False, cpBenign)\n ])),\n wbArray(LCUN, 'Location Cell Unique', wbStruct('', [\n wbFormIDCk('Actor', [NPC_], False, cpBenign),\n wbFormIDCk('Ref', [ACHR], False, cpBenign),\n wbFormIDCk('Location', [LCTN, NULL], False, cpBenign)\n ])),\n wbArray(RCUN, 'Reference Cell Unique', wbFormIDCk('Actor', [NPC_], False, cpBenign)),\n\n wbArray(ACSR, 'Actor Cell Static Reference', wbStruct('', [\n wbFormIDCk('Loc Ref Type', [LCRT], False, cpBenign),\n wbFormIDCk('Marker', sigReferences, False, cpBenign),\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ])),\n wbArray(LCSR, 'Location Cell Static Reference', wbStruct('', [\n wbFormIDCk('Loc Ref Type', [LCRT], False, cpBenign),\n wbFormIDCk('Marker', sigReferences, False, cpBenign),\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ])),\n wbArray(RCSR, 'Reference Cell Static Reference', wbFormIDCk('Ref', [ACHR, REFR], False, cpBenign)),\n\n wbRArray('Actor Cell Encounter Cell',\n wbStruct(ACEC, 'Unknown', [\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbArray('Coordinates', wbStruct('', [\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ]))\n ])\n ),\n wbRArray('Location Cell Encounter Cell',\n wbStruct(LCEC, 'Unknown', [\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbArray('Coordinates', wbStruct('', [\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ]))\n ])\n ),\n wbRArray('Reference Cell Encounter Cell',\n wbStruct(RCEC, 'Unknown', [\n wbFormIDCk('Location', [WRLD, CELL], False, cpBenign),\n wbArray('Coordinates', wbStruct('', [\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ]))\n ])\n ),\n\n wbArray(ACID, 'Actor Cell Marker Reference', wbFormIDCk('Ref', sigReferences, False, cpBenign)),\n wbArray(LCID, 'Location Cell Marker Reference', wbFormIDCk('Ref', sigReferences, False, cpBenign)),\n\n wbArray(ACEP, 'Actor Cell Enable Point', wbStruct('', [\n wbFormIDCk('Actor', sigReferences, False, cpBenign),\n wbFormIDCk('Ref', sigReferences, False, cpBenign),\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ])),\n wbArray(LCEP, 'Location Cell Enable Point', wbStruct('', [\n wbFormIDCk('Actor', sigReferences, False, cpBenign),\n wbFormIDCk('Ref', sigReferences, False, cpBenign),\n wbInteger('Grid Y', itS16, nil, cpBenign),\n wbInteger('Grid X', itS16, nil, cpBenign)\n ])),\n\n wbFULL,\n wbKSIZ,\n wbKWDAs,\n wbFormIDCk(PNAM, 'Parent Location', [LCTN, NULL]),\n wbFormIDCk(NAM1, 'Music', [MUSC, NULL]),\n wbFormIDCk(FNAM, 'Unreported Crime Faction', [FACT]),\n wbFormIDCk(MNAM, 'World Location Marker Ref', [REFR, ACHR]),\n wbFloat(RNAM, 'World Location Radius'),\n //wbFormIDCk(NAM0, 'Horse Marker Ref', [REFR]),\n wbFloat(ANAM, 'Unknown'),\n wbCNAM\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\nend;\n\n{this is required to prevent XE6 compiler error}\ntype\n TVarRecs = array of TVarRec;\n\nfunction CombineVarRecs(const a, b : array of const)\n : TVarRecs;\nbegin\n SetLength(Result, Length(a) + Length(b));\n if Length(a) > 0 then\n Move(a[0], Result[0], SizeOf(TVarRec) * Length(a));\n if Length(b) > 0 then\n Move(b[0], Result[Length(a)], SizeOf(TVarRec) * Length(b));\nend;\n\nfunction MakeVarRecs(const a : array of const)\n : TVarRecs;\nbegin\n SetLength(Result, Length(a));\n if Length(a) > 0 then\n Move(a[0], Result[0], SizeOf(TVarRec) * Length(a));\nend;\n\n\nprocedure DefineFO4i;\nvar\n a, b, c : TVarRecs;\nbegin\n wbRecord(MESG, 'Message', [\n wbEDID,\n wbDESCReq,\n wbFULL,\n wbFormIDCk(INAM, 'Icon (unused)', [NULL], False, cpIgnore, True), // leftover\n wbFormIDCk(QNAM, 'Owner Quest', [QUST]),\n wbInteger(DNAM, 'Flags', itU32, wbFlags([\n 'Message Box',\n 'Delay Initial Display'\n ]), cpNormal, True, False, nil, wbMESGDNAMAfterSet),\n wbInteger(TNAM, 'Display Time', itU32, nil, cpNormal, False, False, wbMESGTNAMDontShow),\n wbString(SNAM, 'SWF'),\n wbLString(NNAM, 'Short Title', 0, cpTranslate),\n wbRStructs('Menu Buttons', 'Menu Button', [\n wbLString(ITXT, 'Button Text', 0, cpTranslate),\n wbCTDAs\n ], [])\n ], False, nil, cpNormal, False, wbMESGAfterLoad);\n\n a := MakeVarRecs([\n 0, 'None',\n Sig2Int('AAAC'), 'Action Activate',\n Sig2Int('AAB1'), 'Action Bleedout Start',\n Sig2Int('AAB2'), 'Action Bleedout Stop',\n Sig2Int('AABA'), 'Action Block Anticipate',\n Sig2Int('AABH'), 'Action Block Hit',\n Sig2Int('AABI'), 'Action Bumped Into',\n Sig2Int('AADA'), 'Action Dual Attack',\n Sig2Int('AADE'), 'Action Death',\n Sig2Int('AADL'), 'Action Dual Release',\n Sig2Int('AADR'), 'Action Draw',\n Sig2Int('AADW'), 'Action Death Wait',\n Sig2Int('AAF1'), 'Action Fly Start',\n Sig2Int('AAF2'), 'Action Fly Stop',\n Sig2Int('AAFA'), 'Action Fall',\n Sig2Int('AAFQ'), 'Action Force Equip',\n Sig2Int('AAGU'), 'Action Get Up',\n Sig2Int('AAH1'), 'Action Hover Start',\n Sig2Int('AAH2'), 'Action Hover Stop',\n Sig2Int('AAID'), 'Action Idle',\n Sig2Int('AAIS'), 'Action Idle Stop',\n Sig2Int('AAJP'), 'Action Jump',\n Sig2Int('AALA'), 'Action Left Attack',\n Sig2Int('AALD'), 'Action Left Ready',\n Sig2Int('AALI'), 'Action Left Interrupt',\n Sig2Int('AALK'), 'Action Look',\n Sig2Int('AALM'), 'Action Large Movement Delta',\n Sig2Int('AALN'), 'Action Land',\n Sig2Int('AALR'), 'Action Left Release',\n Sig2Int('AALS'), 'Action Left Sync Attack',\n Sig2Int('AAMT'), 'Action Mantle',\n Sig2Int('AAOE'), 'Action AoE Attack',\n Sig2Int('AAPA'), 'Action Right Power Attack',\n Sig2Int('AAPE'), 'Action Path End',\n Sig2Int('AAPS'), 'Action Path Start',\n Sig2Int('AAR2'), 'Action Large Recoil',\n Sig2Int('AARA'), 'Action Right Attack',\n Sig2Int('AARC'), 'Action Recoil',\n Sig2Int('AARD'), 'Action Right Ready',\n Sig2Int('AARI'), 'Action Right Interrupt',\n Sig2Int('AARR'), 'Action Right Release',\n Sig2Int('AARS'), 'Action Right Sync Attack',\n Sig2Int('AAS1'), 'Action Stagger Start',\n Sig2Int('AASC'), 'Action Shield Change',\n Sig2Int('AASH'), 'Action Sheath',\n Sig2Int('AASN'), 'Action Sneak',\n Sig2Int('AASP'), 'Action Sprint Stop',\n Sig2Int('AASS'), 'Action Summoned Start',\n Sig2Int('AAST'), 'Action Sprint Start',\n Sig2Int('AASW'), 'Action Swim State Change',\n Sig2Int('AAVC'), 'Action Voice',\n Sig2Int('AAVD'), 'Action Voice Ready',\n Sig2Int('AAVI'), 'Action Voice Interrupt',\n Sig2Int('AAVR'), 'Action Voice Release',\n Sig2Int('AAWH'), 'Action Ward Hit',\n Sig2Int('ABLA'), 'Action Begin Looping Activate',\n Sig2Int('ABOL'), 'Action Bolt Charge',\n Sig2Int('ABSE'), 'Art Object Absorb Effect',\n Sig2Int('ACHI'), 'Action Hide',\n Sig2Int('ACSS'), 'Action Cover Sprint Start',\n Sig2Int('ACTN'), 'Action Tunnel',\n Sig2Int('ACWR'), 'Action Cower',\n Sig2Int('ADGE'), 'Action Dodge',\n Sig2Int('ADPA'), 'Action Dual Power Attack',\n Sig2Int('AECL'), 'Action Enter Cover',\n Sig2Int('AELA'), 'Action End Looping Activate',\n Sig2Int('AENC'), 'Action Enter Combat',\n Sig2Int('AENI'), 'Action Dialogue Enter',\n Sig2Int('AEVD'), 'Action Evade',\n Sig2Int('AEXC'), 'Action Exit Cover',\n Sig2Int('AEXI'), 'Action Dialogue Exit',\n Sig2Int('AEXT'), 'Action Exit Combat',\n Sig2Int('AFCH'), 'Action Fire Charge',\n Sig2Int('AFCO'), 'Action Fire Charge Hold',\n Sig2Int('AFEM'), 'Action Fire Empty',\n Sig2Int('AFIA'), 'Action Fire Auto',\n Sig2Int('AFIS'), 'Action Fire Single',\n Sig2Int('AFLT'), 'Action Flip-Throw',\n Sig2Int('AFNP'), 'Keyword Activator Furniture No Player',\n Sig2Int('AGAL'), 'Action Gun Alert',\n Sig2Int('AGCS'), 'Action Gun Charge Start',\n Sig2Int('AGDN'), 'Action Gun Down',\n Sig2Int('AGRX'), 'Action Gun Relaxed',\n Sig2Int('AGRY'), 'Action Gun Ready',\n Sig2Int('AIDW'), 'Action Idle Warn',\n Sig2Int('AIEN'), 'Action Interaction Enter',\n Sig2Int('AIEQ'), 'Action Interaction Exit Quick',\n Sig2Int('AIEX'), 'Action Interaction Exit',\n Sig2Int('AILN'), 'Action Dialogue Listen Negative',\n Sig2Int('AILp'), 'Action Dialogue Listen Positive',\n Sig2Int('AILQ'), 'Action Dialogue Listen Question',\n Sig2Int('AINT'), 'Action Intimidate',\n Sig2Int('AIVC'), 'Verlet Cape',\n Sig2Int('AIXA'), 'Action Interaction Exit Alternate',\n Sig2Int('AKDN'), 'Action Knockdown',\n Sig2Int('ALIC'), 'Action Limb Critical',\n Sig2Int('ALIK'), 'Alcohol Item keyword',\n Sig2Int('ALPA'), 'Action Left Power Attack',\n Sig2Int('ALTI'), 'Action Dialogue Listen',\n Sig2Int('AMBK'), 'Action Move Backward',\n Sig2Int('AMEL'), 'Action Melee',\n Sig2Int('AMFD'), 'Action Move Forward',\n Sig2Int('AMLT'), 'Action Move Left',\n Sig2Int('AMRT'), 'Action Move Right',\n Sig2Int('AMSP'), 'Action Move Stop',\n Sig2Int('AMST'), 'Action Move Start',\n Sig2Int('ANML'), 'Keyword Animal',\n Sig2Int('ANSC'), 'Action NonSupport Contact',\n Sig2Int('AODA'), 'Keyword Armor Material Daedric',\n Sig2Int('AODB'), 'Keyword Armor Material Dragonbone',\n Sig2Int('AODP'), 'Keyword Armor Material Dragonplate',\n Sig2Int('AODS'), 'Keyword Armor Material Dragonscale',\n Sig2Int('AODW'), 'Keyword Armor Material Dwarven',\n Sig2Int('AOEB'), 'Keyword Armor Material Ebony',\n Sig2Int('AOEL'), 'Keyword Armor Material Elven',\n Sig2Int('AOES'), 'Keyword Armor Material ElvenSplinted',\n Sig2Int('AOFE'), 'Keyword Armor Material Iron',\n Sig2Int('AOFL'), 'Keyword Armor Material FullLeather',\n Sig2Int('AOGL'), 'Keyword Armor Material Glass',\n Sig2Int('AOHI'), 'Keyword Armor Material Hide',\n Sig2Int('AOIB'), 'Keyword Armor Material IronBanded',\n Sig2Int('AOIH'), 'Keyword Armor Material ImperialHeavy',\n Sig2Int('AOIM'), 'Keyword Armor Material Imperial',\n Sig2Int('AOIR'), 'Keyword Armor Material ImperialReinforced',\n Sig2Int('AOOR'), 'Keyword Armor Material Orcish',\n Sig2Int('AOSC'), 'Keyword Armor Material Scaled',\n Sig2Int('AOSD'), 'Keyword Armor Material Studded',\n Sig2Int('AOSK'), 'Keyword Armor Material Stormcloak',\n Sig2Int('AOSP'), 'Keyword Armor Material SteelPlate',\n Sig2Int('AOST'), 'Keyword Armor Material Steel',\n Sig2Int('APIC'), 'Action Pipboy Close',\n Sig2Int('APID'), 'Action Pipboy Data',\n Sig2Int('APII'), 'Action Pipboy Inventory',\n Sig2Int('APIM'), 'Action Pipboy Map',\n Sig2Int('APIN'), 'Action Pipboy Inspect',\n Sig2Int('APIP'), 'Action Pipboy',\n Sig2Int('APIS'), 'Action Pipboy Stats',\n Sig2Int('APIT'), 'Action Pipboy Tab',\n Sig2Int('APIZ'), 'Action Pipboy Zoom',\n Sig2Int('APLH'), 'Action Pipboy Load Holotape',\n Sig2Int('APLN'), 'Action Dialogue Listen Neutral',\n Sig2Int('APNC'), 'Action Panic',\n Sig2Int('APPS'), 'Action Pipboy Select',\n Sig2Int('APR0'), 'Action Pipboy Radio Off',\n Sig2Int('APR1'), 'Action Pipboy Radio On',\n Sig2Int('APSH'), 'Allow Player Shout',\n Sig2Int('APTP'), 'Action Pipboy Tab Previous',\n Sig2Int('AREL'), 'Action Reload',\n Sig2Int('ARGI'), 'Action Ragdoll Instant',\n Sig2Int('ARTL'), 'Armor Material List',\n Sig2Int('ASFL'), 'Action Shuffle',\n Sig2Int('ASID'), 'Action Idle Stop Instant',\n Sig2Int('ASIR'), 'Action Sighted Release',\n Sig2Int('ASIT'), 'Action Sighted',\n Sig2Int('ATHR'), 'Action Throw',\n Sig2Int('ATKI'), 'Action Dialogue Talking',\n Sig2Int('ATLE'), 'Action Turn Left',\n Sig2Int('ATRI'), 'Action Turn Right',\n Sig2Int('ATSP'), 'Action Turn Stop',\n Sig2Int('AVVP'), 'Vampire Available Perks',\n Sig2Int('AVWP'), 'Unused',\n Sig2Int('AWWS'), 'Action Waterwalk Start',\n Sig2Int('AWWW'), 'Bunny Faction',\n Sig2Int('BAPO'), 'Base Potion',\n Sig2Int('BAPS'), 'Base Poison',\n Sig2Int('BEEP'), 'Keyword Robot',\n Sig2Int('BENA'), 'Base Armor Enchantment',\n Sig2Int('BENW'), 'Base Weapon Enchantment',\n Sig2Int('BTMS'), 'Battle Music',\n Sig2Int('CACA'), 'Commanded Actor Ability',\n Sig2Int('CHIK'), 'Chem Item keyword',\n Sig2Int('CLIK'), 'Clothes Item keyword',\n Sig2Int('CMPX'), 'Complex Scene Object',\n Sig2Int('CNMK'), 'Keyword nullptr Mod',\n Sig2Int('COEX'), 'Keyword Conditional Explosion',\n Sig2Int('COOK'), 'Keyword Cooking Pot',\n Sig2Int('CSTY'), 'Combat Style',\n Sig2Int('CWNE'), 'Keyword Civil War Neutral',\n Sig2Int('CWOK'), 'Keyword Civil War Owner',\n Sig2Int('DAED'), 'Keyword Daedra',\n Sig2Int('DBHF'), 'Dark Brotherhood Faction',\n Sig2Int('DCMS'), 'Dungeon Cleared Music',\n Sig2Int('DCZM'), 'Dragon Crash Zone Marker',\n Sig2Int('DDSC'), 'Dialogue Voice Category',\n Sig2Int('DEIS'), 'Drug Wears Off Image Space',\n Sig2Int('DFTS'), 'Footstep Set',\n Sig2Int('DGFL'), 'DialogueFollower Quest',\n Sig2Int('DIEN'), 'Keyword Disallow Enchanting',\n Sig2Int('DLMT'), 'Landscape Material',\n Sig2Int('DLZM'), 'Dragon Land Zone Marker',\n Sig2Int('DMFL'), 'Default Movement Type: Fly',\n Sig2Int('DMSN'), 'Default Movement Type: Sneak',\n Sig2Int('DMSW'), 'Default Movement Type: Swim',\n Sig2Int('DMWL'), 'Default Movement Type: Default',\n Sig2Int('DOP2'), 'Dialogue Output Model 3D',\n Sig2Int('DOP3'), 'Dialogue Output Model 2D',\n Sig2Int('DRAK'), 'Keyword Dragon',\n Sig2Int('DTMS'), 'Death Music',\n Sig2Int('EACA'), 'Every Actor Ability',\n Sig2Int('EPDF'), 'Eat Package Default Food',\n Sig2Int('FFFP'), 'Keyword Furniture Forces 1st Person',\n Sig2Int('FFTP'), 'Keyword Furniture Forces 3rd Person',\n Sig2Int('FOIK'), 'Food Item Keyword',\n Sig2Int('FORG'), 'Keyword Forge',\n Sig2Int('FTEL'), 'Male Face Texture Set: Eyes',\n Sig2Int('FTGF'), 'Fighters'' Guild Faction',\n Sig2Int('FTHD'), 'Male Face Texture Set: Head',\n Sig2Int('FTHF'), 'Female Face Texture Set: Head',\n Sig2Int('FTMF'), 'Female Face Texture Set: Mouth',\n Sig2Int('FTML'), 'Favor travel marker location',\n Sig2Int('FTMO'), 'Male Face Texture Set: Mouth',\n Sig2Int('FTNP'), 'Furniture Test NPC',\n Sig2Int('FTRF'), 'Female Face Texture Set: Eyes'\n ]);\n\n b := MakeVarRecs([\n Sig2Int('GCK1'), 'Keyword Generic Craftable Keyword 01',\n Sig2Int('GCK2'), 'Keyword Generic Craftable Keyword 02',\n Sig2Int('GCK3'), 'Keyword Generic Craftable Keyword 03',\n Sig2Int('GCK4'), 'Keyword Generic Craftable Keyword 04',\n Sig2Int('GCK5'), 'Keyword Generic Craftable Keyword 05',\n Sig2Int('GCK6'), 'Keyword Generic Craftable Keyword 06',\n Sig2Int('GCK7'), 'Keyword Generic Craftable Keyword 07',\n Sig2Int('GCK8'), 'Keyword Generic Craftable Keyword 08',\n Sig2Int('GCK9'), 'Keyword Generic Craftable Keyword 09',\n Sig2Int('GCKX'), 'Keyword Generic Craftable Keyword 10',\n Sig2Int('GFAC'), 'Guard Faction',\n Sig2Int('GLIK'), 'Gloves Item Keyword',\n Sig2Int('GOLD'), 'Gold',\n Sig2Int('GRIK'), 'Grenade Item Keyword',\n Sig2Int('HBAL'), 'Help Basic Alchemy',\n Sig2Int('HBBR'), 'Help Barter',\n Sig2Int('HBCO'), 'Help Basic Cooking',\n Sig2Int('HBEC'), 'Help Basic Enchanting',\n Sig2Int('HBFG'), 'Help Basic Forging',\n Sig2Int('HBFS'), 'Help Favorites',\n Sig2Int('HBFT'), 'Help Teamate Favor',\n Sig2Int('HBHJ'), 'Help Jail',\n Sig2Int('HBJL'), 'Help Journal',\n Sig2Int('HBLH'), 'Help Low Health',\n Sig2Int('HBLK'), 'Help Basic Lockpicking PC',\n Sig2Int('HBLM'), 'Help Low Magicka',\n Sig2Int('HBLS'), 'Help Low Stamina',\n Sig2Int('HBLU'), 'Help Leveling up',\n Sig2Int('HBLX'), 'Help Basic Lockpicking Console',\n Sig2Int('HBML'), 'Help Basic Smelting',\n Sig2Int('HBMM'), 'Help Map Menu',\n Sig2Int('HBOC'), 'Help Basic Object Creation',\n Sig2Int('HBSA'), 'Help Basic Smithing Armor',\n Sig2Int('HBSK'), 'Help Skills Menu',\n Sig2Int('HBSM'), 'Help Basic Smithing Weapon',\n Sig2Int('HBTA'), 'Help Basic Tanning',\n Sig2Int('HBWC'), 'Help Weapon Charge',\n Sig2Int('HCLL'), 'FormList Hair Color List',\n Sig2Int('HEIK'), 'Helmet Item Keyword',\n Sig2Int('HFSD'), 'Heartbeat Sound Fast',\n Sig2Int('HMPC'), 'Help Manual PC',\n Sig2Int('HMXB'), 'Help Manual XBox',\n Sig2Int('HRSK'), 'Keyword Horse',\n Sig2Int('HSSD'), 'Heartbeat Sound Slow',\n Sig2Int('HVFS'), 'Harvest Failed Sound',\n Sig2Int('HVSS'), 'Harvest Sound',\n Sig2Int('HWIK'), 'Heavy Weapon Item keyword',\n Sig2Int('IMDI'), 'Dialogue Imagespace',\n Sig2Int('IMID'), 'ImageSpaceModifier for inventory menu.',\n Sig2Int('IMLH'), 'Imagespace: Low Health',\n Sig2Int('IMPP'), 'ImageSpaceModifier for Pipboy menu in Power armor.',\n Sig2Int('IOPM'), 'Interface Output Model',\n Sig2Int('JRLF'), 'Jarl Faction',\n Sig2Int('JWLR'), 'Keyword Jewelry',\n Sig2Int('KHFL'), 'Kinect Help FormList',\n Sig2Int('KTRW'), 'Teammate Ready Weapon',\n Sig2Int('KWBR'), 'Color Form',\n Sig2Int('KWCU'), 'Keyword Cuirass',\n Sig2Int('KWDM'), 'Keyword DummyObject',\n Sig2Int('KWDO'), 'Keyword ClearableLocation',\n Sig2Int('KWGE'), 'Keyword UseGeometryEmitter',\n Sig2Int('KWMS'), 'Keyword MustStop',\n Sig2Int('LGH1'), 'Default Light 1',\n Sig2Int('LGH2'), 'Default Light 2',\n Sig2Int('LGH3'), 'Default Light 3',\n Sig2Int('LGH4'), 'Default Light 4',\n Sig2Int('LGHP'), 'Pipboy Light',\n Sig2Int('LKHO'), 'Keyword Hold Location',\n Sig2Int('LKPK'), 'Lockpick',\n Sig2Int('LMHP'), 'Local Map Hide Plane',\n Sig2Int('LRRD'), 'LocRefType Resource Destructible',\n Sig2Int('LRSO'), 'LocRefType Civil War Soldier',\n Sig2Int('LSIS'), 'Imagespace: Load screen',\n Sig2Int('MBIK'), 'Med Bag Item Keyword',\n Sig2Int('MDSC'), 'Music Sound Category',\n Sig2Int('MFSN'), 'Magic Fail Sound',\n Sig2Int('MGGF'), 'Mages'' Guild Faction',\n Sig2Int('MIIK'), 'Mine Item Keyword',\n Sig2Int('MMCL'), 'Main Menu Cell',\n Sig2Int('MMSD'), 'Map Menu Looping Sound',\n Sig2Int('MNTK'), 'Keyword Mount',\n Sig2Int('MTSC'), 'Master Sound Category',\n Sig2Int('MVBL'), 'Keyword Movable',\n Sig2Int('NASD'), 'No-Activation Sound',\n Sig2Int('NDSC'), 'Non-Dialogue Voice Category',\n Sig2Int('NMRD'), 'Road Marker',\n Sig2Int('NPCK'), 'Keyword NPC',\n Sig2Int('NRNT'), 'Keyword Nirnroot',\n Sig2Int('P3OM'), 'Player''s Output Model 3rd Person',\n Sig2Int('PDLC'), 'Pause During Loading Menu Category',\n Sig2Int('PDMC'), 'Pause During Menu Category Fade',\n Sig2Int('PDSA'), 'Putdown Sound Armor',\n Sig2Int('PDSB'), 'Putdown Sound Book',\n Sig2Int('PDSG'), 'Putdown Sound Generic',\n Sig2Int('PDSI'), 'Putdown Sound Ingredient',\n Sig2Int('PDSW'), 'Putdown Sound Weapon',\n Sig2Int('PFAC'), 'Player Faction',\n Sig2Int('PIMC'), 'Pause During Menu Category Immediate',\n Sig2Int('PIVV'), 'Player Is Vampire Variable',\n Sig2Int('PIWV'), 'UNUSED01',\n Sig2Int('PLOC'), 'PersistAll Location',\n Sig2Int('PLST'), 'Default Pack List',\n Sig2Int('POEQ'), 'Potion Equip',\n Sig2Int('POPM'), 'Player''s Output Model 1st Person',\n Sig2Int('PTEM'), 'Package Template',\n Sig2Int('PTFR'), 'PotentialFollower Faction',\n Sig2Int('PTNP'), 'Pathing Test NPC',\n Sig2Int('PUSA'), 'Pickup Sound Armor',\n Sig2Int('PUSB'), 'Pickup Sound Book',\n Sig2Int('PUSG'), 'Pickup Sound Generic',\n Sig2Int('PUSI'), 'Pickup Sound Ingredient',\n Sig2Int('PUSW'), 'Pickup Sound Weapon',\n Sig2Int('PVFA'), 'Player Voice Female',\n Sig2Int('PVFC'), 'Player Voice Female Child',\n Sig2Int('PVMA'), 'Player Voice Male',\n Sig2Int('PVMC'), 'Player Voice Male Child',\n Sig2Int('PWFD'), 'Wait-For-Dialogue Package',\n Sig2Int('QMEA'), 'Quest Marker Enemy Above',\n Sig2Int('QMEB'), 'Quest Marker Enemy Below',\n Sig2Int('QMEN'), 'Quest Marker Enemy',\n Sig2Int('QMFO'), 'Quest Marker Follower',\n Sig2Int('QMLO'), 'Quest Marker Location',\n Sig2Int('RIVR'), 'Vampire Race',\n Sig2Int('RIVS'), 'Vampire Spells',\n Sig2Int('RIWR'), 'UNUSED02',\n Sig2Int('RKIK'), 'Repair Kit Item Keyword',\n Sig2Int('RUSG'), 'Keyword Reusable SoulGem',\n Sig2Int('RVBT'), 'Reverb Type',\n Sig2Int('SALT'), 'Sitting Angle Limit',\n Sig2Int('SAT1'), 'Keyword Scale Actor To 1.0',\n Sig2Int('SCSD'), 'Soul Captured Sound',\n Sig2Int('SFDC'), 'SFX To Fade In Dialogue Category',\n Sig2Int('SFSN'), 'Shout Fail Sound',\n Sig2Int('SKLK'), 'Skeleton Key',\n Sig2Int('SLDM'), 'Snow LOD Material',\n Sig2Int('SLHD'), 'Snow LOD Material HD',\n Sig2Int('SMLT'), 'Keyword Smelter',\n Sig2Int('SMSC'), 'Stats Mute Category',\n Sig2Int('SPFK'), 'Keyword Special Furniture',\n Sig2Int('SSSC'), 'Stats Music',\n Sig2Int('TANN'), 'Keyword Tanning Rack',\n Sig2Int('TKAM'), 'Keyword Type Ammo',\n Sig2Int('TKAR'), 'Keyword Type Armor',\n Sig2Int('TKBK'), 'Keyword Type Book',\n Sig2Int('TKGS'), 'Telekinesis Grab Sound',\n Sig2Int('TKIG'), 'Keyword Type Ingredient',\n Sig2Int('TKKY'), 'Keyword Type Key',\n Sig2Int('TKMS'), 'Keyword Type Misc',\n Sig2Int('TKPT'), 'Keyword Type Potion',\n Sig2Int('TKSG'), 'Keyword Type SoulGem',\n Sig2Int('TKTS'), 'Telekinesis Throw Sound',\n Sig2Int('TKWP'), 'Keyword Type Weapon',\n Sig2Int('TVGF'), 'Thieves'' Guild Faction',\n Sig2Int('UNDK'), 'Keyword Undead',\n Sig2Int('URVT'), 'Underwater Reverb Type',\n Sig2Int('UWLS'), 'Underwater Loop Sound',\n Sig2Int('VAMP'), 'Keyword Vampire',\n Sig2Int('VLOC'), 'Virtual Location',\n Sig2Int('VOEQ'), 'Voice Equip',\n Sig2Int('WASN'), 'Ward Absorb Sound',\n Sig2Int('WBSN'), 'Ward Break Sound',\n Sig2Int('WDSN'), 'Ward Deflect Sound',\n Sig2Int('WEML'), 'Weapon Material List',\n Sig2Int('WMDA'), 'Keyword Weapon Material Daedric',\n Sig2Int('WMDH'), 'Keyword Weapon Material DraugrHoned',\n Sig2Int('WMDR'), 'Keyword Weapon Material Draugr',\n Sig2Int('WMDW'), 'Keyword Weapon Material Dwarven',\n Sig2Int('WMEB'), 'Keyword Weapon Material Ebony',\n Sig2Int('WMEL'), 'Keyword Weapon Material Elven',\n Sig2Int('WMFA'), 'Keyword Weapon Material Falmer',\n Sig2Int('WMFH'), 'Keyword Weapon Material FalmerHoned',\n Sig2Int('WMGL'), 'Keyword Weapon Material Glass',\n Sig2Int('WMIK'), 'Workshop Misc Item Keyword',\n Sig2Int('WMIM'), 'Keyword Weapon Material Imperial',\n Sig2Int('WMIR'), 'Keyword Weapon Material Iron',\n Sig2Int('WMOR'), 'Keyword Weapon Material Orcish',\n Sig2Int('WMST'), 'Keyword Weapon Material Steel',\n Sig2Int('WMWE'), 'World Map Weather',\n Sig2Int('WMWO'), 'Keyword Weapon Material Wood',\n Sig2Int('WPOK'), 'Workshop Player Ownership',\n Sig2Int('WTBA'), 'Keyword WeaponTypeBoundArrow',\n Sig2Int('WWSP'), 'UNUSED03'\n ]);\n\n c := CombineVarRecs(a, b);\n\n wbRecord(DOBJ, 'Default Object Manager', [\n wbEDID,\n wbArrayS(DNAM, 'Objects',\n wbStructSK([0], 'Object', [\n wbInteger('Use', itU32, wbEnum([], c), cpNormalIgnoreEmpty),\n wbFormID('Object ID', cpNormalIgnoreEmpty)\n ]), 0, cpNormalIgnoreEmpty, True, wbDOBJObjectsAfterLoad\n )\n ]);\n\n wbRecord(LGTM, 'Lighting Template', [\n wbEDID,\n wbStruct(DATA, 'Lighting', [\n wbByteColors('Ambient Color'),\n wbByteColors('Directional Color'),\n wbByteColors('Fog Color Near'),\n wbFloat('Fog Near'),\n wbFloat('Fog Far'),\n wbInteger('Directional Rotation XY', itS32),\n wbInteger('Directional Rotation Z', itS32),\n wbFloat('Directional Fade'),\n wbFloat('Fog Clip Distance'),\n wbFloat('Fog Power'),\n wbByteArray('Unused', 32, cpIgnore),\n wbByteColors('Fog Color Far'),\n wbFloat('Fog Max'),\n wbFloat('Light Fade Begin'),\n wbFloat('Light Fade End'),\n wbByteArray('Unused', 4, cpIgnore),\n wbFloat('Near Height Mid'),\n wbFloat('Near Height Range'),\n wbByteColors('Fog Color High Near'),\n wbByteColors('Fog Color High Far'),\n wbFloat('High Density Scale'),\n wbFloat('Fog Near Scale'),\n wbFloat('Fog Far Scale'),\n wbFloat('Fog High Near Scale'),\n wbFloat('Fog High Far Scale'),\n wbFloat('Far Height Mid'),\n wbFloat('Far Height Range')\n ], cpNormal, True, nil, 15),\n wbAmbientColors(DALC),\n wbFormIDCk(WGDR, 'God Rays', [GDRY])\n ]);\n\n wbRecord(MUSC, 'Music Type', [\n wbEDID,\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n {0x01} 'Plays One Selection',\n {0x02} 'Abrupt Transition',\n {0x04} 'Cycle Tracks',\n {0x08} 'Maintain Track Order',\n {0x10} 'Unknown 5',\n {0x20} 'Ducks Current Track',\n {0x40} 'Doesn''t Queue'\n ]), cpNormal, True),\n wbStruct(PNAM, 'Data', [\n wbInteger('Priority', itU16),\n wbInteger('Ducking (dB)', itU16, wbDiv(100))\n ]),\n wbFloat(WNAM, 'Fade Duration'),\n wbArray(TNAM, 'Music Tracks', wbFormIDCk('Track', [MUST, NULL]))\n ]);\n\n wbRecord(FSTP, 'Footstep', [\n wbEDID,\n wbFormIDCk(DATA, 'Impact Data Set', [IPDS, NULL], False, cpNormal, True),\n wbString(ANAM, 'Tag', 0, cpNormal, True)\n ]);\n\n wbRecord(FSTS, 'Footstep Set', [\n wbEDID,\n wbStruct(XCNT, 'Count', [\n wbInteger('Walking', itU32),\n wbInteger('Running', itU32),\n wbInteger('Sprinting', itU32),\n wbInteger('Sneaking', itU32),\n wbInteger('Swimming', itU32)\n ], cpNormal, True),\n wbArray(DATA, 'Footstep Sets', wbFormIDCk('Footstep', [FSTP]), 0, nil, nil, cpNormal, True)\n ]);\n\n wbSMNodeFlags := wbFlags([\n 'Random',\n 'Warn if no child quest started'\n ]);\n\n wbRecord(SMBN, 'Story Manager Branch Node', [\n wbEDID,\n wbFormIDCk(PNAM, 'Parent ', [SMQN, SMBN, SMEN, NULL]),\n wbFormIDCk(SNAM, 'Child ', [SMQN, SMBN, SMEN, NULL], False, cpBenign),\n wbCITC,\n wbCTDAsCount,\n wbInteger(DNAM, 'Flags', itU32, wbSMNodeFlags),\n wbUnknown(XNAM)\n ], False, nil, cpNormal, False, nil, wbConditionsAfterSet);\n\n wbRecord(SMQN, 'Story Manager Quest Node', [\n wbEDID,\n wbFormIDCk(PNAM, 'Parent ', [SMQN, SMBN, SMEN, NULL]),\n wbFormIDCk(SNAM, 'Child ', [SMQN, SMBN, SMEN, NULL], False, cpBenign),\n wbCITC,\n wbCTDAsCount,\n wbStruct(DNAM, 'Flags', [\n wbInteger('Node Flags', itU16, wbSMNodeFlags),\n wbInteger('Quest Flags', itU16, wbFlags([\n 'Do all before repeating',\n 'Shares event',\n 'Num quests to run'\n ]))\n ]),\n wbInteger(XNAM, 'Max concurrent quests', itU32),\n wbInteger(MNAM, 'Num quests to run', itU32),\n wbFloat(HNAM, 'Hours until reset'),\n wbInteger(QNAM, 'Quest Count', itU32, nil, cpBenign),\n wbRArray('Quests', wbRStructSK([0], 'Quest', [\n wbFormIDCk(NNAM, 'Quest', [QUST]),\n wbUnknown(FNAM),\n wbFloat(RNAM, 'Hours until reset', cpNormal, False, 1/24)\n ], []), cpNormal, False, nil, wbSMQNQuestsAfterSet)\n ], False, nil, cpNormal, False, nil, wbConditionsAfterSet);\n\n wbRecord(SMEN, 'Story Manager Event Node', [\n wbEDID,\n wbFormIDCk(PNAM, 'Parent ', [SMQN, SMBN, SMEN, NULL]),\n wbFormIDCk(SNAM, 'Child ', [SMQN, SMBN, SMEN, NULL]),\n wbCITC,\n wbCTDAsCount,\n wbInteger(DNAM, 'Flags', itU32, wbSMNodeFlags),\n wbUnknown(XNAM),\n wbString(ENAM, 'Type', 4)\n ], False, nil, cpNormal, False, nil, wbConditionsAfterSet);\nend;\n\nprocedure DefineFO4j;\nbegin\n wbRecord(DLBR, 'Dialog Branch', [\n wbEDID,\n wbFormIDCk(QNAM, 'Quest', [QUST], False, cpNormal, True),\n wbInteger(TNAM, 'Unknown', itU32),\n wbInteger(DNAM, 'Flags', itU32, wbFlags([\n {0x01} 'Top-Level',\n {0x02} 'Blocking',\n {0x04} 'Exclusive'\n ])),\n wbFormIDCk(SNAM, 'Starting Topic', [DIAL], False, cpNormal, True)\n ]);\n\n wbRecord(MUST, 'Music Track', [\n wbEDID,\n wbInteger(CNAM, 'Track Type', itU32, wbEnum([], [\n Int64($23F678C3), 'Palette',\n Int64($6ED7E048), 'Single Track',\n Int64($A1A9C4D5), 'Silent Track'\n ]), cpNormal, True),\n wbFloat(FLTV, 'Duration'),\n wbFloat(DNAM, 'Fade-Out'),\n wbString(ANAM, 'Track Filename'),\n wbString(BNAM, 'Finale Filename'),\n wbStruct(LNAM, 'Loop Data', [\n wbFloat('Loop Begins'),\n wbFloat('Loop Ends'),\n wbInteger('Loop Count', itU32)\n ]),\n wbArray(FNAM, 'Cue Points', wbFloat('Point')),\n wbCITC,\n wbCTDAsCount,\n wbArray(SNAM, 'Tracks', wbFormIDCk('Track', [MUST, NULL]))\n ], False, nil, cpNormal, False, nil, wbConditionsAfterSet);\n\n wbRecord(DLVW, 'Dialog View', [\n wbEDID,\n wbFormIDCk(QNAM, 'Quest', [QUST], False, cpNormal, True),\n wbRArray('Branches', wbFormIDCk(BNAM, 'Branch', [DLBR])),\n wbRArray('Unknown TNAM', wbRStruct('Unknown', [\n wbUnknown(TNAM)\n ], [])),\n wbUnknown(ENAM),\n wbUnknown(DNAM)\n ]);\n\n {wbRecord(WOOP, 'Word of Power', [\n wbEDID\n ]);}\n\n {wbRecord(SHOU, 'Shout', [\n wbEDID\n ]);}\n\n wbRecord(EQUP, 'Equip Type', [\n wbEDID,\n wbArray(PNAM, 'Slot Parents', wbFormIDCk('Parent', [EQUP])),\n wbInteger(DATA, 'Flags', itU32, wbFlags([\n 'Use All Parents',\n 'Parents Optional',\n 'Item Slot'\n ])),\n wbFormIDCk(ANAM, 'Condition Actor Value', [AVIF, NULL, FFFF])\n ]);\n\n wbRecord(RELA, 'Relationship', [\n wbEDID,\n wbStruct(DATA, 'Data', [\n wbFormIDCk('Parent', [NPC_, NULL]),\n wbFormIDCk('Child', [NPC_, NULL]),\n wbInteger('Rank', itU8, wbEnum([\n 'Lover',\n 'Ally',\n 'Confidant',\n 'Friend',\n 'Acquaitance',\n 'Rival',\n 'Foe',\n 'Enemy',\n 'Archnemesis'\n ])),\n wbByteArray('Unknown', 2),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Unknown 1',\n {0x02} 'Unknown 2',\n {0x04} 'Unknown 3',\n {0x08} 'Unknown 4',\n {0x10} 'Unknown 5',\n {0x20} 'Unknown 6',\n {0x40} 'Unknown 7',\n {0x80} 'Secret'\n ])),\n wbFormIDCk('Association Type', [ASTP, NULL])\n ])\n ]);\n\n wbRecord(SCEN, 'Scene', [\n wbEDID,\n wbVMADFragmentedSCEN,\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n {0x00000001} 'Begin on Quest Start',\n {0x00000002} 'Stop on Quest End',\n {0x00000004} 'Unknown 2',\n {0x00000008} 'Repeat Conditions While True',\n {0x00000010} 'Interruptible',\n {0x00000020} 'Unknown 5',\n {0x00000040} 'Prevent Player Exit Dialogue',\n {0x00000080} 'Unknown 7',\n {0x00000100} 'Unknown 8',\n {0x00000200} 'Unknown 9',\n {0x00000400} 'Unknown 10',\n {0x00000800} 'Disable Dialogue Camera',\n {0x00001000} 'No Follower Idle Chatter'\n ])),\n wbRArray('Phases',\n wbRStruct('Phase', [\n wbEmpty(HNAM, 'Marker Phase Start'),\n wbString(NAM0, 'Name'),\n wbRStruct('Start Conditions', [wbCTDAs], []),\n wbEmpty(NEXT, 'Marker Start Conditions'),\n wbRStruct('Completion Conditions', [wbCTDAs], []),\n wbEmpty(NEXT, 'Marker Completion Conditions'),\n wbInteger(WNAM, 'Editor Width', itU32),\n wbInteger(FNAM, 'Flags', itU16, wbFlags([\n {0x0001} 'Start - WalkAway Phase',\n {0x0002} 'Don''t Run End Scripts on Scene Jump',\n {0x0004} 'Start - Inherit In Templated Scenes'\n ])),\n wbStruct(SCQS, 'Set Parent Quest Stage', [\n wbInteger('On Start', itS16),\n wbInteger('On Completion', itS16)\n ]),\n wbEmpty(HNAM, 'Marker Phase End')\n ], [])\n ),\n wbRArray('Actors', wbRStruct('Actor', [\n wbInteger(ALID, 'Alias ID', itS32),\n wbInteger(LNAM, 'Flags', itU32, wbFlags([\n 'No Player Activation',\n 'Optional',\n 'Run Only Scene Packages',\n 'No Command State'\n ])),\n wbInteger(DNAM, 'Behaviour Flags', itU32, wbFlags([\n 'Death Pause',\n 'Death End',\n 'Combat Pause',\n 'Combat End',\n 'Dialogue Pause',\n 'Dialogue End',\n 'OBS_COM Pause',\n 'OBS_COM End'\n ]))\n ], [])),\n wbRArray('Actions', wbRStruct('Action', [\n wbInteger(ANAM, 'Type', itU16, wbEnum([\n {0} 'Dialogue',\n {1} 'Package',\n {2} 'Timer',\n {3} 'Player Dialogue',\n {4} 'Start Scene',\n {5} 'NPC Response Dialogue',\n {6} 'Radio'\n ])),\n wbString(NAM0, 'Name'),\n wbInteger(ALID, 'Alias ID', itS32),\n wbInteger(INAM, 'Index', itU32),\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n {0x00000001} 'Unknown 0',\n {0x00000002} 'Unknown 1',\n {0x00000004} 'Unknown 2',\n {0x00000008} 'Unknown 3',\n {0x00000010} 'Unknown 4',\n {0x00000020} 'Unknown 5',\n {0x00000040} 'Unknown 6',\n {0x00000080} 'Player Positive Use Dialogue Subtype / Hold Into Next Scene',\n {0x00000100} 'Player Negative Use Dialogue Subtype',\n {0x00000200} 'Player Neutral Use Dialogue Subtype',\n {0x00000400} 'Use Dialogue Subtype',\n {0x00000800} 'Player Question Use Dialogue Subtype',\n {0x00001000} 'Keep/Clear Target on Action End',\n {0x00002000} 'Unknown 13',\n {0x00004000} 'Unknown 14',\n {0x00008000} 'Face Target',\n {0x00010000} 'Looping',\n {0x00020000} 'Headtrack Player',\n {0x00040000} 'Unknown 18',\n {0x00080000} 'Ignore For Completion',\n {0x00100000} 'Unknown 20',\n {0x00200000} 'Camera Speaker Target',\n {0x00400000} 'Complete Face Target',\n {0x00800000} 'Unknown 23',\n {0x01000000} 'Unknown 24',\n {0x02000000} 'Unknown 25',\n {0x04000000} 'Unknown 26',\n {0x08000000} 'NPC Positive Use Dialogue Subtype',\n {0x10000000} 'NPC Negative Use Dialogue Subtype',\n {0x20000000} 'NPC Neutral Use Dialogue Subtype',\n {0x40000000} 'NPC Question Use Dialogue Subtype'\n ])),\n wbInteger(SNAM, 'Start Phase', itU32),\n wbInteger(ENAM, 'End Phase', itU32),\n wbFloat(SNAM, 'Timer - Max Seconds'),\n wbInteger(SCQS, 'Set Parent Quest Stage', itS16),\n wbFloat(TNAM, 'Timer - Min Seconds'),\n wbUnknown(STSC),\n wbRStructs('Start Scenes', 'Start Scene', [\n wbFormIDCk(LCEP, 'Scene', [SCEN]),\n wbInteger(INTT, 'Phase Index', itU16),\n wbString(SSPN, 'Start Phase for Scene'),\n wbCITC,\n wbCTDAs\n ], []),\n wbFormIDCk(PTOP, 'Player Positive Response', [DIAL]),\n wbFormIDCk(NTOP, 'Player Negative Response', [DIAL]),\n wbFormIDCk(NETO, 'Player Neutral Response', [DIAL]),\n wbFormIDCk(QTOP, 'Player Question Response', [DIAL]),\n wbFormIDCk(VENC, 'Player Positive Dialogue Subtype', [KYWD]),\n wbFormIDCk(PLVD, 'Player Negative Dialogue Subtype', [KYWD]),\n wbFormIDCk(JOUT, 'Player Neutral Dialogue Subtype', [KYWD]),\n wbFormIDCk(DALC, 'Player Question Dialogue Subtype', [KYWD]),\n wbArray(DTID, 'NPC Headtracking', wbInteger('Actor ID', itS32)),\n wbFormIDCk(NPOT, 'NPC Positive Response', [DIAL]),\n wbFormIDCk(NNGT, 'NPC Negative Response', [DIAL]),\n wbFormIDCk(NNUT, 'NPC Neutral Response', [DIAL]),\n wbFormIDCk(NQUT, 'NPC Question Response', [DIAL]),\n wbFormIDCk(NPOS, 'NPC Positive Dialogue Subtype', [KYWD]),\n wbFormIDCk(NNGS, 'NPC Negative Dialogue Subtype', [KYWD]),\n wbFormIDCk(NNUS, 'NPC Neutral Dialogue Subtype', [KYWD]),\n wbFormIDCk(NQUS, 'NPC Question Dialogue Subtype', [KYWD]),\n wbInteger(DTGT, 'Dialogue Target Actor', itS32),\n wbRArray('Packages', wbFormIDCk(PNAM, 'Package', [PACK])),\n wbFormIDCk(DATA, 'Topic', [DIAL, NULL]),\n wbUnion(HTID, '', wbSceneActionSoundDecider, [\n wbEmpty('End Scene Say Greeting'),\n wbFormIDCk('Play Sound', [SNDR, NULL])\n ]),\n wbFloat(DMAX, 'Looping - Max'),\n wbFloat(DMIN, 'Looping - Min'),\n wbStruct(CRIS, 'Camera', [\n wbFloat('FOV On Player Camera'),\n wbFloat('Rate Of Camera Change')\n ]),\n wbInteger(DEMO, 'Emotion Type', itU32, wbEmotionTypeEnum),\n wbInteger(DEVA, 'Emotion Value', itU32),\n wbArray(HTID, 'Player Headtracking', wbInteger('Actor ID', itS32)),\n wbFormIDCk(VENC, 'Dialogue Subtype', [KYWD]),\n wbFormIDCk(PNAM, 'AnimArchType', [KYWD]),\n wbFormIDCk(ONAM, 'Audio Output Override', [SOPM]),\n wbEmpty(ANAM, 'End Marker')\n ], [])),\n wbFormIDCk(PNAM, 'Quest', [QUST]),\n wbInteger(INAM, 'Last Action Index', itU32),\n wbUnknown(VNAM),\n wbFloat(CNAM, 'Camera Distance Override'),\n wbFloat(ACTV, 'Dialogue Distance Override'),\n wbFloat(CRIS, 'FOV Override'),\n wbKSIZ,\n wbKWDAs,\n wbCTDAs,\n wbStruct(SCQS, 'Set Parent Quest Stage', [\n wbInteger('On Begin', itS16),\n wbInteger('On End', itS16)\n ]),\n wbString(NNAM, 'Notes'),\n wbFormIDCk(TNAM, 'Template Scene', [SCEN]),\n wbInteger(XNAM, 'Index', itU32)\n ]);\n\n wbRecord(ASTP, 'Association Type', [\n wbEDID,\n wbString(MPRT, 'Male Parent Title'),\n wbString(FPRT, 'Female Parent Title'),\n wbString(MCHT, 'Male Child Title'),\n wbString(FCHT, 'Female Child Title'),\n wbInteger(DATA, 'Flags', itU32, wbFlags([\n 'Family Association'\n ]))\n ]);\nend;\n\nprocedure DefineFO4k;\nbegin\n\n wbSPED := wbStruct(SPED, 'Movement Data', [\n wbFloat('Unknown'),\n wbFloat('Walk - Left'),\n wbFloat('Run - Left'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Walk - Right'),\n wbFloat('Run - Right'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Walk - Forward'),\n wbFloat('Run - Forward'),\n wbFloat('Sprint - Forward'),\n wbFloat('Unknown'),\n wbFloat('Walk - Back'),\n wbFloat('Run - Back'),\n wbFloat('Unknown'),\n wbFloat('Standing - Pitch', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Walk - Pitch', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Run - Pitch', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Sprint - Pitch', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Unknown'{, cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize}),\n wbFloat('Unknown'{, cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize}),\n wbFloat('Unknown'{, cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize}),\n wbFloat('Unknown'{, cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize}),\n wbFloat('Standing - Yaw', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Walk - Yaw', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Run - Yaw', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Sprint - Yaw', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ], cpNormal, True, nil, 10);\n\n wbRecord(OTFT, 'Outfit', [\n wbEDID,\n wbArrayS(INAM, 'Items', wbFormIDCk('Item', [ARMO, LVLI]))\n ]);\n\n wbRecord(ARTO, 'Art Object', [\n wbEDID,\n wbOBNDReq,\n wbPTRN,\n wbKSIZ,\n wbKWDAs,\n wbMODL,\n wbInteger(DNAM, 'Art Type', itU32, wbEnum([\n 'Magic Casting',\n 'Magic Hit Effect',\n 'Enchantment Effect'\n ]))\n ]);\n\n wbRecord(MATO, 'Material Object', [\n wbEDID,\n wbMODL,\n wbRArray('Property Data',\n wbByteArray(DNAM, 'Data', 0, cpIgnore, False, False, wbNeverShow)\n ),\n wbStruct(DATA, 'Directional Material Data', [\n wbFloat('Falloff Scale'),\n wbFloat('Falloff Bias'),\n wbFloat('Noise UV Scale'),\n wbFloat('Material UV Scale'),\n wbStruct('Projection Vector', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbFloat('Normal Dampener'),\n wbFloatColors('Single Pass Color'),\n wbInteger('Flags', itU32, wbFlags(['Single Pass']))\n ], cpNormal, True, nil, 5)\n ]);\n\n wbRecord(MOVT, 'Movement Type', [\n wbEDID,\n wbString(MNAM, 'Name'),\n wbSPED,\n wbStruct(INAM, 'Anim Change Thresholds (unused)', [\n wbFloat('Directional', cpNormal, True, 180/Pi),\n wbFloat('Movement Speed'),\n wbFloat('Rotation Speed', cpNormal, True, 180/Pi)\n ]),\n wbFloat(JNAM, 'Float Height'),\n wbFloat(LNAM, 'Flight - Angle Gain')\n ]);\n\n wbRecord(SNDR, 'Sound Descriptor', [\n wbEDID,\n wbString(NNAM, 'Notes'),\n wbInteger(CNAM, 'Descriptor Type', itU32, wbEnum([], [\n Int64($1EEF540A), 'Standard',\n Int64($54651A43), 'Compound',\n Int64($ED157AE3), 'AutoWeapon'\n ])),\n wbFormIDCk(GNAM, 'Category', [SNCT]),\n wbFormIDCk(SNAM, 'Alternate Sound For', [SNDR]),\n wbRArray('Sounds',\n wbRStruct('Sound Files', [\n wbString(ANAM, 'File Name')\n ], [])\n ),\n wbFormIDCk(ONAM, 'Output Model', [SOPM]),\n wbCTDAs,\n wbStruct(LNAM, 'Values', [\n wbByteArray('Unknown', 1),\n wbInteger('Looping', itU8, wbEnum([], [\n $00, 'None',\n $08, 'Loop',\n $10, 'Envelope Fast',\n $20, 'Envelope Slow'\n ])),\n wbInteger('Sidechain', itU8),\n wbInteger('Rumble Send Value = (Small / 7) + ((Big / 7) * 16)', itU8)\n ]),\n wbUnion(BNAM, 'Data', wbSNDRDataDecider, [\n wbStruct('Values', [\n wbInteger('% Frequency Shift', itS8),\n wbInteger('% Frequency Variance', itS8),\n wbInteger('Priority', itU8),\n wbInteger('db Variance', itU8),\n wbInteger('Static Attenuation (db)', itU16, wbDiv(100))\n ]),\n wbFormIDCk('Base Descriptor', [SNDR])\n ]),\n wbRArray('Descriptors', wbFormIDCk(DNAM, 'Descriptor', [SNDR])),\n wbInteger(ITMC, 'Count', itU32, nil, cpBenign),\n wbRArrayS('Rates of Fire',\n wbRStructSK([1], 'Sound', [\n wbEmpty(ITMS, 'Marker Start'),\n wbInteger(INTV, 'RoF (RPM)', itU32),\n wbString(FNAM, 'File'),\n wbEmpty(ITME, 'Marker End')\n ], []),\n cpNormal, False, nil, wbSNDRRatesOfFireAfterSet\n )\n ]);\n\n wbRecord(DUAL, 'Dual Cast Data', [\n wbEDID\n ]);\n\n wbRecord(SNCT, 'Sound Category', [\n wbEDID,\n wbFULL,\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n {0x0000001} 'Mute When Submerged',\n {0x0000002} 'Should Appear on Menu',\n {0x0000004} 'Immune to Time Speedup',\n {0x0000008} 'Pause During Menus (Immed)',\n {0x0000010} 'Pause During Menus (Fade)',\n {0x0000020} 'Exclude from Player OPM Override',\n {0x0000040} 'Pause During Start Menu'\n ]), cpNormal, True),\n wbFormIDCk(PNAM, 'Parent Category', [SNCT]),\n wbFormIDCk(ONAM, 'Menu Slider Category', [SNCT]),\n wbInteger(VNAM, 'Static Volume Multiplier', itU16, wbDiv(65535)),\n wbInteger(UNAM, 'Default Menu Value', itU16, wbDiv(65535)),\n wbFloat(MNAM, 'Min Frequency Multiplier'),\n wbFloat(CNAM, 'Sidechain Target Multiplier')\n ]);\n\n wbRecord(SOPM, 'Sound Output Model', [\n wbEDID,\n wbStruct(NAM1, 'Data', [\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Attenuates With Distance',\n {0x02} 'Allows Rumble',\n {0x04} 'Applies Doppler',\n {0x08} 'Applies Distance Delay',\n {0x10} 'Player Output Model',\n {0x20} 'Try Play on Controller',\n {0x40} 'Causes Ducking',\n {0x80} 'Avoids Ducking'\n ])),\n wbByteArray('Unknown', 2),\n wbInteger('Reverb Send %', itU8)\n ]),\n wbInteger(MNAM, 'Type', itU32, wbEnum([\n 'Uses HRTF',\n 'Defined Speaker Output'\n ])),\n wbInteger(VNAM, 'Static Attenuation', itS16, wbDiv(100)),\n wbStruct(ONAM, 'Output Values', [\n wbArray('Channels', wbStruct('', [\n wbInteger('FL', itU8),\n wbInteger('FR', itU8),\n wbInteger('C', itU8),\n wbInteger('LFE', itU8),\n wbInteger('RL', itU8),\n wbInteger('RR', itU8),\n wbInteger('SL', itU8),\n wbInteger('SR', itU8)\n ]), [\n 'Channel 0',\n 'Channel 1',\n 'Channel 2? (unused)'\n ])\n ]),\n wbStruct(ATTN, 'Attenuation Values', [\n wbFloat('Fade In Distance - Start'),\n wbFloat('Fade In Distance - End'),\n wbFloat('Fade Out Distance - Start'),\n wbFloat('Fade Out Distance - End'),\n wbStruct('Fade In Curve', [\n wbInteger('Value 1', itU8),\n wbInteger('Value 2', itU8),\n wbInteger('Value 3', itU8),\n wbInteger('Value 4', itU8)\n ]),\n wbStruct('Fade Out Curve', [\n wbInteger('Value 1', itU8),\n wbInteger('Value 2', itU8),\n wbInteger('Value 3', itU8),\n wbInteger('Value 4', itU8)\n ])\n ]),\n wbFormIDCk(ENAM, 'Effect Chain', [AECH])\n ]);\n\n wbRecord(COLL, 'Collision Layer', [\n wbEDID,\n wbDESCReq,\n wbInteger(BNAM, 'Index', itU32, nil, cpNormal, True),\n wbStruct(FNAM, 'Debug Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbInteger('Unused', itU8)\n ], cpNormal, True),\n wbInteger(GNAM, 'Flags', itU32, wbFlags([\n {0x00000001} 'Trigger Volume',\n {0x00000002} 'Sensor',\n {0x00000004} 'Navmesh Obstacle'\n ]), cpNormal, True),\n wbString(MNAM, 'Name', 0, cpNormal, True),\n wbInteger(INTV, 'Interactables Count', itU32, nil, cpNormal, True),\n wbArrayS(CNAM, 'Collides With', wbFormIDCk('Forms', [COLL]), 0, cpNormal, False)\n ]);\n\n wbRecord(CLFM, 'Color',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Non-Playable'\n ])), [\n wbEDID,\n wbFULL,\n // union decider doesn't work during copying since decision data FNAM is located after it\n // workaround using integer formatters\n wbInteger(CNAM, 'Color/Index', itU32, wbCLFMColorToStr, wbCLFMColorToInt),\n {wbUnion(CNAM, 'Value', wbCLFMColorDecider, [\n wbByteColors('Color'),\n wbFloat('Remapping Index')\n ]),}\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n 'Playable',\n 'Remapping Index',\n 'Extended LUT'\n ]), cpNormal, True),\n wbCTDAs\n ]);\nend;\n\nprocedure DefineFO4l;\nbegin\n wbRecord(REVB, 'Reverb Parameters', [\n wbEDID,\n wbStruct(DATA, 'Data', [\n wbInteger('Decay Time (ms)', itU16),\n wbInteger('HF Reference (Hz)', itU16),\n wbInteger('Room Filter', itS8),\n wbInteger('Room HF Filter', itS8),\n wbInteger('Reflections', itS8),\n wbInteger('Reverb Amp', itS8),\n wbInteger('Decay HF Ratio', itU8, wbDiv(100)),\n wbInteger('Reflect Delay (ms), scaled', itU8),\n wbInteger('Reverb Delay (ms)', itU8),\n wbInteger('Diffusion %', itU8),\n wbInteger('Density %', itU8),\n wbInteger('Unknown', itU8)\n ], cpNormal, True),\n wbInteger(ANAM, 'Reverb Class', itU32, wbReverbClassEnum, cpNormal, True)\n ]);\n\n wbRecord(GRAS, 'Grass', [\n wbEDID,\n wbOBNDReq,\n wbMODL,\n wbStruct(DATA, '', [\n wbInteger('Density', itU8),\n wbInteger('Min Slope', itU8),\n wbInteger('Max Slope', itU8),\n wbByteArray('Unknown', 1),\n wbInteger('Units From Water', itU16),\n wbByteArray('Unknown', 2),\n wbInteger('Units From Water Type', itU32, wbEnum([\n 'Above - At Least',\n 'Above - At Most',\n 'Below - At Least',\n 'Below - At Most',\n 'Either - At Least',\n 'Either - At Most',\n 'Either - At Most Above',\n 'Either - At Most Below'\n ])),\n wbFloat('Position Range'),\n wbFloat('Height Range'),\n wbFloat('Color Range'),\n wbFloat('Wave Period'),\n wbInteger('Flags', itU8, wbFlags([\n 'Vertex Lighting',\n 'Uniform Scaling',\n 'Fit to Slope'\n ])),\n wbByteArray('Unknown', 3)\n ], cpNormal, True)\n ]);\n\n wbRecord(IDLE, 'Idle Animation', [\n wbEDID,\n wbCTDAs,\n wbString(DNAM, 'Behavior Graph'),\n wbString(ENAM, 'Animation Event'),\n wbArray(ANAM, 'Related Idle Animations', wbFormIDCk('Related Idle Animation', [AACT, IDLE, NULL]),\n ['Parent', 'Previous Sibling'], cpNormal, True),\n wbStruct(DATA, '', [\n wbStruct('Looping seconds (both 255 forever)', [\n wbInteger('Min', itU8),\n wbInteger('Max', itU8)\n ]),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Parent',\n {0x02} 'Sequence',\n {0x04} 'No Attacking',\n {0x04} 'Blocking'\n ], True)),\n wbInteger('Animation Group Section', itU8{, wbIdleAnam}),\n wbInteger('Replay Delay', itU16)\n ], cpNormal, True),\n wbString(GNAM, 'Animation File')\n ]);\n\n wbRecord(INFO, 'Dialog response',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000040} 6, 'Unknown 6',\n {0x00000080} 7, 'Exclude From Export',\n {0x00002000} 13, 'Actor Changed'\n ])), [\n wbEDID,\n wbVMADFragmentedINFO,\n wbStruct(ENAM, 'Response flags', [\n wbInteger('Flags', itU16, wbFlags([\n {0x0001} 'Start Scene on End',\n {0x0002} 'Random',\n {0x0004} 'Say Once',\n {0x0008} 'Requires Player Activation',\n {0x0010} 'Unknown 4',\n {0x0020} 'Random End',\n {0x0040} 'End Running Scene',\n {0x0080} 'ForceGreet Hello',\n {0x0100} 'Player Address',\n {0x0200} 'Unknown 9',\n {0x0400} 'Can Move While Greeting',\n {0x0800} 'No LIP File',\n {0x1000} 'Requires post-processing',\n {0x2000} 'Audio Output Override',\n {0x4000} 'Has Capture',\n {0x8000} 'Unknown 16'\n ])),\n wbInteger('Reset Hours', itU16, wbDiv(2730))\n ]),\n wbFormIDCk(TPIC, 'Topic', [DIAL]),\n wbFormIDCkNoReach(PNAM, 'Previous INFO', [INFO, NULL], False, cpBenign),\n wbFormIDCk(DNAM, 'Shared INFO', [INFO]),\n wbFormIDCk(GNAM, 'Unknown', [INFO]),\n wbString(IOVR, 'Override Filename'),\n\n wbRArray('Responses', wbRStruct('Response', [\n wbStruct(TRDA, 'Response Data', [\n wbFormIDCk('Emotion', [KYWD, FFFF]),\n wbInteger('Response number', itU8),\n wbByteArray('Unused', 3),\n wbByteArray('Unknown', 2),\n wbInteger('Interrupt Percentage', itU16),\n wbInteger('Camera Target Alias', itS32),\n wbInteger('Camera Location Alias', itS32)\n ]),\n wbLStringKC(NAM1, 'Response Text', 0, cpTranslate, True),\n wbString(NAM2, 'Script Notes', 0, cpNormal, True),\n wbString(NAM3, 'Edits', 0, cpNormal, True),\n wbString(NAM4, 'Alternate LIP Text', 0, cpNormal, True),\n wbFormIDCk(SNAM, 'Idle Animations: Speaker', [IDLE]),\n wbFormIDCk(LNAM, 'Idle Animations: Listener', [IDLE]),\n wbInteger(TNAM, 'Interrupt Percentage', itU16),\n wbByteArray(NAM9, 'Text Hash'),\n wbFormIDCk(SRAF, 'Camera Path', [CPTH]),\n wbEmpty(WZMD, 'Stop on Scene End')\n ], [])),\n\n wbCTDAs,\n wbLString(RNAM, 'Prompt', 0, cpTranslate),\n wbFormIDCk(ANAM, 'Speaker', [NPC_]),\n wbFormIDCk(TSCE, 'Start Scene', [SCEN]),\n wbInteger(ALFA, 'Forced Alias', itS32),\n wbUnknown(INTV),\n wbFormIDCk(ONAM, 'Audio Output Override', [SOPM]),\n wbInteger(GREE, 'Greet Distance', itU32),\n wbStruct(TIQS, 'Set Parent Quest Stage', [\n wbInteger('On Begin', itS16),\n wbInteger('On End', itS16)\n ]),\n wbString(NAM0, 'Start Scene Phase'),\n wbInteger(INCC, 'Challenge', itU32, wbEnum([\n {0} 'None',\n {1} 'Easy',\n {2} 'Medium',\n {3} 'Hard',\n {4} 'Always Succeeds',\n {5} 'Easy Repeatable',\n {6} 'Medium Repeatable',\n {7} 'Hard Repeatable'\n ])),\n wbFormIDCk(MODQ, 'Reset Global', [GLOB]),\n wbInteger(INAM, 'Subtitle Priority', itU32, wbEnum([\n 'Low',\n 'Normal',\n 'Unknown 2',\n 'Force'\n ]))\n ], False, wbINFOAddInfo, cpNormal, False, nil{wbINFOAfterLoad});\n\n wbRecord(INGR, 'Ingredient', [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbFULL,\n wbKSIZ,\n wbKWDAs,\n wbMODL,\n wbICON,\n wbMICO,\n wbDEST,\n wbETYP,\n wbYNAM,\n wbZNAM,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n wbStruct(ENIT, 'Effect Data', [\n wbInteger('Ingredient Value', itS32),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'No auto-calculation',\n {0x00000002} 'Food item',\n {0x00000004} 'Unknown 3',\n {0x00000008} 'Unknown 4',\n {0x00000010} 'Unknown 5',\n {0x00000020} 'Unknown 6',\n {0x00000040} 'Unknown 7',\n {0x00000080} 'Unknown 8',\n {0x00000100} 'References Persist'\n ]))\n ], cpNormal, True),\n wbEffectsReq\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n wbRecord(KEYM, 'Key',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000800} 11, 'Calc Value From Components',\n {0x00002000} 13, 'Pack-In Use Only'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULLReq,\n wbMODL,\n wbICON,\n wbMICO,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbKSIZ,\n wbKWDAs,\n wbStruct(DATA, '', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True)\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n wbQuadrantEnum := wbEnum([\n {0} 'Bottom Left',\n {1} 'Bottom Right',\n {2} 'Top Left',\n {3} 'Top Right'\n ]);\n\n if wbSimpleRecords then begin\n\n wbRecord(LAND, 'Landscape',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00040000} 18, 'Compressed'\n ]), [18]), [\n wbByteArray(DATA, 'Unknown'),\n wbByteArray(VNML, 'Vertex Normals'),\n wbByteArray(VHGT, 'Vertext Height Map'),\n wbByteArray(VCLR, 'Vertex Colours'),\n\n wbRArrayS('Layers', wbRUnion('Layer', [\n wbRStructSK([0],'Base Layer', [\n wbStructSK(BTXT, [1, 3], 'Base Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unknown', 1),\n wbInteger('Layer', itS16)\n ])\n ], []),\n wbRStructSK([0],'Alpha Layer', [\n wbStructSK(ATXT, [1, 3], 'Alpha Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unknown', 1),\n wbInteger('Layer', itS16)\n ]),\n wbByteArray(VTXT, 'Alpha Layer Data')\n ], [])\n ], [])),\n wbArray(VTEX, 'Textures', wbFormIDCk('Texture', [LTEX, NULL])),\n wbRArray('Unknown', wbUnknown(MPCD))\n ]);\n\n end else begin\n\n wbRecord(LAND, 'Landscape',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00040000} 18, 'Compressed'\n ]), [18]), [\n wbByteArray(DATA, 'Unknown'),\n wbArray(VNML, 'Vertex Normals', wbStruct('Row', [\n wbArray('Columns', wbStruct('Column', [\n wbInteger('X', itU8),\n wbInteger('Y', itU8),\n wbInteger('Z', itU8)\n ]), 33)\n ]), 33),\n wbStruct(VHGT, 'Vertext Height Map', [\n wbFloat('Offset'),\n wbArray('Rows', wbStruct('Row', [\n wbArray('Columns', wbInteger('Column', itU8), 33)\n ]), 33),\n wbByteArray('Unknown', 3)\n ]),\n wbArray(VCLR, 'Vertex Colours', wbStruct('Row', [\n wbArray('Columns', wbStruct('Column', [\n wbInteger('X', itU8),\n wbInteger('Y', itU8),\n wbInteger('Z', itU8)\n ]), 33)\n ]), 33),\n\n wbRArrayS('Layers', wbRUnion('Layer', [\n wbRStructSK([0],'Base Layer', [\n wbStructSK(BTXT, [1, 3], 'Base Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unknown', 1),\n wbInteger('Layer', itS16)\n ])\n ], []),\n wbRStructSK([0],'Alpha Layer', [\n wbStructSK(ATXT, [1, 3], 'Alpha Layer Header', [\n wbFormIDCk('Texture', [LTEX, NULL]),\n wbInteger('Quadrant', itU8, wbQuadrantEnum),\n wbByteArray('Unknown', 1),\n wbInteger('Layer', itS16)\n ]),\n wbArrayS(VTXT, 'Alpha Layer Data', wbStructSK([0], 'Cell', [\n wbInteger('Position', itU16, wbAtxtPosition),\n wbByteArray('Unknown', 2),\n wbFloat('Opacity')\n ]))\n ], [])\n ], [])),\n wbArray(VTEX, 'Textures', wbFormIDCk('Texture', [LTEX, NULL])),\n wbRArray('Unknown', wbUnknown(MPCD))\n ]);\n\n end;\n\n wbRecord(LIGH, 'Light',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00010000} 16, 'Random Anim Start',\n {0x00020000} 17, 'Unknown 17',\n {0x00020000} 25, 'Obstacle',\n {0x00020000} 28, 'Portal-strict'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbMODL,\n wbKSIZ,\n wbKWDAs,\n wbDEST,\n wbPRPS,\n wbFULL,\n wbICON,\n wbMICO,\n wbStruct(DATA, '', [\n wbInteger('Time', itS32),\n wbInteger('Radius', itU32),\n wbByteColors('Color'),\n // Omnidirectional is the default type\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Unknown 0',\n {0x00000002} 'Can be Carried',\n {0x00000004} 'Unknown 2',\n {0x00000008} 'Flicker',\n {0x00000010} 'Unknown 4',\n {0x00000020} 'Off By Default',\n {0x00000040} 'Unknown 6',\n {0x00000080} 'Pulse',\n {0x00000100} 'Unknown 8',\n {0x00000200} 'Unknown 9',\n {0x00000400} 'Shadow Spotlight',\n {0x00000800} 'Shadow Hemisphere',\n {0x00001000} 'Shadow OmniDirectional',\n {0x00002000} 'Unknown 13',\n {0x00004000} 'NonShadow Spotlight',\n {0x00008000} 'Non Specular',\n {0x00010000} 'Attenuation Only',\n {0x00020000} 'NonShadow Box',\n {0x00040000} 'Ignore Roughness',\n {0x00080000} 'No Rim Lighting',\n {0x00100000} 'Ambient Only',\n {0x00200000} 'Unknown 21' // only in [001C7F0C] \n ])),\n wbFloat('Falloff Exponent'),\n wbFloat('FOV'),\n wbFloat('Near Clip'),\n wbStruct('Flicker Effect', [\n wbFloat('Period'),\n wbFloat('Intensity Amplitude'),\n wbFloat('Movement Amplitude')\n ]),\n wbFloat('Constant'),\n wbFloat('Scalar'),\n wbFloat('Exponent'),\n wbFloat('God Rays - Near Clip'),\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ], cpNormal, True, nil, 10),\n wbFloat(FNAM, 'Fade value', cpNormal, True),\n wbString(NAM0, 'Gobo'),\n wbFormIDCk(LNAM, 'Lens', [LENS]),\n wbFormIDCk(WGDR, 'God Rays', [GDRY]),\n wbFormIDCk(SNAM, 'Sound', [SNDR])\n ], False, nil, cpNormal, False, wbLIGHAfterLoad);\nend;\n\nprocedure DefineFO4m;\nbegin\n\n wbRecord(LSCR, 'Load Screen',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000400} 10, 'Displays In Main Menu',\n {0x00008000} 15, 'No Rotation'\n ])), [\n wbEDID,\n wbDESCReq,\n wbCTDAs,\n wbFormIDCk(NNAM, 'Loading Screen NIF', [STAT, SCOL, NULL], False, cpNormal, True),\n wbFormIDCk(TNAM, 'Transform', [TRNS]),\n wbStruct(ONAM, 'Rotation', [\n wbInteger('Min', itS16),\n wbInteger('Max', itS16)\n ]),\n wbStruct(ZNAM, 'Zoom', [\n wbFloat('Min'),\n wbFloat('Max')\n ]),\n wbString(MOD2, 'Camera Path', 0, cpNormal, False)\n ]);\n\n wbRecord(LTEX, 'Landscape Texture', [\n wbEDID,\n wbFormIDCk(TNAM, 'Texture Set', [TXST], False, cpNormal, False),\n wbFormIDCk(MNAM, 'Material Type', [MATT, NULL], False, cpNormal, True),\n wbStruct(HNAM, 'Havok Data', [\n wbInteger('Friction', itU8),\n wbInteger('Restitution', itU8)\n ], cpNormal, True),\n wbInteger(SNAM, 'Texture Specular Exponent', itU8, nil, cpNormal, True),\n wbRArray('Grasses', wbFormIDCk(GNAM, 'Grass', [GRAS]))\n ]);\n\n wbRecord(LVLN, 'Leveled NPC', [\n wbEDID,\n wbOBNDReq,\n wbLVLD,\n wbInteger(LVLM, 'Max Count', itU8), { Always 00 } {Unavailable}\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count',\n {0x04} 'Calculate All' {Still picks just one}\n ]), cpNormal, True),\n wbFormIDCk(LVLG, 'Use Global', [GLOB]),\n wbLLCT,\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itU16),\n wbByteArray('Unused', 2, cpIgnore, false, wbNeverShow),\n wbFormIDCk('Reference', [NPC_, LVLN]),\n wbInteger('Count', itS16),\n wbInteger('Chance None', itU8),\n wbByteArray('Unused', 1, cpIgnore, false, wbNeverShow)\n ]),\n\t\t\t\twbCOED\n ], []), cpNormal, False, nil, wbLVLOsAfterSet),\n wbArrayS(LLKC, 'Filter Keyword Chances',\n wbStructSK([0], 'Filter', [\n wbFormIDCk('Keyword', [KYWD]),\n wbInteger('Chance', itU32)\n ])\n ),\n wbMODL\n ], False, nil, cpNormal, False, wbLLEAfterLoad, wbLLEAfterSet);\n\n wbRecord(LVLI, 'Leveled Item', [\n wbEDID,\n wbOBNDReq,\n wbLVLD,\n wbInteger(LVLM, 'Max Count', itU8), { Always 00 }\n wbInteger(LVLF, 'Flags', itU8, wbFlags([\n {0x01} 'Calculate from all levels <= player''s level',\n {0x02} 'Calculate for each item in count',\n {0x04} 'Use All'\n ]), cpNormal, True),\n wbFormIDCk(LVLG, 'Use Global', [GLOB]),\n wbLLCT,\n wbRArrayS('Leveled List Entries',\n wbRStructExSK([0], [1], 'Leveled List Entry', [\n wbStructExSK(LVLO , [0, 2], [3], 'Base Data', [\n wbInteger('Level', itU16),\n wbByteArray('Unused', 2, cpIgnore, false, wbNeverShow),\n wbFormIDCk('Reference', sigBaseObjects),\n wbInteger('Count', itU16),\n wbInteger('Chance None', itU8),\n wbByteArray('Unused', 1, cpIgnore, false, wbNeverShow)\n ]),\n wbCOED\n ], []), cpNormal, False, nil, wbLVLOsAfterSet\n ),\n wbArrayS(LLKC, 'Filter Keyword Chances',\n wbStructSK([0], 'Filter', [\n wbFormIDCk('Keyword', [KYWD]),\n wbInteger('Chance', itU32)\n ])\n ),\n wbFormIDCk(LVSG, 'Epic Loot Chance', [GLOB]),\n wbLStringKC(ONAM, 'Override Name', 0, cpTranslate)\n ], False, nil, cpNormal, False, wbLLEAfterLoad, wbLLEAfterSet);\n\n wbRecord(LVSP, 'Leveled Spell', [\n wbEDID\n ]);\n\n wbMGEFType := wbInteger('Archetype', itU32, wbEnum([\n {00} 'Value Modifier',\n {01} 'Script',\n {02} 'Dispel',\n {03} 'Cure Disease',\n {04} 'Absorb',\n {05} 'Dual Value Modifier',\n {06} 'Calm',\n {07} 'Demoralize',\n {08} 'Frenzy',\n {09} 'Disarm',\n {10} 'Command Summoned',\n {11} 'Invisibility',\n {12} 'Light',\n {13} 'Darkness',\n {14} 'Nighteye',\n {15} 'Lock',\n {16} 'Open',\n {17} 'Bound Weapon',\n {18} 'Summon Creature',\n {19} 'Detect Life',\n {20} 'Telekinesis',\n {21} 'Paralysis',\n {22} 'Reanimate',\n {23} 'Soul Trap',\n {24} 'Turn Undead',\n {25} 'Guide',\n {26} 'Unknown 26',\n {27} 'Cure Paralysis',\n {28} 'Cure Addiction',\n {29} 'Cure Poison',\n {30} 'Concussion',\n {31} 'Stimpack',\n {32} 'Accumulate Magnitude',\n {33} 'Stagger',\n {34} 'Peak Value Modifier',\n {35} 'Cloak',\n {36} 'Unknown 36',\n {37} 'Slow Time',\n {38} 'Rally',\n {39} 'Enhance Weapon',\n {40} 'Spawn Hazard',\n {41} 'Etherealize',\n {42} 'Banish',\n {43} 'Spawn Scripted Ref',\n {44} 'Disguise',\n {45} 'Damage',\n {46} 'Immunity',\n {47} 'Permanent Reanimate',\n {48} 'Jetpack',\n {49} 'Chameleon'\n ]), cpNormal, False, nil, wbMGEFArchtypeAfterSet);\n\n wbMGEFData := wbRStruct('Magic Effect Data', [\n wbStruct(DATA, 'Data', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Hostile',\n {0x00000002} 'Recover',\n {0x00000004} 'Detrimental',\n {0x00000008} 'Snap to Navmesh',\n {0x00000010} 'No Hit Event',\n\t\t\t\t{0x00000020} 'Unknown 6',\n\t\t\t\t{0x00000040} 'Unknown 7',\n\t\t\t\t{0x00000080} 'Unknown 8',\n\t\t\t\t{0x00000100} 'Dispel with Keywords',\n\t\t\t\t{0x00000200} 'No Duration',\n\t\t\t\t{0x00000400} 'No Magnitude',\n\t\t\t\t{0x00000800} 'No Area',\n\t\t\t\t{0x00001000} 'FX Persist',\n\t\t\t\t{0x00002000} 'Unknown 14',\n\t\t\t\t{0x00004000} 'Gory Visuals',\n\t\t\t\t{0x00008000} 'Hide in UI',\n\t\t\t\t{0x00010000} 'Unknown 17',\n\t\t\t\t{0x00020000} 'No Recast',\n\t\t\t\t{0x00040000} 'Unknown 19',\n\t\t\t\t{0x00080000} 'Unknown 20',\n\t\t\t\t{0x00100000} 'Unknown 21',\n\t\t\t\t{0x00200000} 'Power Affects Magnitude',\n\t\t\t\t{0x00400000} 'Power Affects Duration',\n\t\t\t\t{0x00800000} 'Unknown 24',\n\t\t\t\t{0x01000000} 'Unknown 25',\n\t\t\t\t{0x02000000} 'Unknown 26',\n\t\t\t\t{0x04000000} 'Painless',\n\t\t\t\t{0x08000000} 'No Hit Effect',\n\t\t\t\t{0x10000000} 'No Death Dispel',\n\t\t\t\t{0x20000000} 'Unknown 30',\n\t\t\t\t{0x40000000} 'Unknown 31',\n\t\t\t\t{0x80000000} 'Unknown 32'\n\t\t\t])),\n wbFloat('Base Cost'),\n wbUnion('Assoc. Item', wbMGEFAssocItemDecider, [\n wbFormID('Unused', cpIgnore),\n wbFormIDCk('Assoc. Item', [LIGH, NULL]),\n wbFormIDCk('Assoc. Item', [WEAP, ARMO, NULL]),\n wbFormIDCk('Assoc. Item', [NPC_, NULL]),\n wbFormIDCk('Assoc. Item', [HAZD, NULL]),\n wbFormIDCk('Assoc. Item', [SPEL, NULL]),\n wbFormIDCk('Assoc. Item', [RACE, NULL]),\n wbFormIDCk('Assoc. Item', [ENCH, NULL]),\n wbFormIDCk('Assoc. Item', [KYWD, NULL])\n ], cpNormal, False, nil, wbMGEFAssocItemAfterSet),\n wbByteArray('Magic Skill (unused)', 4),\n wbFormIDCk('Resist Value', [AVIF, NULL]),\n wbInteger('Counter Effect count', itU16),\n wbByteArray('Unused', 2),\n wbFormIDCk('Casting Light', [LIGH, NULL]),\n wbFloat('Taper Weight'),\n wbFormIDCk('Hit Shader', [EFSH, NULL]),\n wbFormIDCk('Enchant Shader', [EFSH, NULL]),\n wbInteger('Minimum Skill Level', itU32),\n wbStruct('Spellmaking', [\n wbInteger('Area', itU32),\n wbFloat('Casting Time')\n ]),\n wbFloat('Taper Curve'),\n wbFloat('Taper Duration'),\n wbFloat('Second AV Weight', cpNormal, False, nil, wbMGEFAV2WeightAfterSet),\n wbMGEFType,\n wbActorValue,\n wbFormIDCk('Projectile', [PROJ, NULL]),\n wbFormIDCk('Explosion', [EXPL, NULL]),\n wbInteger('Casting Type', itU32, wbCastEnum),\n wbInteger('Delivery', itU32, wbTargetEnum),\n wbActorValue, //wbInteger('Second Actor Value', itS32, wbActorValueEnum),\n wbFormIDCk('Casting Art', [ARTO, NULL]),\n wbFormIDCk('Hit Effect Art', [ARTO, NULL]),\n wbFormIDCk('Impact Data', [IPDS, NULL]),\n wbFloat('Skill Usage Multiplier'),\n wbStruct('Dual Casting', [\n wbFormIDCk('Art', [DUAL, NULL]),\n wbFloat('Scale')\n ]),\n wbFormIDCk('Enchant Art', [ARTO, NULL]),\n wbByteArray('Unknown', 4),\n wbByteArray('Unknown', 4),\n wbFormIDCk('Equip Ability', [SPEL, NULL]),\n wbFormIDCk('Image Space Modifier', [IMAD, NULL]),\n wbFormIDCk('Perk to Apply', [PERK, NULL]),\n wbInteger('Casting Sound Level', itU32, wbSoundLevelEnum),\n wbStruct('Script Effect AI', [\n wbFloat('Score'),\n wbFloat('Delay Time')\n ])\n ], cpNormal, True)\n ], []);\n\n wbRecord(MGEF, 'Magic Effect', [\n wbEDID,\n wbVMAD,\n wbFULL,\n wbMDOB,\n wbKSIZ,\n wbKWDAs,\n wbMGEFData,\n wbRArrayS('Counter Effects', wbFormIDCk(ESCE, 'Effect', [MGEF]), cpNormal, False, nil, wbCounterEffectsAfterSet),\n wbArray(SNDD, 'Sounds', wbStruct('', [\n wbInteger('Type', itU32, wbEnum([\n 'Sheathe/Draw',\n 'Charge',\n 'Ready',\n 'Release',\n 'Concentration Cast Loop',\n 'On Hit'\n ])),\n wbFormIDCk('Sound', [SNDR])\n ])),\n wbLStringKC(DNAM, 'Magic Item Description', 0, cpTranslate),\n wbCTDAs\n ], False, nil, cpNormal, False, nil {wbMGEFAfterLoad}, wbMGEFAfterSet);\n\n wbRecord(MISC, 'Misc. Item',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 11, 'Calc From Components',\n {0x00000004} 13, 'Pack-In Use Only'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbICON,\n wbMICO,\n wbDEST,\n wbYNAM,\n wbZNAM,\n wbKSIZ,\n wbKWDAs,\n wbFormID(FIMD, 'Featured Item Message'),\n wbStruct(DATA, 'Data', [\n wbInteger('Value', itS32),\n wbFloat('Weight')\n ], cpNormal, True),\n // the amount of components is the same as size of CDIX, so should not be sorted probably\n wbStructs(CVPA, 'Components', 'Component', [\n wbFormIDCk('Component', sigBaseObjects), // CK allows only CMPO\n wbInteger('Count', itU32)\n ]),\n wbArray(CDIX, 'Component Display Indices', wbInteger('Display Index', itU8))\n ], False, nil, cpNormal, False, wbRemoveEmptyKWDA, wbKeywordsAfterSet);\n\n wbRecord(COBJ, 'Constructible Object', [\n wbEDID,\n wbYNAM,\n wbZNAM,\n wbArrayS(FVPA, 'Components',\n wbStructSK([0], 'Component', [\n wbFormIDCk('Component', sigBaseObjects),\n wbInteger('Count', itU32)\n ])\n ),\n wbDESC,\n wbCTDAs,\n wbFormIDCk(CNAM, 'Created Object', sigBaseObjects),\n wbFormIDCk(BNAM, 'Workbench Keyword', [KYWD]),\n wbByteArray(NAM1, 'Unused', 0, cpIgnore, False, False, wbNeverShow), // co_PA_FusionCore01\n wbByteArray(NAM2, 'Unused', 0, cpIgnore, False, False, wbNeverShow), // co_PA_FusionCore01\n wbByteArray(NAM3, 'Unused', 0, cpIgnore, False, False, wbNeverShow), // co_PA_FusionCore01\n wbFormIDCk(ANAM, 'Menu Art Object', [ARTO]),\n wbArrayS(FNAM, 'Category', wbFormIDCk('Keyword', [KYWD])),\n wbStruct(INTV, 'Data', [\n wbInteger('Created Object Count', itU16),\n wbInteger('Priority', itU16)\n ], cpNormal, False, nil, 1)\n ]);\n\n wbRecord(NPC_, 'Non-Player Character (Actor)',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000400} 10, 'Unknown 10',\n {0x00040000} 18, 'Compressed',\n {0x00080000} 19, 'Unknown 19',\n {0x20000000} 29, 'Bleedout Override'\n ]), [18]), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFormIDCk(STCP, 'Unknown', [STAG]),\n wbStruct(ACBS, 'Configuration', [\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Female',\n {0x00000002} 'Essential',\n {0x00000004} 'Is CharGen Face Preset',\n {0x00000008} 'Respawn',\n {0x00000010} 'Auto-calc stats',\n {0x00000020} 'Unique',\n {0x00000040} 'Doesn''t affect stealth meter',\n {0x00000080} 'PC Level Mult',\n {0x00000100} 'Unknown 8',\n {0x00000200} 'Calc For Each Template',\n {0x00000400} 'Unknown 10',\n {0x00000800} 'Protected',\n {0x00001000} 'Unknown 12',\n {0x00002000} 'Unknown 13',\n {0x00004000} 'Summonable',\n {0x00008000} 'Unknown 15',\n {0x00010000} 'Doesn''t bleed',\n {0x00020000} 'Unknown 17',\n {0x00040000} 'Bleedout Override',\n {0x00080000} 'Opposite Gender Anims',\n {0x00100000} 'Simple Actor',\n {0x00200000} 'Unknown 21',\n {0x00400000} 'Unknown 22',\n {0x00800000} 'No Activation/Hellos',\n {0x01000000} 'Diffuse Alpha Test',\n {0x02000000} 'Unknown 25',\n {0x04000000} 'Unknown 26',\n {0x08000000} 'Unknown 27',\n {0x10000000} 'Unknown 28',\n {0x20000000} 'Is Ghost',\n {0x40000000} 'Unknown 30',\n {0x80000000} 'Invulnerable'\n ])),\n wbInteger('XP Value Offset', itS16, nil, cpNormal, True, nil{wbActorTemplateUseStats}),\n wbUnion('Level', wbNPCLevelDecider, [\n wbInteger('Level', itS16, nil, cpNormal, True, nil{wbActorTemplateUseStats}),\n wbInteger('Level Mult', itS16, wbDiv(1000), cpNormal, True, nil{wbActorTemplateUseStats})\n ], cpNormal, True, nil{wbActorTemplateUseStats}),\n wbInteger('Calc min level', itU16, nil, cpNormal, True, nil{wbActorTemplateUseStats}),\n wbInteger('Calc max level', itU16, nil, cpNormal, True, nil{wbActorTemplateUseStats}),\n wbInteger('Disposition Base', itS16),\n wbInteger('Use Template Actors', itU16, wbFlags([\n {0x0001} 'Traits',\n {0x0002} 'Stats',\n {0x0004} 'Factions',\n {0x0008} 'Spell List',\n {0x0010} 'AI Data',\n {0x0020} 'AI Packages',\n {0x0040} 'Model/Animation',\n {0x0080} 'Base Data',\n {0x0100} 'Inventory',\n {0x0200} 'Script',\n {0x0400} 'Def Pack List',\n {0x0800} 'Attack Data',\n {0x1000} 'Keywords'\n ])),\n wbInteger('Bleedout Override', itU16),\n wbByteArray('Unknown', 2)\n ], cpNormal, True),\n wbRArrayS('Factions',\n wbStructSK(SNAM, [0], 'Faction', [\n wbFormIDCk('Faction', [FACT]),\n wbInteger('Rank', itS8)\n ]), cpNormal, False, nil, nil, nil{wbActorTemplateUseFactions}\n ),\n wbFormIDCk(INAM, 'Death item', [LVLI], False, cpNormal, False, nil{wbActorTemplateUseTraits}),\n wbFormIDCk(VTCK, 'Voice', [VTYP], False, cpNormal, False, nil{wbActorTemplateUseTraits}),\n wbFormIDCk(TPLT, 'Default Template', [LVLN, NPC_]),\n wbFormIDCk(LTPT, 'Legendary Template', [LVLN, NPC_]),\n wbFormIDCk(LTPC, 'Legendary Chance', [GLOB]),\n wbStruct(TPTA, 'Template Actors', [\n wbFormIDCk('Traits', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate0),\n wbFormIDCk('Stats', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate1),\n wbFormIDCk('Factions', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate2),\n wbFormIDCk('Spell List', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate3),\n wbFormIDCk('AI Data', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate4),\n wbFormIDCk('AI Packages', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate5),\n wbFormIDCk('Model/Animation', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate6),\n wbFormIDCk('Base Data', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate7),\n wbFormIDCk('Inventory', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate8),\n wbFormIDCk('Script', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate9),\n wbFormIDCk('Def Pack List', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate10),\n wbFormIDCk('Attack Data', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate11),\n wbFormIDCk('Keywords', [LVLN, NPC_, NULL], False, cpNormal, False, wbActorTemplatesUseTemplate12)\n ]),\n wbFormIDCk(RNAM, 'Race', [RACE], False, cpNormal, True, nil{wbActorTemplateUseTraits}),\n wbSPCT,\n wbSPLOs,\n wbDEST,\n wbFormIDCk(WNAM, 'Skin', [ARMO], False, cpNormal, False),\n wbFormIDCk(ANAM, 'Far away model', [ARMO], False, cpNormal, False, nil{wbActorTemplateUseTraits}),\n wbFormIDCk(ATKR, 'Attack Race', [RACE], False, cpNormal, False),\n wbRArrayS('Attacks', wbAttackData),\n wbFormIDCk(SPOR, 'Spectator Override Package List', [FLST]),\n wbFormIDCk(OCOR, 'Observe Dead Body Override Package List', [FLST]),\n wbFormIDCk(GWOR, 'Guard Warn Override Package List', [FLST]),\n wbFormIDCk(ECOR, 'Combat Override Package List', [FLST]),\n wbFormIDCk(FCPL, 'Follower Command Package List', [FLST]),\n wbFormIDCk(RCLR, 'Follower Elevator Package List', [FLST]),\n wbInteger(PRKZ, 'Perk Count', itU32, nil, cpBenign),\n wbRArrayS('Perks',\n wbStructSK(PRKR, [0], 'Perk', [\n wbFormIDCk('Perk', [PERK]),\n wbInteger('Rank', itU8)\n ]), cpNormal, False, nil, wbPRKRsAfterSet\n ),\n wbPRPS,\n wbFTYP,\n wbNTRM,\n wbCOCT,\n wbCNTOs,\n wbAIDT,\n wbRArray('Packages', wbFormIDCk(PKID, 'Package', [PACK]), cpNormal, False, nil{wbActorTemplateUseAIPackages}),\n wbKSIZ,\n wbKWDAs,\n wbAPPR,\n wbObjectTemplate,\n wbFormIDCk(CNAM, 'Class', [CLAS], False, cpNormal, True),\n wbFULL,\n wbLString(SHRT, 'Short Name', 0, cpTranslate),\n wbByteArray(DATA, 'Marker'),\n wbStruct(DNAM, '', [\n wbInteger('Unknown', itU16),\n wbInteger('Unknown', itU16),\n wbInteger('Far Away Model Distance', itU16),\n wbInteger('Geared Up Weapons', itU16)\n ]),\n wbRArrayS('Head Parts', wbFormIDCk(PNAM, 'Head Part', [HDPT]), cpNormal, False, nil, nil, nil{wbActorTemplateUseModelAnimation}),\n wbFormIDCk(HCLF, 'Hair Color', [CLFM], False, cpNormal, False),\n wbFormIDCk(BCLF, 'Facial Hair Color', [CLFM], False, cpNormal, False),\n wbFormIDCk(ZNAM, 'Combat Style', [CSTY], False, cpNormal, False),\n wbFormIDCk(GNAM, 'Gift Filter', [FLST], False, cpNormal, False),\n wbUnknown(NAM5, cpNormal, True),\n wbFloat(NAM6, 'Height Min', cpNormal, True),\n wbFloat(NAM7, 'Unused', cpNormal, True),\n wbFloat(NAM4, 'Height Max'),\n wbStruct(MWGT, 'Weight', [\n wbFloat('Thin'),\n wbFloat('Muscular'),\n wbFloat('Fat')\n ]),\n wbInteger(NAM8, 'Sound Level', itU32, wbSoundLevelEnum, cpNormal, True),\n wbRStruct('Actor Sounds', [\n wbInteger(CS2H, 'Count', itU32, nil, cpBenign, True),\n wbRArrayS('Sounds',\n wbRStructSK([0], 'Sound', [\n wbFormIDCk(CS2K, 'Keyword', [KYWD]),\n wbFormIDCk(CS2D, 'Sound', [SNDR], False, cpNormal, True)\n ], [], cpNormal, False, nil, True),\n cpNormal, False, nil, wbNPCActorSoundsAfterSet\n ),\n wbEmpty(CS2E, 'End Marker', cpNormal, True),\n wbByteArray(CS2F, 'Finalize', 1, cpNormal, True)\n ], []),\n wbFormIDCk(CSCR, 'Inherits Sounds From', [NPC_], False, cpNormal, False),\n wbFormIDCk(PFRN, 'Power Armor Stand', [FURN]),\n wbFormIDCk(DOFT, 'Default Outfit', [OTFT], False, cpNormal, False),\n wbFormIDCk(SOFT, 'Sleeping Outfit', [OTFT], False, cpNormal, False),\n wbFormIDCk(DPLT, 'Default Package List', [FLST], False, cpNormal, False),\n wbFormIDCk(CRIF, 'Crime Faction', [FACT], False, cpNormal, False),\n wbFormIDCk(FTST, 'Head Texture', [TXST], False, cpNormal, False),\n wbStruct(QNAM, 'Texture lighting', [\n wbFloat('Red', cpNormal, True, 255, 0),\n wbFloat('Green', cpNormal, True, 255, 0),\n wbFloat('Blue', cpNormal, True, 255, 0),\n wbFloat('Alpha')\n ]),\n wbArray(MSDK, 'Morph Keys', wbInteger('Key', itU32, wbMorphValueToStr, wbHexStrToInt)),\n wbArray(MSDV, 'Morph Values', wbFloat('Value')),\n wbRArrayS('Face Tinting Layers',\n wbRStructSK([0], 'Layer', [\n wbStructSK(TETI, [1], 'Index', [\n wbInteger('Data Type', itU16, wbEnum(['', 'Value/Color', 'Value'])),\n wbInteger('Index', itU16, wbTintLayerToStr, wbStrToInt)\n ]),\n //wbByteArray(TEND, 'Data')\n wbStruct(TEND, 'Data', [\n wbInteger('Value', itU8, wbDiv(100)),\n wbByteColors('Color'),\n wbInteger('Template Color Index', itS16)\n ], cpNormal, True, nil, 1)\n ], [])\n ),\n wbStruct(MRSV, 'Body Morph Region Values', [\n wbFloat('Head'),\n wbFloat('Upper Torso'),\n wbFloat('Arms'),\n wbFloat('Lower Torso'),\n wbFloat('Legs')\n ]),\n // reported to cause issues when sorted\n wbRArrayS('Face Morphs',\n wbRStructSK([0], 'Face Morph', [\n wbInteger(FMRI, 'Index', itU32, wbFaceMorphToStr, wbHexStrToInt),\n //wbArray(FMRS, 'Unknown', wbFloat('Unknown'))\n wbStruct(FMRS, 'Values', [\n wbFloat('Position - X'),\n wbFloat('Position - Y'),\n wbFloat('Position - Z'),\n wbFloat('Rotation - X'),\n wbFloat('Rotation - Y'),\n wbFloat('Rotation - Z'),\n wbFloat('Scale'),\n wbByteArray('Unknown')\n ])\n ], [])\n ),\n wbFloat(FMIN, 'Facial Morph Intensity'),\n wbATTX\n ], False, nil, cpNormal, False, wbNPCAfterLoad, wbNPCAfterSet);\n\n wbPKDTSpecificFlagsUnused := False;\n\n wbPKDTFlags := wbFlags([\n {0x00000001} 'Offers Services',\n {0x00000002} 'Unknown 2',\n {0x00000004} 'Must complete',\n {0x00000008} 'Maintain Speed at Goal',\n {0x00000010} 'Treat As Player Follower',\n {0x00000020} 'Unknown 6',\n {0x00000040} 'Unlock doors at package start',\n {0x00000080} 'Unlock doors at package end',\n {0x00000100} 'Request Block Idles',\n {0x00000200} 'Continue if PC Near',\n {0x00000400} 'Once per day',\n {0x00000800} 'Unknown 12',\n {0x00001000} 'Skip Load Into Furniture',\n {0x00002000} 'Preferred Speed',\n {0x00004000} 'Unknown 15',\n {0x00008000} 'Unknown 16',\n {0x00010000} 'Unknown 17',\n {0x00020000} 'Always Sneak',\n {0x00040000} 'Allow Swimming',\n {0x00080000} 'Unknown 20',\n {0x00100000} 'Ignore Combat',\n {0x00200000} 'Weapons Unequipped',\n {0x00400000} 'Unknown 23',\n {0x00800000} 'Weapon Drawn',\n {0x01000000} 'Unknown 25',\n {0x02000000} 'Unknown 26',\n {0x04000000} 'Unknown 27',\n {0x08000000} 'No Combat Alert',\n {0x10000000} 'Unknown 29',\n {0x20000000} 'Wear Sleep Outfit',\n {0x40000000} 'Unknown 31',\n {0x80000000} 'Unknown 32'\n ], [29]);\n\n wbPKDTInterruptFlags := wbFlags([\n {0x0001} 'Hellos to player',\n {0x0002} 'Random conversations',\n {0x0004} 'Observe combat behavior',\n {0x0008} 'Greet corpse behavior',\n {0x0010} 'Reaction to player actions',\n {0x0020} 'Friendly fire comments',\n {0x0040} 'Aggro Radius Behavior',\n {0x0080} 'Allow Idle Chatter',\n {0x0100} 'Unknown 9',\n {0x0200} 'World Interactions',\n {0x0400} 'Off For Important Scene',\n {0x0800} 'Unknown 12',\n {0x1000} 'Unknown 13',\n {0x2000} 'Unknown 14',\n {0x4000} 'Unknown 15',\n {0x8000} 'Unknown 16'\n ]);\nend;\n\n\nprocedure DefineFO4n;\n\n function wbTintTemplateGroups(const aName: string): IwbSubRecordArrayDef;\n begin\n Result :=\n wbRStructs(aName, 'Group', [\n wbLString(TTGP, 'Group Name', 0, cpTranslate),\n wbRStructs('Options', 'Option', [\n wbStruct(TETI, 'Index', [\n wbByteArray('Unknown', 2),\n wbInteger('Index', itU16)\n ]),\n wbLString(TTGP, 'Name', 0, cpTranslate),\n wbUnknown(TTEF),\n wbCTDAs,\n wbRArray('Textures', wbString(TTET, 'Texture')),\n wbUnknown(TTEB),\n wbArray(TTEC, 'Template Colors', wbStruct('Template Color', [\n wbFormIDCk('Color', [CLFM]),\n wbFloat('Alpha'),\n wbInteger('Template Index', itU16),\n wbByteArray('Unknown', 4)\n ])),\n wbFloat(TTED, 'Unknown')\n ], []),\n wbByteArray(TTGE, 'Group End', 4)\n ], []);\n end;\n\n function wbMorphGroups(const aName: string): IwbSubRecordArrayDef;\n begin\n Result :=\n wbRArray(aName,\n wbRStruct('Morph Group', [\n wbString(MPGN, 'Name'),\n wbInteger(MPPC, 'Count', itU32, nil, cpBenign),\n wbRArray('Morph Presets',\n wbRStruct('Morph Preset', [\n wbInteger(MPPI, 'Index', itU32, wbIntToHexStr, wbHexStrToInt),\n wbLString(MPPN, 'Name', 0, cpTranslate),\n wbString(MPPM, 'Unknown'),\n wbFormIDCk(MPPT, 'Texture', [TXST]),\n wbUnknown(MPPF)\n ], []),\n cpNormal, False, nil, wbMorphPresetsAfterSet\n ),\n wbUnknown(MPPK),\n wbUnknown(MPGS)\n ], [])\n );\n end;\n\n function wbFaceMorphs(const aName: string): IwbSubRecordArrayDef;\n begin\n Result :=\n wbRArray(aName,\n wbRStruct('Face Morph', [\n wbInteger(FMRI, 'Index', itU32, wbIntToHexStr, wbHexStrToInt),\n wbLString(FMRN, 'Name')\n ], [])\n );\n end;\n\nbegin\n wbUNAMs := wbRArray('Data Inputs', wbRStruct('Data Input', [\n wbInteger(UNAM, 'Index', itS8),\n wbString(BNAM, 'Name'),\n wbInteger(PNAM, 'Flags', itU32, wbFlags([\n 'Public'\n ]))\n ], []));\n\n wbRecord(PACK, 'Package', [\n wbEDID,\n wbVMADFragmentedPACK,\n\n wbStruct(PKDT, 'Pack Data', [\n wbInteger('General Flags', itU32, wbPKDTFlags),\n wbInteger('Type', itU8, wbEnum ([], [\n 18, 'Package',\n 19, 'Package Template'\n ])),\n wbInteger('Interrupt Override', itU8, wbEnum([\n {0} 'None',\n {1} 'Spectator',\n {2} 'ObserveDead',\n {3} 'GuardWarn',\n {4} 'Combat',\n {5} 'Command Travel',\n {6} 'Command Activate',\n {7} 'Leave Workstation'\n ])),\n wbInteger('Preferred Speed', itU8, wbEnum([\n 'Walk',\n 'Jog',\n 'Run',\n 'Fast Walk'\n ])),\n wbByteArray('Unknown', 1),\n wbInteger('Interrupt Flags', itU16, wbPKDTInterruptFlags),\n wbByteArray('Unknown', 2)\n ], cpNormal, True),\n\n wbStruct(PSDT, 'Schedule', [\n wbInteger('Month', itS8),\n wbInteger('Day of week', itS8, wbEnum([\n 'Sunday',\n 'Monday',\n 'Tuesday',\n 'Wednesday',\n 'Thursday',\n 'Friday',\n 'Saturday',\n 'Weekdays',\n 'Weekends',\n 'Monday, Wednesday, Friday',\n 'Tuesday, Thursday'\n ], [\n -1, 'Any'\n ])),\n wbInteger('Date', itU8),\n wbInteger('Hour', itS8),\n wbInteger('Minute', itS8),\n wbByteArray('Unused', 3, cpIgnore),\n wbInteger('Duration (minutes)', itS32)\n ], cpNormal, True),\n\n wbCTDAs,\n\n wbRStruct('Idle Animations', [\n wbInteger(IDLF, 'Flags', itU8, wbEnum([], [\n 0, 'Unknown',\n 8, 'Random',\n 9, 'Run in Sequence',\n 12, 'Random, Do Once',\n 13, 'Run in Sequence, Do Once'\n ]), cpNormal, True),\n wbInteger(IDLC, 'Animation Count', itU8, nil, cpBenign),\n wbFloat(IDLT, 'Idle Timer Setting', cpNormal, True),\n wbArray(IDLA, 'Animations', wbFormIDCk('Animation', [IDLE]), 0, nil, wbIDLAsAfterSet, cpNormal, True),\n wbByteArray(IDLB, 'Unknown', 4, cpIgnore)\n ], [], cpNormal, False, nil, False, nil {cannot be totally removed , wbAnimationsAfterSet}),\n\n wbFormIDCk(CNAM, 'Combat Style', [CSTY]),\n wbFormIDCk(QNAM, 'Owner Quest', [QUST]),\n wbStruct(PKCU, 'Counter', [\n wbInteger('Data Input Count', itU32),\n wbFormIDCk('Package Template', [PACK, NULL]),\n wbInteger('Version Counter (autoincremented)', itU32)\n ], cpNormal, True),\n\n wbRStruct('Package Data', [\n wbRArray('Data Input Values', wbRStruct('Value', [\n wbString(ANAM, 'Type'),\n wbUnion(CNAM, 'Value', wbPubPackCNAMDecider, [\n {0} wbByteArray('Unknown'),\n {1} wbInteger('Bool', itU8, wbBoolEnum),\n {2} wbInteger('Integer', itU32),\n {3} wbFloat('Float')\n ]),\n wbUnknown(BNAM),\n wbPDTOs,\n wbPLDT,\n wbStruct(PTDA, 'Target', [wbTargetData]),\n wbUnknown(TPIC)\n ], [], cpNormal, False)),\n wbUNAMs\n ], []),\n wbByteArray(XNAM, 'Marker'),\n\n wbRStruct('Procedure Tree', [\n wbRArray('Branches', wbRStruct('Branch', [\n wbString(ANAM, 'Branch Type'),\n wbCITC,\n wbCTDAsCount,\n wbStruct(PRCB, 'Root', [\n wbInteger('Branch Count', itU32),\n wbInteger('Flags', itU32, wbFlags([\n 'Repeat when Complete',\n 'Unknown 1'\n ]))\n ]),\n wbString(PNAM, 'Procedure Type'),\n wbInteger(FNAM, 'Flags', itU32, wbFlags(['Success Completes Package'])),\n wbRArray('Data Input Indexes', wbInteger(PKC2, 'Index', itU8)),\n {>>> PFO2 should be single, there is only 1 PACK [00095F46] in Skyrim.esm with 2xPFO2 <<<}\n wbRArray('Flags Override',\n wbStruct(PFO2, 'Data', [\n wbInteger('Set General Flags', itU32, wbPKDTFlags),\n wbInteger('Clear General Flags', itU32, wbPKDTFlags),\n wbInteger('Set Interrupt Flags', itU16, wbPKDTInterruptFlags),\n wbInteger('Clear Interrupt Flags', itU16, wbPKDTInterruptFlags),\n wbInteger('Preferred Speed Override', itU8, wbEnum([\n 'Walk',\n 'Jog',\n 'Run',\n 'Fast Walk'\n ])),\n wbByteArray('Unknown', 3)\n ])\n ),\n wbRArray('Unknown', wbUnknown(PFOR), cpIgnore)\n ], [], cpNormal, False, nil, False, nil, wbConditionsAfterSet))\n ], []),\n wbUNAMs,\n wbRStruct('OnBegin', [\n wbEmpty(POBA, 'OnBegin Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbPDTOs\n ], []),\n wbRStruct('OnEnd', [\n wbEmpty(POEA, 'OnEnd Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbPDTOs\n ], []),\n wbRStruct('OnChange', [\n wbEmpty(POCA, 'OnChange Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbPDTOs\n ], [])\n ], False, nil, cpNormal, False, nil {wbPACKAfterLoad});\n\n wbQUSTAliasFlags :=\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n {0x00000001} 'Reserves Location/Reference',\n {0x00000002} 'Optional',\n {0x00000004} 'Quest Object',\n {0x00000008} 'Allow Reuse in Quest',\n {0x00000010} 'Allow Dead',\n {0x00000020} 'Matching Ref - In Loaded Area',\n {0x00000040} 'Essential',\n {0x00000080} 'Allow Disabled',\n {0x00000100} 'Stores Text',\n {0x00000200} 'Allow Reserved',\n {0x00000400} 'Protected',\n {0x00000800} 'Forced by Aliases',\n {0x00001000} 'Allow Destroyed',\n {0x00002000} 'Matching Ref - Closest',\n {0x00004000} 'Uses Stored Text',\n {0x00008000} 'Initially Disabled',\n {0x00010000} 'Allow Cleared',\n {0x00020000} 'Clear Names When Removed',\n {0x00040000} 'Matching Ref - Actors Only',\n {0x00080000} 'Create Ref - Temp',\n {0x00100000} 'External Alias - Linked',\n {0x00200000} 'No Pickpocket',\n {0x00400000} 'Can Apply Data To Non-Aliased Refs',\n {0x00800000} 'Is Companion',\n {0x01000000} 'Optional All Scenes'\n ]));\n\n wbRecord(QUST, 'Quest',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00004000} 14, 'Partial Form'\t// Allows the Record to inherit some subrecords from its master\n ])), [\n wbEDID,\n wbVMADFragmentedQUST,\n wbFULL,\n wbStruct(DNAM, 'General', [\n wbInteger('Flags', itU16, wbFlags([\n {0x0001} 'Start Game Enabled',\n {0x0002} 'Unknown 2',\n {0x0004} 'Add Idle Topic To Hello',\n {0x0008} 'Allow repeated stages',\n {0x0010} 'Unknown 5',\n {0x0020} 'Unknown 6',\n {0x0040} 'Unknown 7',\n {0x0080} 'Unknown 8',\n {0x0100} 'Run Once',\n {0x0200} 'Exclude from dialogue export',\n {0x0400} 'Warn on alias fill failure',\n {0x0800} 'Unknown 12',\n {0x1000} 'Unknown 13'\n ])),\n wbInteger('Priority', itU8),\n wbInteger('Form Version', itU8, nil, cpIgnore),\n wbByteArray('Unknown', 4),\n wbInteger('Type', itU32, wbEnum([\n {0} 'None',\n {1} 'Main Quest',\n {2} 'Brotherhood of Steel',\n {3} 'Institute',\n {4} 'Minutemen',\n {5} 'Railroad',\n {6} 'Miscellaneous',\n {7} 'Side Quests',\n {8} 'DLC01',\n {9} 'DLC02',\n {10} 'DLC03',\n {11} 'DLC04',\n {12} 'DLC05',\n {13} 'DLC06',\n {14} 'DLC07'\n ]))\n ]),\n wbString(ENAM, 'Event', 4),\n wbFormIDCk(LNAM, 'Location', [LCTN]),\n wbFormIDCk(XNAM, 'Quest Completion XP', [GLOB]),\n wbRArray('Text Display Globals', wbFormIDCk(QTGL, 'Global', [GLOB])),\n wbFLTR,\n wbRStruct('Quest Dialogue Conditions', [wbCTDAs], [], cpNormal, False),\n wbEmpty(NEXT, 'Marker'),\n wbCTDAs, {>>> Unknown, doesn't show up in CK <<<}\n wbRArrayS('Stages', wbRStructSK([0], 'Stage', [\n wbStructSK(INDX, [0], 'Stage Index', [\n wbInteger('Stage Index', itU16),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Unknown 1',\n {0x02} 'Run On Start',\n {0x04} 'Run On Stop',\n {0x08} 'Keep Instance Data From Here On'\n ])),\n wbInteger('Unknown', itU8)\n ]),\n wbRArray('Log Entries', wbRStruct('Log Entry', [\n wbInteger(QSDT, 'Stage Flags', itU8, wbFlags([\n {0x01} 'Complete Quest',\n {0x02} 'Fail Quest'\n ])),\n wbCTDAs,\n wbString(NAM2, 'Note'),\n wbLString(CNAM, 'Log Entry', 0, cpTranslate),\n wbFormIDCk(NAM0, 'Next Quest', [QUST])\n ], []))\n ], [])),\n wbRArray('Objectives', wbRStruct('Objective', [\n wbInteger(QOBJ, 'Objective Index', itU16),\n wbInteger(FNAM, 'Flags', itU32, wbFlags([\n {0x01} 'ORed With Previous',\n {0x02} 'No Stats Tracking'\n ])),\n wbLString(NNAM, 'Display Text', 0, cpTranslate, True),\n wbRArray('Targets', wbRStruct('Target', [\n wbStruct(QSTA, 'Target', [\n wbInteger('Alias', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbInteger('Flags', itU32, wbFlags([\n {0x01} 'Compass Marker Ignores Locks',\n {0x02} 'Hostile',\n {0x04} 'Use Straight Line Pathing'\n ])),\n wbFormIDCk('Keyword', [KYWD, NULL])\n ]),\n wbCTDAs\n ], []))\n ], [])),\n\n wbByteArray(ANAM, 'Aliases Marker', 4),\n\n wbRArray('Aliases',\n wbRUnion('Alias', [\n\n // Reference Alias\n wbRStruct('Alias', [\n wbInteger(ALST, 'Reference Alias ID', itU32),\n wbString(ALID, 'Alias Name'),\n wbQUSTAliasFlags,\n wbInteger(ALFI, 'Force Into Alias When Filled', itS32, wbQuestAliasToStr, wbStrToAlias),\n //wbFormIDCk(ALFL, 'Specific Location', [LCTN]),\n wbFormID(ALFR, 'Forced Reference'),\n wbFormIDCk(ALUA, 'Unique Actor', [NPC_]),\n wbRStruct('Location Alias Reference', [\n wbInteger(ALFA, 'Alias', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbFormIDCk(KNAM, 'Keyword', [KYWD]),\n wbFormIDCk(ALRT, 'Ref Type', [LCRT])\n ], []),\n wbRStruct('External Alias Reference', [\n wbFormIDCk(ALEQ, 'Quest', [QUST]),\n wbInteger(ALEA, 'Alias', itS32, wbQuestExternalAliasToStr, wbStrToAlias)\n ], []),\n wbRStruct('Create Reference to Object', [\n wbFormID(ALCO, 'Object'),\n wbStruct(ALCA, 'Alias', [\n wbInteger('Alias', itS16, wbQuestAliasToStr, wbStrToAlias),\n wbInteger('Create', itU16, wbEnum([] ,[\n $0000, 'At',\n $8000, 'In'\n ]))\n ]),\n wbInteger(ALCL, 'Level', itU32, wbEnum([\n 'Easy',\n 'Medium',\n 'Hard',\n 'Very Hard',\n 'None'\n ]))\n ], []),\n wbRStruct('Find Matching Reference Near Alias', [\n wbInteger(ALNA, 'Alias', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbInteger(ALNT, 'Type', itU32, wbEnum([\n 'Linked From',\n 'Linked Ref'\n ]))\n ], []),\n wbRStruct('Find Matching Reference From Event', [\n wbString(ALFE, 'From Event', 4),\n wbByteArray(ALFD, 'Event Data')\n ], []),\n wbInteger(ALCC, 'Closest To Alias', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbCTDAs,\n wbKSIZ,\n wbKWDAs,\n wbCOCT,\n wbCNTOs,\n wbFormIDCk(SPOR, 'Spectator override package list', [FLST], False, cpNormal, False),\n wbFormIDCk(OCOR, 'Observe dead body override package list', [FLST], False, cpNormal, False),\n wbFormIDCk(GWOR, 'Guard warn override package list', [FLST], False, cpNormal, False),\n wbFormIDCk(ECOR, 'Combat override package list', [FLST], False, cpNormal, False),\n wbArray(ALLA, 'Linked Aliases', wbStruct('Linked Alias', [\n wbFormIDCk('Keyword', [KYWD, NULL]),\n wbInteger('Alias', itS32, wbQuestAliasToStr, wbStrToAlias)\n ])),\n wbFormIDCk(ALDN, 'Display Name', [MESG]),\n wbFormIDCk(ALFV, 'Forced Voice', [VTYP]),\n wbFormIDCk(ALDI, 'Death Item', [LVLI]),\n wbRArrayS('Alias Spells', wbFormIDCk(ALSP, 'Spell', [SPEL])),\n wbRArrayS('Alias Factions', wbFormIDCk(ALFC, 'Faction', [FACT])),\n wbRArray('Alias Package Data', wbFormIDCk(ALPC, 'Package', [PACK])),\n wbFormIDCk(VTCK, 'Voice Types', [NPC_, FACT, FLST, VTYP, NULL]),\n wbEmpty(ALED, 'Alias End', cpNormal, True)\n ], [], cpNormal, False, nil, False, nil, wbContainerAfterSet),\n\n // Location Alias\n wbRStruct('Alias', [\n wbInteger(ALLS, 'Location Alias ID', itU32),\n wbString(ALID, 'Alias Name'),\n wbQUSTAliasFlags,\n wbInteger(ALFI, 'Force Into Alias When Filled', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbFormIDCk(ALFL, 'Specific Location', [LCTN]),\n wbRStruct('Reference Alias Location', [\n wbInteger(ALFA, 'Alias', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbFormIDCk(KNAM, 'Keyword', [KYWD])\n ], []),\n wbRStruct('External Alias Location', [\n wbFormIDCk(ALEQ, 'Quest', [QUST]),\n wbInteger(ALEA, 'Alias', itS32, wbQuestExternalAliasToStr, wbStrToAlias)\n ], []),\n wbRStruct('Find Matching Location From Event', [\n wbString(ALFE, 'From Event', 4),\n wbByteArray(ALFD, 'Event Data')\n ], []),\n wbCTDAs,\n wbInteger(ALCC, 'Closest To Alias', itS32, wbQuestAliasToStr, wbStrToAlias),\n wbEmpty(ALED, 'Alias End', cpNormal, True)\n ], []),\n\n // Ref Collection Alias\n wbRStruct('Alias', [\n wbInteger(ALCS, 'Collection Alias ID', itU32),\n wbInteger(ALMI, 'Max Initial Fill Count', itU8)\n ], [])\n\n ], [])\n ),\n\n wbString(NNAM, 'Description', 0, cpTranslate, False),\n wbFormIDCk(GNAM, 'Quest Group', [KYWD]),\n wbString(SNAM, 'SWF File')\n ]);\n\n wbBodyPartIndexEnum := wbEnum([\n 'Body Texture'\n ]);\n\n wbPhonemeTargets := wbStruct(PHWT, 'Phoneme Target Weight', [\n wbFloat('Aah / LipBigAah'),\n wbFloat('BigAah / LipDST'),\n wbFloat('BMP / LipEee'),\n wbFloat('ChJsh / LipFV'),\n wbFloat('DST / LipK'),\n wbFloat('Eee / LipL'),\n wbFloat('Eh / LipR'),\n wbFloat('FV / LipTh'),\n wbFloat('I'),\n wbFloat('K'),\n wbFloat('N'),\n wbFloat('Oh'),\n wbFloat('OohQ'),\n wbFloat('R'),\n wbFloat('TH'),\n wbFloat('W'),\n wbUnknown\n ], cpNormal, False, nil, 1); // only a single value in HandyRace\n\n wbPHWT := wbRStruct('FaceFX Phonemes', [\n wbRStruct('IY', [wbPhonemeTargets], []),\n wbRStruct('IH', [wbPhonemeTargets], []),\n wbRStruct('EH', [wbPhonemeTargets], []),\n wbRStruct('EY', [wbPhonemeTargets], []),\n wbRStruct('AE', [wbPhonemeTargets], []),\n wbRStruct('AA', [wbPhonemeTargets], []),\n wbRStruct('AW', [wbPhonemeTargets], []),\n wbRStruct('AY', [wbPhonemeTargets], []),\n wbRStruct('AH', [wbPhonemeTargets], []),\n wbRStruct('AO', [wbPhonemeTargets], []),\n wbRStruct('OY', [wbPhonemeTargets], []),\n wbRStruct('OW', [wbPhonemeTargets], []),\n wbRStruct('UH', [wbPhonemeTargets], []),\n wbRStruct('UW', [wbPhonemeTargets], []),\n wbRStruct('ER', [wbPhonemeTargets], []),\n wbRStruct('AX', [wbPhonemeTargets], []),\n wbRStruct('S', [wbPhonemeTargets], []),\n wbRStruct('SH', [wbPhonemeTargets], []),\n wbRStruct('Z', [wbPhonemeTargets], []),\n wbRStruct('ZH', [wbPhonemeTargets], []),\n wbRStruct('F', [wbPhonemeTargets], []),\n wbRStruct('TH', [wbPhonemeTargets], []),\n wbRStruct('V', [wbPhonemeTargets], []),\n wbRStruct('DH', [wbPhonemeTargets], []),\n wbRStruct('M', [wbPhonemeTargets], []),\n wbRStruct('N', [wbPhonemeTargets], []),\n wbRStruct('NG', [wbPhonemeTargets], []),\n wbRStruct('L', [wbPhonemeTargets], []),\n wbRStruct('R', [wbPhonemeTargets], []),\n wbRStruct('W', [wbPhonemeTargets], []),\n wbRStruct('Y', [wbPhonemeTargets], []),\n wbRStruct('HH', [wbPhonemeTargets], []),\n wbRStruct('B', [wbPhonemeTargets], []),\n wbRStruct('D', [wbPhonemeTargets], []),\n wbRStruct('JH', [wbPhonemeTargets], []),\n wbRStruct('G', [wbPhonemeTargets], []),\n wbRStruct('P', [wbPhonemeTargets], []),\n wbRStruct('T', [wbPhonemeTargets], []),\n wbRStruct('K', [wbPhonemeTargets], []),\n wbRStruct('CH', [wbPhonemeTargets], []),\n wbRStruct('SIL', [wbPhonemeTargets], []),\n wbRStruct('SHOTSIL', [wbPhonemeTargets], []),\n wbRStruct('FLAP', [wbPhonemeTargets], [])\n ], []);\n\n wbHeadPart := wbRStructSK([0], 'Head Part', [\n wbInteger(INDX, 'Head Part Number', itU32),\n wbFormIDCk(HEAD, 'Head', [HDPT, NULL])\n ], []);\n\n wbRaceRBPC :=\n wbArray(RBPC, 'Biped Object Conditions',\n wbUnion('Slot 30+', wbFormVer78Decider, [\n wbInteger('Slot 30+', itU32),\n wbFormIDCk('Slot 30+', [AVIF, NULL])\n ])\n );\n // since version 78: array of pair of AVIF FormID, before array of AVIF index. Similar to DamageType (and MGEF also somehow).\n {wbUnion(RBPC, 'Biped Object Conditions', wbFormVer78Decider, [\n wbArray('Biped Object Conditions', wbInteger('Condition AV', itU32)),\n wbArray('Biped Object Conditions', wbStruct('Condition AV', [\n wbFormIDck('AVIF 1', [AVIF, NULL]),\n wbFormIDck('AVIF 2', [AVIF, NULL])\n ]))\n ]);}\n\n wbRecord(RACE, 'Race',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00080000} 19, 'Unknown 19'\n ])), [\n wbEDID,\n wbFormIDCk(STCP, 'Sound', [STAG]),\n wbFULL,\n wbDESCReq,\n wbSPCT,\n wbSPLOs,\n wbFormIDCk(WNAM, 'Skin', [ARMO, NULL]),\n wbBOD2,\n wbKSIZ,\n wbKWDAs,\n wbPRPS,\n wbAPPR,\n wbStruct(DATA, 'Data', [\n wbFloat('Male Height'),\n wbFloat('Female Height'),\n wbStruct('Male Default Weight', [\n wbFloat('Thin'),\n wbFloat('Muscular'),\n wbFloat('Fat')\n ]),\n wbStruct('Female Default Weight', [\n wbFloat('Thin'),\n wbFloat('Muscular'),\n wbFloat('Fat')\n ]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Playable',\n {0x00000002} 'FaceGen Head',\n {0x00000004} 'Child',\n {0x00000008} 'Tilt Front/Back',\n {0x00000010} 'Tilt Left/Right',\n {0x00000020} 'No Shadow',\n {0x00000040} 'Swims',\n {0x00000080} 'Flies',\n {0x00000100} 'Walks',\n {0x00000200} 'Immobile',\n {0x00000400} 'Not Pushable',\n {0x00000800} 'No Combat In Water',\n {0x00001000} 'No Rotating to Head-Track',\n {0x00002000} 'Don''t Show Blood Spray',\n {0x00004000} 'Don''t Show Blood Decal',\n {0x00008000} 'Uses Head Track Anims',\n {0x00010000} 'Spells Align w/Magic Node',\n {0x00020000} 'Use World Raycasts For FootIK',\n {0x00040000} 'Allow Ragdoll Collision',\n {0x00080000} 'Regen HP In Combat',\n {0x00100000} 'Can''t Open Doors',\n {0x00200000} 'Allow PC Dialogue',\n {0x00400000} 'No Knockdowns',\n {0x00800000} 'Allow Pickpocket',\n {0x01000000} 'Always Use Proxy Controller',\n {0x02000000} 'Don''t Show Weapon Blood',\n {0x04000000} 'Overlay Head Part List', {>>>Only one can be active<<<}\n {0x08000000} 'Override Head Part List', {>>>Only one can be active<<<}\n {0x10000000} 'Can Pickup Items',\n {0x20000000} 'Allow Multiple Membrane Shaders',\n {0x40000000} 'Can Dual Wield',\n {0x80000000} 'Avoids Roads'\n ])),\n wbFloat('Acceleration Rate'),\n wbFloat('Deceleration Rate'),\n wbInteger('Size', itU32, wbEnum([\n 'Small',\n 'Medium',\n 'Large',\n 'Extra Large'\n ])),\n wbByteArray('Unknown', 8),\n wbFloat('Injured Health Pct'),\n wbInteger('Shield Biped Object', itS32, wbBipedObjectEnum),\n wbInteger('Beard Biped Object', itS32, wbBipedObjectEnum),\n wbInteger('Body Biped Object', itS32, wbBipedObjectEnum),\n wbFloat('Aim Angle Tolerance'),\n wbFloat('Flight Radius'),\n wbFloat('Angular Acceleration Rate'),\n wbFloat('Angular Tolerance'),\n wbInteger('Flags 2', itU32, wbFlags([\n {0x00000001} 'Use Advanced Avoidance',\n {0x00000002} 'Non-Hostile',\n {0x00000004} 'Floats',\n {0x00000008} 'Unknown 3',\n {0x00000010} 'Unknown 4',\n {0x00000020} 'Head Axis Bit 0',\n {0x00000040} 'Head Axis Bit 1',\n {0x00000080} 'Can Melee When Knocked Down',\n {0x00000100} 'Use Idle Chatter During Combat',\n {0x00000200} 'Ungendered',\n {0x00000400} 'Can Move When Knocked Down',\n {0x00000800} 'Use Large Actor Pathing',\n {0x00001000} 'Use Subsegmented Damage',\n {0x00002000} 'Flight - Defer Kill',\n {0x00004000} 'Unknown 14',\n {0x00008000} 'Flight - Allow Procedural Crash Land',\n {0x00010000} 'Disable Weapon Culling',\n {0x00020000} 'Use Optimal Speeds',\n {0x00040000} 'Has Facial Rig',\n {0x00080000} 'Can Use Crippled Limbs',\n {0x00100000} 'Use Quadruped Controller',\n {0x00200000} 'Low Priority Pushable',\n {0x00400000} 'Cannot Use Playable Items'\n ])),\n wbByteArray('Unknown', 36),\n wbInteger('Pipboy Biped Object', itS32, wbBipedObjectEnum),\n wbInteger('XP Value', itS16),\n wbFloat('Severable - Debris Scale'),\n wbInteger('Severable - Debris Count', itU8),\n wbInteger('Severable - Decal Count', itU8),\n wbFloat('Explodable - Debris Scale'),\n wbInteger('Explodable - Debris Count', itU8),\n wbInteger('Explodable - Decal Count', itU8),\n wbFormIDCk('Severable - Explosion', [EXPL, NULL]),\n wbFormIDCk('Severable - Debris', [DEBR, NULL]),\n wbFormIDCk('Severable - Impact DataSet', [IPDS, NULL]),\n wbFormIDCk('Explodable - Explosion', [EXPL, NULL]),\n wbFormIDCk('Explodable - Debris', [DEBR, NULL]),\n wbFormIDCk('Explodable - Impact DataSet', [IPDS, NULL]),\n wbFloat('OnCripple - Debris Scale'),\n wbInteger('OnCripple - Debris Count', itU8),\n wbInteger('OnCripple - Decal Count', itU8),\n wbFormIDCk('OnCripple - Explosion', [EXPL, NULL]),\n wbFormIDCk('OnCripple - Debris', [DEBR, NULL]),\n wbFormIDCk('OnCripple - Impact DataSet', [IPDS, NULL]),\n wbFormIDCk('Explodable - Subsegment Explosion', [EXPL, NULL]),\n wbFloat('Orientation Limits - Pitch'),\n wbFloat('Orientation Limits - Roll')\n ], cpNormal, True),\n\n wbEmpty(MNAM, 'Male Marker'),\n wbString(ANAM, 'Male Skeletal Model'),\n wbMODT,\n wbEmpty(FNAM, 'Female Marker'),\n wbString(ANAM, 'Female Skeletal Model'),\n wbMODT,\n wbEmpty(NAM2, 'Marker NAM2 #1'),\n wbRArrayS('Movement Type Names', wbString(MTNM, 'Name')),\n wbArray(VTCK, 'Voices', wbFormIDCk('Voice', [VTYP]), ['Male', 'Female'], cpNormal, True),\n //wbArray(DNAM, 'Decapitate Armors', wbFormIDCk('Decapitate Armor', [NULL, ARMO]), ['Male', 'Female'], cpNormal, False),\n wbArray(HCLF, 'Default Hair Colors', wbFormIDCk('Default Hair Color', [NULL, CLFM]), ['Male', 'Female'], cpNormal, False),\n wbInteger(TINL, 'Total Number of Tints in List', itU16, nil, nil, cpNormal, False), {>>> Needs Count Updated <<<}\n wbFloat(PNAM, 'FaceGen - Main clamp', cpNormal, True),\n wbFloat(UNAM, 'FaceGen - Face clamp', cpNormal, True),\n\n wbFormIDCk(ATKR, 'Attack Race', [RACE], False, cpNormal, False),\n wbRArrayS('Attacks', wbAttackData),\n\n wbRStruct('Body Data', [\n wbEmpty(NAM1, 'Body Data Marker', cpNormal, True),\n wbRStruct('Male Body Data', [\n wbEmpty(MNAM, 'Male Data Marker'),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbBodyPartIndexEnum),\n wbMODL\n ], []), cpNormal, True)\n ], [], cpNormal, True),\n wbRStruct('Female Body Data', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbRArrayS('Parts', wbRStructSK([0], 'Part', [\n wbInteger(INDX, 'Index', itU32, wbBodyPartIndexEnum),\n wbMODL\n ], []), cpNormal, True)\n ], [], cpNormal, True)\n ], [], cpNormal, True),\n wbFormIDCk(GNAM, 'Body Part Data', [BPTD]),\n\n\t wbEmpty(NAM2, 'Marker NAM2 #2', cpNormal),\n\t wbEmpty(NAM3, 'Marker NAM3 #3', cpNormal, True),\n wbRStruct('Male Behavior Graph', [\n wbEmpty(MNAM, 'Male Data Marker'),\n wbMODL\n ], [], cpNormal, True),\n wbRStruct('Female Behavior Graph', [\n wbEmpty(FNAM, 'Female Data Marker', cpNormal, True),\n wbMODL\n ], [], cpNormal, True),\n\n wbFormIDCk(NAM4, 'Impact Material Type', [MATT]),\n wbFormIDCk(NAM5, 'Impact Data Set', [IPDS]),\n\t\twbFormIDCk(NAM7, 'Dismember Blood Art', [ARTO]),\n\t\twbFormIDCk(CNAM, 'Meat Cap TextureSet', [TXST]),\n\t\twbFormIDCk(NAM2, 'Collar TextureSet', [TXST]),\n wbFormIDCk(ONAM, 'Sound - Open Corpse', [SNDR]),\n wbFormIDCk(LNAM, 'Sound - Close Corpse', [SNDR]),\n wbRArray('Biped Object Names', wbString(NAME, 'Name')),\n wbRaceRBPC,\n wbRArrayS('Movement Data Overrides', wbRStructSK([0], 'Override', [\n wbFormIDCk(MTYP, 'Movement Type', [MOVT]),\n wbSPED\n ], [])),\n wbInteger(VNAM, 'Equipment Flags', itU32, wbEquipType),\n wbRArray('Equip Slots',\n wbRStruct('Equip Slot', [\n wbFormIDCk(QNAM, 'Equip Slot', [EQUP]),\n wbString(ZNAM, 'Node')\n ], [])\n ),\n wbFormIDCk(UNWP, 'Unarmed Weapon', [WEAP]),\n\n wbRArray('Phoneme Target Names', wbString(PHTN, 'Name')),\n wbPHWT,\n\n wbFormIDCk(WKMV, 'Base Movement Defaults - Default', [MOVT]),\n wbFormIDCk(SWMV, 'Base Movement Defaults - Swim', [MOVT]),\n wbFormIDCk(FLMV, 'Base Movement Defaults - Fly', [MOVT]),\n wbFormIDCk(SNMV, 'Base Movement Defaults - Sneak', [MOVT]),\n\n // Male head\n wbEmpty(NAM0, 'Head Data Marker'),\n wbEmpty(MNAM, 'Male Data Marker'),\n wbStruct(NNAM, 'Male Neck Fat Adjustments Scale', [\n wbByteArray('Unknown', 4),\n wbFloat('X'),\n wbFloat('Y')\n ]),\n wbRArrayS('Male Head Parts', wbHeadPart),\n wbRArray('Male Race Presets', wbFormIDCk(RPRM, 'Preset NPC', [NPC_, NULL])),\n wbRArray('Male Hair Colors', wbFormIDCk(AHCM, 'Hair Color', [CLFM, NULL])),\n wbRArrayS('Male Face Details', wbFormIDCk(FTSM, 'Texture Set', [TXST, NULL])),\n wbFormIDCk(DFTM, 'Male Default Face Texture', [TXST]),\n wbTintTemplateGroups('Male Tint Layers'),\n wbMorphGroups('Male Morph Groups'),\n wbFaceMorphs('Male Face Morphs'),\n wbString(WMAP, 'Male Wrinkle Map Path'),\n\n // Female head\n wbEmpty(NAM0, 'Head Data Marker'),\n wbEmpty(FNAM, 'Female Data Marker'),\n wbStruct(NNAM, 'Female Neck Fat Adjustments Scale', [\n wbByteArray('Unknown', 4),\n wbFloat('X'),\n wbFloat('Y')\n ]),\n wbRArrayS('Female Head Parts', wbHeadPart),\n wbRArray('Female Race Presets', wbFormIDCk(RPRF, 'Preset NPC', [NPC_, NULL])),\n wbRArray('Female Hair Colors', wbFormIDCk(AHCF, 'Hair Color', [CLFM, NULL])),\n wbRArrayS('Female Face Details', wbFormIDCk(FTSF, 'Texture Set', [TXST, NULL])),\n wbFormIDCk(DFTF, 'Female Default Face Texture', [TXST]),\n wbTintTemplateGroups('Female Tint Layers'),\n wbMorphGroups('Female Morph Groups'),\n wbFaceMorphs('Female Face Morphs'),\n wbString(WMAP, 'Female Wrinkle Map Path'),\n\n\t\twbFormIDCk(NAM8, 'Morph Race', [RACE]),\n wbFormIDCk(RNAM, 'Armor Race', [RACE]),\n wbFormIDCk(SRAC, 'Subgraph Template Race', [RACE]),\n wbFormIDCk(SADD, 'Subgraph Additive Race', [RACE]),\n wbRArray('Subgraph Data',\n wbRStruct('Data', [\n wbString(SGNM, 'Behaviour Graph'),\n wbRArray('Actor Keywords', wbFormIDCk(SAKD, 'Keyword', [KYWD])),\n wbRArray('Target Keywords', wbFormIDCk(STKD, 'Keyword', [KYWD])),\n wbRArray('Animation Paths', wbString(SAPT, 'Path'), cpNormal, True),\n // Values greater than $10000 sets a bool. Reading this \"closes\" the current record.\n wbStruct(SRAF, 'Flags', [\n wbInteger('Role', itU16, wbEnum([\n {0} 'MT',\n {1} 'Weapon',\n {2} 'Furniture',\n {3} 'Idle',\n {4} 'Pipboy'\n ])),\n wbInteger('Perspective', itU16, wbEnum([\n '3rd',\n '1st'\n ]))\n ], cpNormal, True)\n ], [], cpNormal, False, nil, True)\n ),\n wbFloat(PTOP, 'Idle Chatter Time Min'),\n wbFloat(NTOP, 'Idle Chatter Time Max'),\n wbRArray('Morph Values',\n wbRStruct('Value', [\n wbInteger(MSID, 'Index', itU32, wbIntToHexStr, wbHexStrToInt),\n wbString(MSM0, 'Min Name'),\n wbString(MSM1, 'Max Name')\n ], [])\n ),\n wbUnknown(MLSI),\n wbString(HNAM, 'Hair Color Lookup Texture'),\n wbString(HLTX, 'Hair Color Extended Lookup Texture'),\n wbFormIDCk(QSTI, 'Dialogue Quest', [QUST]),\n wbBSMPSequence\n ], False, nil, cpNormal, False, nil, wbRACEAfterSet);\n\n\n wbRecord(REFR, 'Placed Object', wbFormaterUnion(wbREFRRecordFlagsDecider, [\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000010} 4, 'Ground Piece',\n {0x00000100} 8, 'LOD Respects Enable State',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Is Full LOD',\n {0x04000000} 26, 'Filter (Collision Geometry)',\n {0x08000000} 27, 'Bounding Box (Collision Geometry)',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x40000000} 30, 'Ground',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {ACTI STAT SCOL TREE} wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000010} 4, 'Ground Piece',\n {0x00000100} 8, 'LOD Respects Enable State',\n {0x00000200} 9, 'Hidden From Local Map',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00008000} 15, 'Visible when distant',\n {0x00010000} 16, 'Is Full LOD',\n {0x04000000} 26, 'Filter (Collision Geometry)',\n {0x08000000} 27, 'Bounding Box (Collision Geometry)',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {CONT TERM} wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000010} 4, 'Ground Piece',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Is Full LOD',\n {0x02000000} 25, 'No AI Acquire',\n {0x04000000} 26, 'Filter (Collision Geometry)',\n {0x08000000} 27, 'Bounding Box (Collision Geometry)',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'Ground',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {DOOR} wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Minimal Use Door',\n {0x00000040} 6, 'Hidden From Local Map',\n {0x00000100} 8, 'Inaccessible',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Is Full LOD',\n {0x04000000} 26, 'Filter (Collision Geometry)',\n {0x08000000} 27, 'Bounding Box (Collision Geometry)',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {LIGH} wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000100} 8, 'Doesn''t Light Water',\n {0x00000200} 9, 'Casts Shadows',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Never Fades',\n {0x00020000} 17, 'Doesn''t Light Landscape',\n {0x02000000} 25, 'No AI Acquire',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {MSTT} wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000010} 4, 'Ground Piece',\n {0x00000200} 9, 'Motion Blur',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Is Full LOD',\n {0x04000000} 26, 'Filter (Collision Geometry)',\n {0x08000000} 27, 'Bounding Box (Collision Geometry)',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {ADDN} wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Is Full LOD',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn',\n {0x80000000} 31, 'Multibound'\n ], True, True)),\n {ALCH BOOK SCRL AMMO ARMO INGR KEYM MISC FURN WEAP}\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000010} 4, 'Ground Piece',\n {0x00000400} 10, 'Persistent',\n {0x00000800} 11, 'Initially Disabled',\n {0x00010000} 16, 'Is Full LOD',\n {0x02000000} 25, 'No AI Acquire',\n {0x10000000} 28, 'Reflected By Auto Water',\n {0x20000000} 29, 'Don''t Havok Settle',\n {0x40000000} 30, 'No Respawn',\n {0x80000000} 31, 'Multibound'\n ], True, True))\n ]), [\n wbEDID,\n wbVMAD,\n wbFormIDCk(NAME, 'Base', sigBaseObjects, False, cpNormal, True),\n\n {--- Bound Contents ---}\n {--- Bound Data ---}\n wbStruct(XMBO, 'Bound Half Extents', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n\n {--- Primitive ---}\n wbStruct(XPRM, 'Primitive', [\n wbStruct('Bounds', [\n wbFloat('X', cpNormal, True, 2, 4),\n wbFloat('Y', cpNormal, True, 2, 4),\n wbFloat('Z', cpNormal, True, 2, 4)\n ]),\n wbFloatColors('Color'),\n wbFloat('Unknown'),\n wbInteger('Type', itU32, wbEnum([\n 'None',\n 'Box',\n 'Sphere',\n 'Plane',\n 'Line',\n 'Ellipsoid'\n ]))\n ]),\n\n wbArray(XPOD, 'Portal Data', wbStruct('References', [\n wbFormIDCk('Origin', [REFR, NULL]),\n wbFormIDCk('Destination', [REFR, NULL])\n ])),\n\n wbUnknown(XORD),\n\n wbStruct(XOCP, 'Occlusion Plane Data', [\n wbStruct('Size', [\n wbFloat('Width', cpNormal, False, 2),\n wbFloat('Height', cpNormal, False, 2)\n ]),\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation (Quaternion?)', [\n wbFloat('q1'),\n wbFloat('q2'),\n wbFloat('q3'),\n wbFloat('q4')\n ])\n ]),\n\n wbRStruct('Bound Data', [\n wbStruct(XRMR, 'Header', [\n wbInteger('Linked Rooms Count', itU8),\n wbInteger('Flags', itU8, wbFlags([\n 'Unknown 1',\n 'Unknown 2',\n 'Unknown 3',\n 'Unknown 4',\n 'Unknown 5',\n 'Unknown 6',\n 'Has Image Space',\n 'Has Lighting Template'\n ])),\n wbByteArray('Unknown', 2)\n ]),\n wbFormIDCk(LNAM, 'Lighting Template', [LGTM]),\n wbFormIDCk(INAM, 'Image Space', [IMGS]),\n wbRArrayS('Linked Rooms',\n wbFormIDCk(XLRM, 'Linked Room', [REFR])\n )\n ], []),\n wbEmpty(XMBP, 'MultiBound Primitive Marker', cpIgnore),\n\n {--- Ragdoll ---}\n wbXRGD,\n wbXRGB,\n\n wbFloat(XRDS, 'Radius'),\n wbXSCL,\n\n {--- Emittance ---}\n wbFormIDCk(XEMI, 'Emittance', [LIGH, REGN]),\n\t\twbStruct(XLIG, 'Light Data', [\n wbFloat('FOV 90+/-'),\n wbFloat('Fade 1.0+/-'),\n wbFloat('End Distance Cap'),\n wbFloat('Shadow Depth Bias'),\n wbFloat('Near Clip'),\n wbFloat('Volumetric Intensity')\n ], cpNormal, False, nil, 4),\n\t\twbStruct(XALP, 'Alpha', [\n wbInteger('Cutoff', itU8),\n wbInteger('Base', itU8)\n ]),\n\n {--- Teleport ---}\n wbStruct(XTEL, 'Teleport Destination', [\n wbFormIDCk('Door', [REFR], True),\n wbPosRot,\n wbInteger('Flags', itU32, wbFlags([\n 'No Alarm',\n 'No Load Screen',\n 'Relative Position'\n ])),\n wbFormIDCk('Transition Interior', [CELL, NULL])\n ]),\n wbFormIDCk(XTNM, 'Teleport Loc Name', [MESG]),\n\n {--- MultiBound ---}\n wbFormIDCk(XMBR, 'MultiBound Reference', [REFR]),\n\n {--- Placed Water ---}\n wbUnknown(XWCN),\n wbStruct(XWCU, 'Water Velocity', [\n wbFloat('X Offset'),\n wbFloat('Y Offset'),\n wbFloat('Z Offset'),\n wbByteArray('Unknown', 4),\n wbFloat('X Angle'),\n wbFloat('Y Angle'),\n wbFloat('Z Angle'),\n wbByteArray('Unknown', 0)\n ]),\n\n wbFormIDCk(XASP, 'Acoustic Restriction', [REFR]),\n wbEmpty(XATP, 'Activation Point'),\n wbInteger(XAMC, 'Ammo Count', itU32),\n wbEmpty(XLKT, 'Linked Ref Transient'),\n wbFormIDCk(XLYR, 'Layer', [LAYR]),\n wbFormIDCk(XMSP, 'Material Swap', [MSWP]),\n wbFormIDCk(XRFG, 'Reference Group', [RFGP]),\n wbStruct(XRDO, 'Radio', [\n wbFloat('Frequency'),\n wbFloat('Min Weak Distance'),\n wbFloat('Max Weak Distance'),\n wbInteger('Flags', itU32, wbFlags(['Ignores Distance Checks']))\n ]),\n wbStruct(XBSD, 'Spline', [\n wbFloat('Slack'),\n wbFloat('Thickness'),\n wbFloat('Unknown'), // not shown in editor\n wbFloat('Unknown'), // not shown in editor\n wbFloat('Unknown'), // not shown in editor\n wbInteger('Wind - Detached End', itU8, wbBoolEnum),\n wbByteArray('Unused', 0) // junk data?\n ], cpNormal, False, nil, 5),\n wbStruct(XPDD, 'Projected Decal', [\n wbFloat('Width Scale'),\n wbFloat('Height Scale')\n // \"Uses Box Primitive\" checkbox does the following:\n // 1. \"Rounds\" above floats (probably due to floating point precision) [DIRTY EDITS?]\n // 2. \"Rounds\" DATA\\Position floats (probably due to floating point precision) [DIRTY EDITS?]\n // 3. Creates an XPRM subrecord (this is the \"Primitive\" tab in the editor)\n // 4. Fills out Primitive data:\n // 4a. Primitive type: Box\n // 4b. Collision layer: XTRI subrecord = 15\n // 4c. Bounds (XYZ): 256.0, 215.0, 256.0\n // 4d. Color (RGB): 0, 128, 128\n // 4e. Unknown: 0.4\n ]),\n wbFormIDCk(XSPC, 'Spawn Container', [REFR]),\n\n {--- Activate Parents ---}\n wbRStruct('Activate Parents', [\n wbInteger(XAPD, 'Flags', itU8, wbFlags([\n 'Parent Activate Only'\n ], True)),\n wbRArrayS('Activate Parent Refs',\n wbStructSK(XAPR, [0], 'Activate Parent Ref', [\n wbFormIDCk('Reference', sigReferences),\n wbFloat('Delay')\n ])\n )\n ], []),\n\n wbFormIDCk(XLIB, 'Leveled Item Base Object', [LVLI]),\n wbXLCM,\n wbFormIDCk(XLCN, 'Persistent Location', [LCTN]),\n\n {>>> COLL form Index value <<<}\n wbInteger(XTRI, 'Collision Layer', itU32),\n\n {--- Lock ---}\n wbStruct(XLOC, 'Lock Data', [\n wbInteger('Level', itU8, wbEnum([], [\n 0, 'None',\n 1, 'Novice 1',\n 25, 'Novice 25',\n 50, 'Advanced',\n 75, 'Expert',\n 100, 'Master',\n 253, 'Requires Terminal',\n 251, 'Barred',\n 252, 'Chained',\n 254, 'Inaccessible',\n 255, 'Requires Key'\n ])),\n wbByteArray('Unused', 3, cpIgnore),\n wbFormIDCkNoReach('Key', [KEYM, NULL]),\n wbInteger('Flags', itU8, wbFlags(['', '', 'Leveled Lock'])),\n wbByteArray('Unused', 3, cpIgnore),\n wbUnknown\n ], cpNormal, False, nil, 4),\n\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN]),\n\n {--- Generated Data ---}\n wbStruct(XNDP, 'Navigation Door Link', [\n wbFormIDCk('Navigation Mesh', [NAVM]),\n wbInteger('Teleport Marker Triangle', itS16, wbREFRNavmeshTriangleToStr, wbStringToInt),\n wbByteArray('Unused', 2, cpIgnore)\n ]),\n\n wbFormIDCk(XLRL, 'Location Reference', [LCRT, LCTN, NULL], False, cpBenignIfAdded),\n wbArray(XLRT, 'Location Ref Type', wbFormIDCk('Ref', [LCRT, NULL])),\n wbEmpty(XIS2, 'Ignored by Sandbox'),\n\n {--- Ownership ---}\n wbXOWN,\n wbXRNK,\n\n wbInteger(XCNT, 'Item Count', itS32),\n wbInteger(XHLT, 'Health %', itU32),\n\n wbXESP,\n wbRArray('Linked References', wbStruct(XLKR, 'Linked Reference', [\n wbFormIDCk('Keyword/Ref', [KYWD, PLYR, ACHR, REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA, NULL]),\n wbFormIDCk('Ref', sigReferences)\n ], cpNormal, False, nil, 1)),\n\n wbRArray('Patrol', wbRStruct('Data', [\n wbFloat(XPRD, 'Idle Time', cpNormal, True),\n wbEmpty(XPPA, 'Patrol Script Marker', cpNormal, True),\n wbFormIDCk(INAM, 'Idle', [IDLE, NULL], False, cpNormal, True),\n wbPDTOs\n ], [])),\n\n {--- Flags ---}\n wbInteger(XACT, 'Action Flag', itU32, wbFlags([\n 'Use Default',\n 'Activate',\n 'Open',\n 'Open by Default'\n ])),\n\n wbFloat(XHTW, 'Head-Tracking Weight'),\n wbFloat(XFVC, 'Favor Cost'),\n\n wbEmpty(ONAM, 'Open by Default'),\n\n {--- Map Data ---}\n wbRStruct('Map Marker', [\n wbEmpty(XMRK, 'Map Marker Data'),\n wbInteger(FNAM, 'Map Flags', itU8, wbFlags([\n {0x01} 'Visible',\n {0x02} 'Can Travel To',\n {0x04} '\"Show All\" Hidden',\n {0x08} 'Use Location Name'\n ]), cpNormal, True),\n wbFULLReq,\n wbStruct(TNAM, '', [\n wbInteger('Type', itU8, wbEnum([], [\n {Vv = Verified Vanilla}\n {No new map markers for Automatron or Workshop}\n 0, 'Cave', {Vv}\n 1, 'City', {Vv}\n 2, 'Diamond City', {Vv}\n 3, 'Encampment', {Vv}\n 4, 'Factory / Industrial Site', {Vv}\n 5, 'Gov''t Building / Monument', {Vv}\n 6, 'Metro Station', {Vv}\n 7, 'Military Base', {Vv}\n 8, 'Natural Landmark', {Vv}\n 9, 'Office / Civic Building', {Vv}\n 10, 'Ruins - Town', {Vv}\n 11, 'Ruins - Urban', {Vv}\n 12, 'Sanctuary', {Vv}\n 13, 'Settlement', {Vv}\n 14, 'Sewer / Utility Tunnels', {Vv}\n 15, 'Vault', {Vv}\n 16, 'Airfield', {Vv}\n 17, 'Bunker Hill', {Vv}\n 18, 'Camper', {Vv}\n 19, 'Car', {Vv}\n 20, 'Church', {Vv}\n 21, 'Country Club', {Vv}\n 22, 'Custom House', {Vv}\n 23, 'Drive-In', {Vv}\n 24, 'Elevated Highway', {Vv}\n 25, 'Faneuil Hall', {Vv}\n 26, 'Farm', {Vv}\n 27, 'Filling Station', {Vv}\n 28, 'Forested', {Vv}\n 29, 'Goodneighbor', {Vv}\n 30, 'Graveyard', {Vv}\n 31, 'Hospital', {Vv}\n 32, 'Industrial Dome', {Vv}\n 33, 'Industrial Stacks', {Vv}\n 34, 'Institute', {Vv}\n 35, 'Irish Pride', {Vv}\n 36, 'Junkyard', {Vv}\n 37, 'Observatory', {Vv}\n 38, 'Pier', {Vv}\n 39, 'Pond / Lake', {Vv}\n 40, 'Quarry', {Vv}\n 41, 'Radioactive Area', {Vv}\n 42, 'Radio Tower', {Vv}\n 43, 'Salem', {Vv}\n 44, 'School', {Vv}\n 45, 'Shipwreck', {Vv}\n 46, 'Submarine', {Vv}\n 47, 'Swan Pond', {Vv}\n 48, 'Synth Head', {Vv}\n 49, 'Town', {Vv}\n 50, 'Brotherhood of Steel', {Vv}\n 51, 'Brownstone Townhouse', {Vv}\n 52, 'Bunker', {Vv}\n 53, 'Castle', {Vv}\n 54, 'Skyscraper', {Vv}\n 55, 'Libertalia', {Vv}\n 56, 'Low-Rise Building', {Vv}\n 57, 'Minutemen', {Vv}\n 58, 'Police Station', {Vv}\n 59, 'Prydwen', {Vv}\n 60, 'Railroad - Faction', {Vv}\n 61, 'Railroad', {Vv}\n 62, 'Satellite', {Vv}\n 63, 'Sentinel', {Vv}\n 64, 'USS Constitution', {Vv}\n 65, 'Mechanist LairRaider settlementVassal settlementPotential Vassal settlement', {Vv}\n 66, 'Custom 66',\n 67, 'Custom 67',\n 68, 'Custom 68',\n 69, 'Custom 69',\n 70, 'Custom 70',\n 71, 'Custom 71',\n 72, 'Custom 72',\n 73, 'Custom 73',\n 74, 'Custom 74',\n 75, 'Custom 75',\n 76, 'Custom 76',\n 77, 'Custom 77',\n 78, 'Custom 78',\n 79, 'Custom 79',\n 80, 'Custom 80',\n 81, 'Custom 81',\n 82, 'Custom 82',\n 83, 'Custom 83',\n 84, 'Custom 84',\n 85, 'Custom 85',\n 86, 'Custom 86',\n 87, 'Custom 87',\n 88, 'Custom 88',\n 89, 'Custom 89',\n 90, 'Custom 90',\n 91, 'Custom 91',\n 92, 'Custom 92',\n 93, 'Custom 93',\n 94, 'Custom 94',\n 95, 'Custom 95',\n 96, 'Custom 96',\n 97, 'Custom 97',\n 98, 'Custom 98',\n 99, 'Custom 99'\n ])),\n wbByteArray('Unused', 1)\n ], cpNormal, True)\n ], []),\n\n {--- Attach reference ---}\n wbFormIDCk(XATR, 'Attach Ref', [REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA]),\n\n wbRArray('Spline Connection', wbStruct(XPLK, 'Link', [\n wbFormIDCk('Ref', [REFR, ACHR]),\n wbUnknown // always 00 00 00 00 so far in DLCWorkshop03.esm\n ])),\n\n wbRStruct('Power Grid', [\n wbInteger(XWPG, 'Count', itU32),\n wbRArray('Connections', wbStruct(XWPN, 'Connection', [\n wbFormIDCk('Node 1', [REFR, ACHR, NULL]),\n wbFormIDCk('Node 2', [REFR, ACHR, NULL]),\n wbFormIDCk('Line', [REFR, NULL]) // BNDS ref\n ]))\n ], []),\n\n wbUnknown(XCVR),\n wbUnknown(XCVL),\n wbFormIDCk(XCZR, 'Unknown', sigReferences),\n wbUnknown(XCZA),\n wbFormIDCk(XCZC, 'Unknown', [CELL, NULL]),\n\n wbXLOD, // not seen in FO4 vanilla files\n\n wbDataPosRot,\n wbString(MNAM, 'Comments')\n ], True, wbPlacedAddInfo, cpNormal, False, wbREFRAfterLoad);\n\n wbRecord(REGN, 'Region',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000040} 6, 'Border Region'\n ])), [\n wbEDID,\n wbStruct(RCLR, 'Map Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8),\n wbByteArray('Unknown', 1)\n ], cpNormal, True),\n wbFormIDCkNoReach(WNAM, 'Worldspace', [WRLD]),\n wbRArray('Region Areas', wbRStruct('Region Area', [\n wbInteger(RPLI, 'Edge Fall-off', itU32),\n wbArray(RPLD, 'Region Point List Data', wbStruct('Point', [\n wbFloat('X'),\n wbFloat('Y')\n ]), 0, wbRPLDAfterLoad),\n wbUnknown(ANAM)\n ], [])),\n wbRArrayS('Region Data Entries', wbRStructSK([0], 'Region Data Entry', [\n {always starts with an RDAT}\n wbStructSK(RDAT, [0], 'Data Header', [\n wbInteger('Type', itU32, wbEnum([\n {0} 'Unknown 0',\n {1} 'Unknown 1',\n {2} 'Objects',\n {3} 'Weather',\n {4} 'Map',\n {5} 'Land',\n {6} 'Grass',\n {7} 'Sound',\n {8} 'Imposter',\n {9} 'Unknown 10',\n {10}'Unknown 11',\n {11}'Unknown 12',\n {12}'Unknown 13',\n {13}'Unknown 14',\n {14}'Unknown 15',\n {15}'Unknown 16'\n ])),\n wbInteger('Flags', itU8, wbFlags([\n 'Override'\n ])),\n wbInteger('Priority', itU8),\n wbByteArray('Unknown')\n ], cpNormal, True),\n\n {--- Icon ---}\n wbICON,\n\n {--- Sound ---}\n wbFormIDCk(RDMO, 'Music', [MUSC], False, cpNormal, False, wbREGNSoundDontShow),\n wbArrayS(RDSA, 'Sounds', wbStructSK([0], 'Sound', [\n wbFormIDCk('Sound', [SNDR, NULL]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Pleasant',\n {0x00000002} 'Cloudy',\n {0x00000004} 'Rainy',\n {0x00000008} 'Snowy'\n ])),\n wbFloat('Chance')\n ]), 0, cpNormal, False, nil, nil, wbREGNSoundDontShow),\n\n\t\t\t{--- Map ---}\n wbLString(RDMP, 'Map Name', 0, cpTranslate, False, wbREGNMapDontShow),\n\n {followed by one of these: }\n\n {--- Objects ---}\n wbArray(RDOT, 'Objects', wbStruct('Object', [\n wbFormIDCk('Object', [TREE, FLOR, STAT, LTEX, MSTT]),\n wbInteger('Parent Index', itU16, wbHideFFFF),\n wbByteArray('Unknown', 2),\n wbFloat('Density'),\n wbInteger('Clustering', itU8),\n wbInteger('Min Slope', itU8),\n wbInteger('Max Slope', itU8),\n wbInteger('Flags', itU8, wbFlags([\n {0}'Conform to slope',\n {1}'Paint Vertices',\n {2}'Size Variance +/-',\n {3}'X +/-',\n {4}'Y +/-',\n {5}'Z +/-',\n {6}'Tree',\n {7}'Huge Rock'\n ])),\n wbInteger('Radius wrt Parent', itU16),\n wbInteger('Radius', itU16),\n wbFloat('Min Height'),\n wbFloat('Max Height'),\n wbFloat('Sink'),\n wbFloat('Sink Variance'),\n wbFloat('Size Variance'),\n wbStruct('Angle Variance', [\n wbInteger('X', itU16),\n wbInteger('Y', itU16),\n wbInteger('Z', itU16)\n ]),\n wbByteArray('Unknown', 2),\n wbByteArray('Unknown', 4)\n ]), 0, nil, nil, cpNormal, False, wbREGNObjectsDontShow),\n\n {--- Grass ---}\n wbArrayS(RDGS, 'Grasses', wbStructSK([0], 'Grass', [\n wbFormIDCk('Grass', [GRAS]),\n wbByteArray('Unknown',4)\n ]), 0, cpNormal, False, nil, nil, wbREGNGrassDontShow),\n\n {--- Weather ---}\n wbArrayS(RDWT, 'Weather Types', wbStructSK([0], 'Weather Type', [\n wbFormIDCk('Weather', [WTHR]),\n wbInteger('Chance', itU32),\n wbFormIDCk('Global', [GLOB, NULL])\n ]), 0, cpNormal, False, nil, nil, wbREGNWeatherDontShow),\n\n wbFloat(RLDM, 'LOD Display Distance Multiplier'),\n wbFloat(ANAM, 'Occlusion Accuracy Dist')\n\n ], []))\n ], True);\n\n wbRecord(SOUN, 'Sound Marker', [\n wbEDID,\n wbOBNDReq,\n wbFormIDCk(SDSC, 'Sound Descriptor', [SNDR, NULL]),\n wbStruct(REPT, 'Repeat', [\n wbFloat('Min Time'),\n wbFloat('Max Time'),\n wbInteger('Stackable', itU8, wbBoolEnum)\n ], cpNormal, False, nil, 2)\n ]);\n\n wbSPIT := wbStruct(SPIT, 'Data', [\n wbInteger('Base Cost', itU32),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Manual Cost Calc',\n {0x00000002} 'Unknown 2',\n {0x00000004} 'Unknown 3',\n {0x00000008} 'Unknown 4',\n {0x00000010} 'Unknown 5',\n {0x00000020} 'Unknown 6',\n {0x00000040} 'Unknown 7',\n {0x00000080} 'Unknown 8',\n {0x00000100} 'Unknown 9',\n {0x00000200} 'Unknown 10',\n {0x00000400} 'Unknown 11',\n {0x00000800} 'Unknown 12',\n {0x00001000} 'Unknown 13',\n {0x00002000} 'Unknown 14',\n {0x00004000} 'Unknown 15',\n {0x00008000} 'Unknown 16',\n {0x00010000} 'Unknown 17',\n {0x00020000} 'PC Start Spell',\n {0x00040000} 'Instant Cast',\n {0x00080000} 'Area Effect Ignores LOS',\n {0x00100000} 'Ignore Resistance',\n {0x00200000} 'No Absorb/Reflect',\n {0x00400000} 'Unknown 23',\n {0x00800000} 'No Dual Cast Modification',\n {0x01000000} 'Unknown 25',\n {0x02000000} 'Unknown 26',\n {0x04000000} 'Unknown 27',\n {0x08000000} 'Unknown 28',\n {0x10000000} 'Unknown 29',\n {0x20000000} 'Unknown 30',\n {0x40000000} 'Unknown 31',\n {0x80000000} 'Unknown 32'\n ])),\n wbInteger('Type', itU32, wbEnum([\n {0} 'Spell',\n {1} 'Disease',\n {2} 'Power',\n {3} 'Lesser Power',\n {4} 'Ability',\n {5} 'Poison',\n {6} 'Unknown 6',\n {7} 'Unknown 7',\n {8} 'Unknown 8',\n {9} 'Unknown 9',\n {10} 'Addiction',\n {11} 'Voice'\n ])),\n wbFloat('Charge Time'),\n wbInteger('Cast Type', itU32, wbCastEnum),\n wbInteger('Target Type', itU32, wbTargetEnum),\n wbFloat('Cast Duration'),\n wbFloat('Range'),\n wbFormIDCk('Casting Perk', [NULL, PERK])\n ], cpNormal, True);\n\n wbRecord(SPEL, 'Spell', [\n wbEDID,\n wbOBNDReq,\n wbFULL,\n wbKSIZ,\n wbKWDAs,\n wbETYP,\n wbDESCReq,\n wbSPIT,\n wbEffectsReq\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n {wbRecord(SCRL, 'Scroll', [\n wbEDID\n ]);}\n\n wbRecord(STAT, 'Static',\n wbFlags(wbRecordFlagsFlags, [\n {0x00000001} { 0} '',\n {0x00000002} { 1} '',\n {0x00000004} { 2} 'Heading Marker',\n {0x00000008} { 3} '',\n {0x00000010} { 4} 'Non Occluder',\n {0x00000020} { 5} 'Deleted',\n {0x00000040} { 6} 'Has Tree LOD', // Used in Fallout 4 ?\n {0x00000080} { 7} 'Add-On LOD Object',\n {0x00000100} { 8} '',\n {0x00000200} { 9} 'Hidden From Local Map',\n {0x00000400} {10} 'Headtrack Marker',\n {0x00000800} {11} 'Used as Platform',\n {0x00001000} {12} '',\n {0x00002000} {13} 'Pack-In Use Only',\n {0x00004000} {14} '',\n {0x00008000} {15} 'Has Distant LOD',\n {0x00010000} {16} '',\n {0x00020000} {17} 'Uses HD LOD Texture',\n {0x00040000} {18} '',\n {0x00080000} {19} 'Has Currents',\n {0x00100000} {20} '',\n {0x00200000} {21} '',\n {0x00400000} {22} '',\n {0x00800000} {23} 'Is Marker',\n {0x01000000} {24} '',\n {0x02000000} {25} 'Obstacle',\n {0x04000000} {26} 'NavMesh Generation - Filter',\n {0x08000000} {27} 'NavMesh Generation - Bounding Box',\n {0x10000000} {28} 'Show In World Map (Sky Cell Only)',\n {0x20000000} {29} '',\n {0x40000000} {30} 'NavMesh Generation - Ground',\n {0x80000000} {31} ''\n ]), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFTYP,\n wbMODL,\n wbPRPS,\n wbFULL,\n wbStruct(DNAM, 'Direction Material', [\n wbFloat('Max Angle (30-120)'),\n wbFormIDCk('Material', [MATO, NULL]),\n wbFloat('Leaf Amplitude'),\n wbFloat('Leaf Frequency')\n ], cpNormal, True, nil, 2),\n wbNVNM,\n wbArray(MNAM, 'Distant LOD',\n wbStruct('LOD', [\n {>>> Contains null-terminated mesh filename followed by random data up to 260 bytes <<<}\n wbString(True, 'Mesh', 260)\n //wbByteArray('Mesh', 260, cpIgnore)\n ]), [\n 'Level 0',\n 'Level 1',\n 'Level 2',\n 'Level 3'\n ],\n cpNormal, False\n )\n ], True); // unordered, NVNM can be before or after MNAM\n\n wbRecord(TES4, 'Main File Header',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000001} 0, 'ESM',\n {0x00000080} 7, 'Localized'\n ], False), True), [\n wbStruct(HEDR, 'Header', [\n wbFloat('Version'),\n wbInteger('Number of Records', itU32),\n wbInteger('Next Object ID', itU32)\n ], cpNormal, True),\n wbByteArray(OFST, 'Unknown', 0, cpIgnore), // If possible then ignored by the runtime. Neither from the CK\n wbByteArray(DELE, 'Unknown', 0, cpIgnore), // If possible then ignored by the runtime. Neither from the CK\n wbString(CNAM, 'Author', 0, cpTranslate, True),\n wbString(SNAM, 'Description', 0, cpTranslate),\n wbRArray('Master Files', wbRStruct('Master File', [\n wbString(MAST, 'Filename', 0, cpNormal, True),\n // wbInteger(DATA, 'Filesize', itU64, nil, nil, cpIgnore, True) // Should be set by CK but usually null\n wbByteArray(DATA, 'Unknown', 8, cpIgnore, True)\n ], [ONAM])),\n wbArray(ONAM, 'Overridden Forms', // Valid in CK\n wbFormIDCk('Form', [ACHR, LAND, NAVM, REFR, PGRE, PHZD, PMIS, PARW, PBAR, PBEA, PCON, PFLA, DLBR, DIAL, INFO, SCEN]),\n 0, nil, nil, cpNormal, False{, wbTES4ONAMDontShow}),\n wbByteArray(SCRN, 'Screenshot'), // If possible then ignored by the runtime. Neither from the CK\n wbRArray('Transient Types (CK only)', wbStruct(TNAM, 'Transient Type', [\n wbInteger('FormType', itU32), // seen TESTopic 78 (array of DIAL) and BGSScene 126 (array of SCEN)\n wbArray('Unknown', wbFormID('Unknown'))\n ])), // Ignored by the runtime\n wbInteger(INTV, 'Unknown', itU32), // Ignored by the runtime, 4 bytes loaded in CK\n wbInteger(INCC, 'Unknown', itU32) // Size of some array of 12 bytes elements\n ], True, nil, cpNormal, True, wbRemoveOFST);\nend;\n\nprocedure DefineFO4o;\nbegin\n\n wbRecord(TREE, 'Tree',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00008000} 15, 'Has Distant LOD'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbMODL,\n wbFormIDCK(PFIG, 'Ingredient', sigBaseObjects),\n wbFormIDCK(SNAM, 'Harvest Sound', [SNDR, NULL]),\n wbStruct(PFPC, 'Ingredient Production', [\n wbInteger('Spring', itU8),\n wbInteger('Summer', itU8),\n wbInteger('Fall', itU8),\n wbInteger('Winter', itU8)\n ]),\n wbFULL,\n wbStruct(CNAM, 'Tree Data', [\n wbFloat('Trunk Flexibility'),\n wbFloat('Branch Flexibility'),\n //wbByteArray('Unknown', 32),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Unknown'),\n wbFloat('Leaf Amplitude'),\n wbFloat('Leaf Frequency')\n ], cpNormal, True)\n ]);\n\n wbRecord(FLOR, 'Flora', [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULLReq,\n wbMODL,\n wbDEST,\n wbKSIZ,\n wbKWDAs,\n wbPRPS,\n wbUnknown(PNAM),\n wbATTX,\n wbLString(RNAM, 'Activate Text Override', 0, cpTranslate),\n wbUnknown(FNAM),\n wbFormIDCk(PFIG, 'Ingredient', sigBaseObjects),\n wbFormIDCK(SNAM, 'Harvest Sound', [SNDR]),\n wbStruct(PFPC, 'Ingredient Production', [\n wbInteger('Spring', itU8),\n wbInteger('Summer ', itU8),\n wbInteger('Fall', itU8),\n wbInteger('Winter', itU8)\n ], cpNormal, True)\n ], False, nil, cpNormal, False, nil, wbKeywordsAfterSet);\n\n wbRecord(WATR, 'Water', [\n wbEDID,\n wbFULL,\n wbInteger(ANAM, 'Opacity (unused)', itU8),\n wbInteger(FNAM, 'Flags', itU8, wbFlags([\n {0x01} 'Dangerous',\n {0x02} 'Unknown 1',\n {0x04} 'Directional Sound'\n ]), cpNormal, True),\n wbFormIDCk(TNAM, 'Material (unused)', [MATT]),\n wbFormIDCk(SNAM, 'Open Sound', [SNDR, NULL]),\n wbFormIDCk(XNAM, 'Consume Spell', [SPEL]),\n wbFormIDCk(YNAM, 'Contact Spell', [SPEL]),\n wbFormIDCk(INAM, 'Image Space', [IMGS]),\n wbByteArray(DATA, 'Unused', 0),\n wbStruct(DNAM, 'Visual Data', [\n wbStruct('Fog Properties', [\n wbFloat('Depth Amount'),\n wbByteColors('Shallow Color'),\n wbByteColors('Deep Color'),\n wbFloat('Color Shallow Range'),\n wbFloat('Color Deep Range'),\n wbFloat('Shallow Alpha'),\n wbFloat('Deep Alpha'),\n wbFloat('Alpha Shallow Range'),\n wbFloat('Alpha Deep Range'),\n wbByteColors('Underwater Color'),\n wbFloat('Underwater Fog Amount'),\n wbFloat('Underwater Near Fog'),\n wbFloat('Underwater Far Fog')\n ]),\n wbStruct('Physical Properties', [\n wbFloat('Normal Magnitude'),\n wbFloat('Shallow Normal Falloff'),\n wbFloat('Deep Normal Falloff'),\n wbFloat('Reflectivity Amount'),\n wbFloat('Fresnel Amount'),\n wbFloat('Surface Effect Falloff'),\n wbStruct('Displacement Simulator', [\n wbFloat('Force'),\n wbFloat('Velocity'),\n wbFloat('Falloff'),\n wbFloat('Dampener'),\n wbFloat('Starting Size')\n ]),\n wbByteColors('Reflection Color')\n ]),\n wbStruct('Specular Properties', [\n wbFloat('Sun Specular Power'),\n wbFloat('Sun Specular Magnitude'),\n wbFloat('Sun Sparkle Power'),\n wbFloat('Sun Sparkle Magnitude'),\n wbFloat('Interior Specular Radius'),\n wbFloat('Interior Specular Brightness'),\n wbFloat('Interior Specular Power')\n ]),\n wbStruct('Noise Properties', [\n wbFloat('Layer 1 - Wind Direction'),\n wbFloat('Layer 2 - Wind Direction'),\n wbFloat('Layer 3 - Wind Direction'),\n wbFloat('Layer 1 - Wind Speed'),\n wbFloat('Layer 2 - Wind Speed'),\n wbFloat('Layer 3 - Wind Speed'),\n wbFloat('Layer 1 - Amplitude Scale'),\n wbFloat('Layer 2 - Amplitude Scale'),\n wbFloat('Layer 3 - Amplitude Scale'),\n wbFloat('Layer 1 - UV Scale'),\n wbFloat('Layer 2 - UV Scale'),\n wbFloat('Layer 3 - UV Scale'),\n wbFloat('Layer 1 - Noise Falloff'),\n wbFloat('Layer 2 - Noise Falloff'),\n wbFloat('Layer 3 - Noise Falloff')\n ]),\n wbStruct('Silt Properties', [\n wbFloat('Silt Amount'),\n wbByteColors('Light Color'),\n wbByteColors('Dark Color')\n ]),\n wbInteger('Screen Space Reflections', itU8, wbBoolEnum)\n ], cpNormal, True, nil, 4),\n wbByteArray(GNAM, 'Unused', 0),\n wbStruct(NAM0, 'Linear Velocity', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ], cpNormal, False),\n wbStruct(NAM1, 'Angular Velocity', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ], cpNormal, False),\n wbString(NAM2, 'Layer 1 Noise Texture'),\n wbString(NAM3, 'Layer 2 Noise Texture'),\n wbString(NAM4, 'Layer 3 Noise Texture')\n ]);\n\n wbRecord(WEAP, 'Weapon',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 2, 'Non-Playable',\n {0x20000000} 30, 'High-Res 1st Person Only'\n ])), [\n wbEDID,\n wbVMAD,\n wbOBNDReq,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbICON,\n wbMICO,\n wbEITM,\n wbInteger(EAMT, 'Enchantment Amount', itU16),\n wbDEST,\n wbETYP,\n wbFormIDCk(BIDS, 'Block Bash Impact Data Set', [IPDS, NULL]),\n wbFormIDCk(BAMT, 'Alternate Block Material', [MATT, NULL]),\n wbYNAM,\n wbZNAM,\n wbKSIZ,\n wbKWDAs,\n wbDESC,\n wbFormIDCk(INRD, 'Instance Naming', [INNR]),\n wbAPPR,\n wbObjectTemplate,\n wbFormIDCk(NNAM, 'Embedded Weapon Mod', [OMOD]),\n wbRStruct('1st Person Model', [\n wbString(MOD4, 'Model Filename'),\n wbByteArray(MO4T, 'Texture Files Hashes', 0, cpIgnore, false, false, wbNeverShow),\n wbMO4S,\n wbMO4C,\n wbMO4F\n ], []),\n wbStruct(DNAM, 'Data', [\n wbFormIDCk('Ammo', [AMMO, NULL]),\n wbFloat('Speed'),\n wbFloat('Reload Speed'),\n wbFloat('Reach'),\n wbFloat('Min Range'),\n wbFloat('Max Range'),\n wbFloat('Attack Delay'),\n wbByteArray('Unknown', 4),\n wbFloat('Damage - OutOfRange Mult'),\n wbInteger('On Hit', itU32, wbHitBehaviourEnum),\n wbFormIDCk('Skill', [AVIF, NULL]),\n wbFormIDCk('Resist', [AVIF, NULL]),\n wbInteger('Flags', itU32, wbFlags([\n {0x00000001} 'Player Only',\n {0x00000002} 'NPCs Use Ammo',\n {0x00000004} 'No Jam After Reload',\n {0x00000008} 'Charging Reload',\n {0x00000010} 'Minor Crime',\n {0x00000020} 'Fixed Range',\n {0x00000040} 'Not Used In Normal Combat',\n {0x00000080} 'Unknown 8',\n {0x00000100} 'Crit Effect - on Death',\n {0x00000200} 'Charging Attack',\n {0x00000400} 'Unknown 11',\n {0x00000800} 'Hold Input To Power',\n {0x00001000} 'Non Hostile',\n {0x00002000} 'Bound Weapon',\n {0x00004000} 'Ignores Normal Weapon Resistance',\n {0x00008000} 'Automatic',\n {0x00010000} 'Repeatable Single Fire',\n {0x00020000} 'Can''t Drop',\n {0x00040000} 'Hide Backpack',\n {0x00080000} 'Embedded Weapon',\n {0x00100000} 'Not Playable',\n {0x00200000} 'Has Scope',\n {0x00400000} 'Bolt Action',\n {0x00800000} 'Secondary Weapon',\n {0x01000000} 'Disable Shells',\n {0x02000000} 'Unknown 26',\n {0x04000000} 'Unknown 27',\n {0x08000000} 'Unknown 28',\n {0x10000000} 'Unknown 29',\n {0x20000000} 'Unknown 30',\n {0x40000000} 'Unknown 31',\n {0x80000000} 'Unknown 32'\n ])),\n wbInteger('Capacity', itU16),\n wbInteger('Animation Type', itU8, wbEnum([\n 'HandToHandMelee',\n 'OneHandSword',\n 'OneHandDagger',\n 'OneHandAxe',\n 'OneHandMace',\n 'TwoHandSword',\n 'TwoHandAxe',\n 'Bow',\n 'Staff',\n 'Gun',\n 'Grenade',\n 'Mine'\n ])),\n wbFloat('Damage - Secondary'),\n wbFloat('Weight'),\n wbInteger('Value', itU32),\n wbInteger('Damage - Base', itU16),\n wbInteger('Sound Level', itU32, wbSoundLevelEnum),\n wbFormIDCk('Sound - Attack', [SNDR, NULL]),\n wbFormIDCk('Sound - Attack 2D', [SNDR, NULL]),\n wbFormIDCk('Sound - Attack Loop', [SNDR, NULL]),\n wbFormIDCk('Sound - Attack Fail', [SNDR, NULL]),\n wbFormIDCk('Sound - Idle', [SNDR, NULL]),\n wbFormIDCk('Sound - Equip Sound', [SNDR, NULL]),\n wbFormIDCk('Sound - UnEquip Sound', [SNDR, NULL]),\n wbFormIDCk('Sound - Fast Equip Sound', [SNDR, NULL]),\n wbInteger('Accuracy Bonus', itU8),\n wbFloat('Animation Attack Seconds'),\n wbByteArray('Unknown', 2),\n wbFloat('Action Point Cost'),\n wbFloat('Full Power Seconds'),\n wbFloat('Min Power Per Shot'),\n wbInteger('Stagger', itU32, wbStaggerEnum),\n wbByteArray('Unknown', 4)\n ]),\n wbStruct(FNAM, '', [\n wbFloat('Animation Fire Seconds'),\n wbFloat('Rumble - Left Motor Strength'),\n wbFloat('Rumble - Right Motor Strength'),\n wbFloat('Rumble - Duration'),\n wbFloat('Animation Reload Seconds'),\n wbByteArray('Unknown', 4),\n wbFloat('Sighted Transition Seconds'),\n wbInteger('# Projectiles', itU8),\n wbFormIDCk('Override Projectile', [PROJ, NULL]),\n wbInteger('Pattern', itU32, wbEnum([\n 'Constant',\n 'Square',\n 'Triangle',\n 'Sawtooth'\n ])),\n wbInteger('Rumble - Peroid (ms)', itU32)\n ]),\n wbStruct(CRDT, 'Critical Data', [\n wbFloat('Crit Damage Mult'),\n wbFloat('Crit Charge Bonus'),\n wbFormIDCk('Crit Effect', [SPEL, NULL])\n ]),\n wbFormIDCk(INAM, 'Impact Data Set', [IPDS]),\n wbFormIDCk(LNAM, 'NPC Add Ammo List', [LVLI]),\n wbFormIDCk(WAMD, 'Aim Model', [AMDL]),\n wbFormIDCk(WZMD, 'Zoom', [ZOOM]),\n wbFormIDCk(CNAM, 'Template', [WEAP]),\n wbStructs(DAMA, 'Damage Types', 'Damage Type', [\n wbFormIDCk('Type', [DMGT]),\n wbInteger('Amount', itU32)\n ]),\n wbFLTR,\n wbInteger(MASE, 'Melee Speed', itU32, wbEnum([\n 'Very Slow',\n 'Slow',\n 'Medium',\n 'Fast',\n 'Very Fast'\n ]))\n ], False, nil, cpNormal, False, nil{wbWEAPAfterLoad}, wbKeywordsAfterSet);\n\n wbRecord(WRLD, 'Worldspace',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00080000} 19, 'Can''t Wait'\n ])), [\n wbEDID,\n wbRArray('Unused RNAM', wbUnknown(RNAM), cpIgnore, False{, wbNeverShow}),\n wbMaxHeightDataWRLD,\n wbFULL,\n wbStruct(WCTR, 'Fixed Dimensions Center Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbFormIDCk(LTMP, 'Interior Lighting', [LGTM]),\n wbFormIDCk(XEZN, 'Encounter Zone', [ECZN, NULL]),\n wbFormIDCk(XLCN, 'Location', [LCTN, NULL]),\n wbRStruct('Parent', [\n wbFormIDCk(WNAM, 'Worldspace', [WRLD]),\n wbStruct(PNAM, '', [\n wbInteger('Flags', itU8, wbFlags([\n {0x0001} 'Use Land Data',\n {0x0002} 'Use LOD Data',\n {0x0004} 'Don''t Use Map Data',\n {0x0008} 'Use Water Data',\n {0x0010} 'Use Climate Data',\n {0x0020} 'Use Image Space Data (unused)',\n {0x0040} 'Use Sky Cell'\n ], [5])),\n wbByteArray('Unknown', 1)\n ], cpNormal, True)\n ], []),\n wbFormIDCk(CNAM, 'Climate', [CLMT]),\n wbFormIDCk(NAM2, 'Water', [WATR]),\n wbFormIDCk(NAM3, 'LOD Water Type', [WATR]),\n wbFloat(NAM4, 'LOD Water Height'),\n wbStruct(DNAM, 'Land Data', [\n wbFloat('Default Land Height'),\n wbFloat('Default Water Height')\n ]),\n wbString(ICON, 'Map Image'),\n wbRStruct('Cloud Model', [wbMODL], []),\n wbStruct(MNAM, 'Map Data', [\n wbStruct('Usable Dimensions', [\n wbInteger('X', itS32),\n wbInteger('Y', itS32)\n ]),\n wbStruct('Cell Coordinates', [\n wbStruct('NW Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ]),\n wbStruct('SE Cell', [\n wbInteger('X', itS16),\n wbInteger('Y', itS16)\n ])\n ])\n ]),\n wbStruct(ONAM, 'World Map Offset Data', [\n wbFloat('World Map Scale'),\n wbFloat('Cell X Offset'),\n wbFloat('Cell Y Offset'),\n wbFloat('Cell Z Offset')\n ], cpNormal, True),\n wbFloat(NAMA, 'Distant LOD Multiplier'),\n wbInteger(DATA, 'Flags', itU8, wbFlags([\n {0x01} 'Small World',\n {0x02} 'Can''t Fast Travel',\n {0x04} 'Unknown 3',\n {0x08} 'No LOD Water',\n {0x10} 'No Landscape',\n {0x20} 'No Sky',\n {0x40} 'Fixed Dimensions',\n {0x80} 'No Grass'\n ]), cpNormal, True),\n {>>> Object Bounds doesn't show up in CK <<<}\n wbRStruct('Object Bounds', [\n wbStruct(NAM0, 'Min', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True),\n wbStruct(NAM9, 'Max', [\n wbFloat('X', cpNormal, False, 1/4096),\n wbFloat('Y', cpNormal, False, 1/4096)\n ], cpIgnore, True)\n ], []),\n wbFormIDCk(ZNAM, 'Music', [MUSC]),\n wbString(NNAM, 'Canopy Shadow (unused)', 0, cpIgnore),\n wbString(XWEM, 'Water Environment Map'),\n wbString(TNAM, 'HD LOD Diffuse Texture'),\n wbString(UNAM, 'HD LOD Normal Texture'),\n wbRStruct('World Default Level Data', [\n wbStruct(WLEV, 'Dimension', [\n wbStruct('NW Cell', [\n wbInteger('X', itS8),\n wbInteger('Y', itS8)\n ]),\n wbStruct('Size', [\n wbInteger('Width', itU8),\n wbInteger('Height', itU8)\n ])\n ]),\n wbByteArray(WLEV, 'Data')\n ], []),\n wbOFST,\n wbUnknown(CLSZ)\n ], False, nil, cpNormal, False, wbWRLDAfterLoad);\n\n\n wbRecord(WTHR, 'Weather',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000200} 9, 'Unknown 9'\n ])), [\n wbEDID,\n wbString(_00_0TX, 'Cloud Texture Layer #0'),\n wbString(_10_0TX, 'Cloud Texture Layer #1'),\n wbString(_20_0TX, 'Cloud Texture Layer #2'),\n wbString(_30_0TX, 'Cloud Texture Layer #3'),\n wbString(_40_0TX, 'Cloud Texture Layer #4'),\n wbString(_50_0TX, 'Cloud Texture Layer #5'),\n wbString(_60_0TX, 'Cloud Texture Layer #6'),\n wbString(_70_0TX, 'Cloud Texture Layer #7'),\n wbString(_80_0TX, 'Cloud Texture Layer #8'),\n wbString(_90_0TX, 'Cloud Texture Layer #9'),\n wbString(_3A_0TX, 'Cloud Texture Layer #10'),\n wbString(_3B_0TX, 'Cloud Texture Layer #11'),\n wbString(_3C_0TX, 'Cloud Texture Layer #12'),\n wbString(_3D_0TX, 'Cloud Texture Layer #13'),\n wbString(_3E_0TX, 'Cloud Texture Layer #14'),\n wbString(_3F_0TX, 'Cloud Texture Layer #15'),\n wbString(_40h_0TX, 'Cloud Texture Layer #16'),\n wbString(A0TX, 'Cloud Texture Layer #17'),\n wbString(B0TX, 'Cloud Texture Layer #18'),\n wbString(C0TX, 'Cloud Texture Layer #19'),\n wbString(D0TX, 'Cloud Texture Layer #20'),\n wbString(E0TX, 'Cloud Texture Layer #21'),\n wbString(F0TX, 'Cloud Texture Layer #22'),\n wbString(G0TX, 'Cloud Texture Layer #23'),\n wbString(H0TX, 'Cloud Texture Layer #24'),\n wbString(I0TX, 'Cloud Texture Layer #25'),\n wbString(J0TX, 'Cloud Texture Layer #26'),\n wbString(K0TX, 'Cloud Texture Layer #27'),\n wbString(L0TX, 'Cloud Texture Layer #28'),\n wbUnknown(LNAM),\n wbFormIDCK(MNAM, 'Precipitation Type', [SPGD, NULL]),\n wbFormIDCK(NNAM, 'Visual Effect', [RFCT, NULL], False, cpNormal, True),\n wbByteArray(ONAM, 'Unused', 0, cpIgnore),\n wbRStruct('Cloud Speed', [\n wbArray(RNAM, 'Y Speed', wbInteger('Layer', itU8, wbCloudSpeedToStr, wbCloudSpeedToInt)),\n wbArray(QNAM, 'X Speed', wbInteger('Layer', itU8, wbCloudSpeedToStr, wbCloudSpeedToInt))\n ], []),\n wbArray(PNAM, 'Cloud Colors', wbWeatherColors('Layer')),\n wbArray(JNAM, 'Cloud Alphas', wbStruct('Layer', [\n wbFloat('Sunrise'),\n wbFloat('Day'),\n wbFloat('Sunset'),\n wbFloat('Night'),\n wbFloat('EarlySunrise'),\n wbFloat('LateSunrise'),\n wbFloat('EarlySunset'),\n wbFloat('LateSunset')\n ])),\n wbStruct(NAM0, 'Weather Colors', [\n wbWeatherColors('Sky-Upper'),\n wbWeatherColors('Fog Near'),\n wbWeatherColors('Unknown'),\n wbWeatherColors('Ambient'),\n wbWeatherColors('Sunlight'),\n wbWeatherColors('Sun'),\n wbWeatherColors('Stars'),\n wbWeatherColors('Sky-Lower'),\n wbWeatherColors('Horizon'),\n wbWeatherColors('Effect Lighting'),\n wbWeatherColors('Cloud LOD Diffuse'),\n wbWeatherColors('Cloud LOD Ambient'),\n wbWeatherColors('Fog Far'),\n wbWeatherColors('Sky Statics'),\n wbWeatherColors('Water Multiplier'),\n wbWeatherColors('Sun Glare'),\n wbWeatherColors('Moon Glare'),\n wbWeatherColors('Fog Near High'),\n wbWeatherColors('Fog Far High')\n ], cpNormal, True, nil, 8),\n wbArray(NAM4, 'Unknown', wbFloat('Unknown')),\n wbStruct(FNAM, 'Fog Distance', [\n wbFloat('Day - Near'),\n wbFloat('Day - Far'),\n wbFloat('Night - Near'),\n wbFloat('Night - Far'),\n wbFloat('Day - Power'),\n wbFloat('Night - Power'),\n wbFloat('Day - Max'),\n wbFloat('Night - Max'),\n wbFloat('Day - Near Height Mid'),\n wbFloat('Day - Near Height Range'),\n wbFloat('Night - Near Height Mid'),\n wbFloat('Night - Near Height Range'),\n wbFloat('Day - High Density Scale'),\n wbFloat('Night - High Density Scale'),\n wbFloat('Day - Far Height Mid'),\n wbFloat('Day - Far Height Range'),\n wbFloat('Night - Far Height Mid'),\n wbFloat('Night - Far Height Range')\n ], cpNormal, True, nil, 8),\n wbStruct(DATA, 'Data', [\n wbInteger('Wind Speed', itU8), // scaled 0..1\n wbByteArray('Unknown', 2),\n wbInteger('Trans Delta', itU8), // scaled 0..0,25\n wbInteger('Sun Glare', itU8), // scaled 0..1\n wbInteger('Sun Damage', itU8), // scaled 0..1\n wbInteger('Precipitation - Begin Fade In', itU8), // scaled 0..1\n wbInteger('Precipitation - End Fade Out', itU8), // scaled 0..1\n wbInteger('Thunder/Lightning - Begin Fade In', itU8),\n wbInteger('Thunder/Lightning - End Fade Out', itU8),\n wbInteger('Thunder/Lightning - Frequency', itU8),\n wbInteger('Flags', itU8, wbFlags([\n {0x01} 'Weather - Pleasant',\n {0x02} 'Weather - Cloudy',\n {0x04} 'Weather - Rainy',\n {0x08} 'Weather - Snow',\n {0x10} 'Sky Statics - Always Visible',\n {0x20} 'Sky Statics - Follows Sun Position',\n {0x40} 'Rain Occlusion',\n {0x80} 'HUD Rain Effects'\n ])),\n wbStruct('Lightning Color', [\n wbInteger('Red', itU8),\n wbInteger('Green', itU8),\n wbInteger('Blue', itU8)\n ]),\n wbInteger('Visual Effect - Begin', itU8), // scaled 0..1\n wbInteger('Visual Effect - End', itU8), // scaled 0..1\n wbInteger('Wind Direction', itU8), // scaled 0..360\n wbInteger('Wind Direction Range', itU8), // scaled 0..180\n wbInteger('Unknown', itU8)\n ], cpNormal, True, nil, 16),\n wbInteger(NAM1, 'Disabled Cloud Layers', itU32, wbFlags(['0','1','2','3','4','5','6','7','8','9','10','11','12','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31'])),\n wbRArray('Sounds',\n wbStruct(SNAM, 'Sound', [\n wbFormIDCK('Sound', [SNDR, NULL]),\n wbInteger('Type', itU32, wbEnum([\n {0x01} 'Default',\n {0x02} 'Precipitation',\n {0x04} 'Wind',\n {0x08} 'Thunder'\n ]))\n ])\n ),\n wbRArrayS('Sky Statics', wbFormIDCk(TNAM, 'Static', [STAT, NULL])),\n wbStruct(IMSP, 'Image Spaces', [\n wbFormIDCK('Sunrise', [IMGS, NULL]),\n wbFormIDCK('Day', [IMGS, NULL]),\n wbFormIDCK('Sunset', [IMGS, NULL]),\n wbFormIDCK('Night', [IMGS, NULL]),\n wbFormIDCK('EarlySunrise', [IMGS, NULL]),\n wbFormIDCK('LateSunrise', [IMGS, NULL]),\n wbFormIDCK('EarlySunset', [IMGS, NULL]),\n wbFormIDCK('LateSunset', [IMGS, NULL])\n ], cpNormal, True, nil, 4),\n wbStruct(WGDR, 'God Rays', [\n wbFormIDCK('Sunrise', [GDRY, NULL]),\n wbFormIDCK('Day', [GDRY, NULL]),\n wbFormIDCK('Sunset', [GDRY, NULL]),\n wbFormIDCK('Night', [GDRY, NULL]),\n wbFormIDCK('EarlySunrise', [GDRY, NULL]),\n wbFormIDCK('LateSunrise', [GDRY, NULL]),\n wbFormIDCK('EarlySunset', [GDRY, NULL]),\n wbFormIDCK('LateSunset', [GDRY, NULL])\n ]),\n wbRStruct('Directional Ambient Lighting Colors', [\n wbAmbientColors(DALC, 'Sunrise'),\n wbAmbientColors(DALC, 'Day'),\n wbAmbientColors(DALC, 'Sunset'),\n wbAmbientColors(DALC, 'Night'),\n wbAmbientColors(DALC, 'EarlySunrise'),\n wbAmbientColors(DALC, 'LateSunrise'),\n wbAmbientColors(DALC, 'EarlySunset'),\n wbAmbientColors(DALC, 'LateSunset')\n ], [], cpNormal, True),\n wbRStruct('Aurora', [wbMODL], []),\n wbFormIDCk(GNAM, 'Sun Glare Lens Flare', [LENS]),\n wbStruct(UNAM, 'Magic', [\n wbFormIDCk('On Lightning Strike - Spell', [SPEL, NULL]),\n wbFloat('On Lightning Strike - Threshold'),\n wbFormIDCk('On Weather Activate - Spell', [SPEL, NULL]),\n wbFloat('On Weather Activate - Threshold'),\n wbByteArray('Unknown', 4), // SPEL FormID for another context but unresolved in Fallout4.esm, legacy data\n wbFloat('Unknown')\n ], cpNormal, False, nil, 3),\n wbFloat(VNAM, 'Volatility Mult'),\n wbFloat(WNAM, 'Visibility Mult')\n ]);\nend;\n\nprocedure DefineFO4p;\nbegin\n {wbRecord(SCPT, 'SCPT', [\n wbEDID\n ]);}\nend;\n\n{>>> Start of new Fallout 4 Records <<<}\n\nprocedure DefineFO4q;\nbegin\n wbRecord(AECH, 'Audio Effect Chain', [\n wbEDID,\n wbRArray('Effects',\n wbRStruct('Effect', [\n wbInteger(KNAM, 'Type', itU32, wbEnum([], [\n Int64($864804BE), 'BSOverdrive',\n Int64($EF575F7F), 'BSStateVariableFilter',\n Int64($18837B4F), 'BSDelayEffect'\n ]), cpNormal, False, False, nil, nil, Int64($864804BE)),\n wbStruct(DNAM, 'Data', [\n wbInteger('Enabled', itU32, wbBoolEnum),\n wbUnion('Value 1', wbAECHDataDecider, [\n wbFloat('Input Gain'), // exponentially(?) normalized from 0..10 to -80..20\n wbFloat('Center Freq'),\n wbFloat('Feedback %')\n ]),\n wbUnion('Value 2', wbAECHDataDecider, [\n wbFloat('Output Gain'), // exponentially(?) normalized from 0..10 to -80..20\n wbFloat('Q Value'),\n wbFloat('Wet Mix %')\n ]),\n wbUnion('Value 3', wbAECHDataDecider, [\n wbFloat('Upper Threshold'), // exponentially(?) normalized from 0..1 to -74..0\n wbInteger('Filter Mode', itU32, wbEnum([\n 'High Pass',\n 'Low Pass',\n 'Band Pass',\n 'Notch'\n ])),\n wbInteger('Delay MS', itU32)\n ]),\n wbUnion('Value 4', wbAECHDataDecider, [\n wbFloat('Lower Threshold'), // exponentially(?) normalized from 0..1 to -80..0\n wbByteArray('Unused', 0),\n wbByteArray('Unused', 0)\n ])\n ])\n ], [])\n )\n ]);\n\n wbRecord(AMDL, 'Aim Model', [\n wbEDID,\n wbStruct(DNAM, 'Data', [\n wbFloat('Cone of Fire - Min Angle'),\n wbFloat('Cone of Fire - Max Angle'),\n wbFloat('Cone of Fire - Increase Per Shot'),\n wbFloat('Cone of Fire - Decrease Per Sec'),\n wbInteger('Cone of Fire - Decrease Delay MS', itU32),\n wbFloat('Cone of Fire - Sneak Mult'),\n wbFloat('Recoil - Diminish Spring Force'),\n wbFloat('Recoil - Diminish Sights Mult'),\n wbFloat('Recoil - Max Per Shot'),\n wbFloat('Recoil - Min Per Shot'),\n wbFloat('Recoil - Hip Mult'),\n wbInteger('Runaway - Recoil Shots', itU32),\n wbFloat('Recoil - Arc'),\n wbFloat('Recoil - Arc Rotate'),\n wbFloat('Cone of Fire - Iron Sights Mult'),\n wbFloat('Stability - Base Stability')\n ])\n ]);\n\n wbRecord(AORU, 'Attraction Rule', [\n wbEDID,\n wbStruct(AOR2, 'Data', [\n wbFloat('Radius'),\n wbFloat('Min Delay'),\n wbFloat('Max Delay'),\n wbInteger('Requires Line of Sight', itU8, wbBoolEnum),\n wbInteger('Combat Target', itU8, wbBoolEnum),\n wbByteArray('Unused', 2)\n ], cpNormal, True)\n ]);\n\n wbRecord(BNDS, 'Bendable Spline', [\n wbEDID,\n wbOBND,\n wbStruct(DNAM, 'Data', [\n wbFloat('Default Number of Tiles'),\n wbInteger('Default Number of Slices', itU16),\n wbInteger('Default Number of Tiles - Relative to Length', itU16, wbBoolEnum),\n wbFloatColors('Default Color'),\n wbFloat('Wind Settings - Sensibility'),\n wbFloat('Wind Settings - Flexibility')\n ]),\n wbFormIDCk(TNAM, 'Texture', [TXST])\n ]);\n\n wbRecord(CMPO, 'Component', [\n wbEDID,\n wbOBND,\n wbFULL,\n wbCUSD,\n wbInteger(DATA, 'Auto Calc Value', itU32),\n wbFormIDCk(MNAM, 'Scrap Item', [MISC]),\n wbFormIDCk(GNAM, 'Mod Scrap Scalar', [GLOB])\n ]);\n\n wbRecord(DFOB, 'Default Object', [\n wbEDID,\n wbFormID(DATA, 'Object')\n ]);\n\n wbRecord(DMGT, 'Damage Type', [\n wbEDID,\n // Before form version 78, it was an array of AVIF index, since then array of AVIF formID, coupled with a SPEL formID\n wbUnion(DNAM, 'Data', wbFormVer78Decider, [\n wbArray('Damage Types', wbInteger('Actor Value Index', itU32)),\n wbArray('Damage Types', wbStruct('Damage Type', [\n wbFormIDck('Actor Value', [AVIF, NULL]),\n wbFormIDck('Spell', [SPEL, NULL])\n ]))\n ])\n ]);\n\n wbRecord(GDRY, 'God Rays', [\n wbEDID,\n wbStruct(DATA, 'Data', [\n wbFloatColors('Back Color'),\n wbFloatColors('Fwd Color'),\n wbFloat('Intensity'),\n wbFloat('Air Color - Scale'),\n wbFloat('Back Color - Scale'),\n wbFloat('Fwd Color - Scale'),\n wbFloat('Back Phase'),\n wbFloatColors('Air Color'),\n wbFloat('Fwd Phase')\n ])\n ]);\n\nend;\n\nprocedure DefineFO4r;\nbegin\n wbRecord(INNR, 'Instance Naming Rules', [\n wbEDID,\n wbInteger(UNAM, 'Target', itU32, wbEnum([], [\n 0, 'None',\n $1D, 'Armor',\n $2D, 'Actor',\n $2A, 'Furniture',\n $2B, 'Weapon'\n ])),\n wbRArray('Naming Rules',\n wbRStruct('Ruleset', [\n wbInteger(VNAM, 'Count', itU32),\n // should not be sorted\n wbRArray('Names',\n wbRStruct('Name', [\n wbLString(WNAM, 'Text', 0, cpTranslate),\n wbKSIZ,\n wbKWDAs,\n wbStruct(XNAM, 'Property', [\n wbFloat('Value'),\n wbInteger('Target', itU8, wbEnum([\n { 0} 'Enchantments',\n { 1} 'BashImpactDataSet',\n { 2} 'BlockMaterial',\n { 3} 'Keywords',\n { 4} 'Weight',\n { 5} 'Value',\n { 6} 'Rating',\n { 7} 'AddonIndex',\n { 8} 'BodyPart',\n { 9} 'DamageTypeValues',\n {10} 'ActorValues',\n {11} 'Health',\n {12} 'ColorRemappingIndex',\n {13} 'MaterialSwaps'\n ])),\n wbInteger('Op', itU8, wbEnum([\n {0} '>=',\n {1} '>',\n {2} '<=',\n {3} '<',\n {4} '='\n ]))\n ]),\n wbInteger(YNAM, 'Index', itU16)\n ], []),\n cpNormal, False, nil, wbINNRAfterSet\n )\n ], [])\n )\n ]);\n\n wbRecord(KSSM, 'Sound Keyword Mapping', [\n wbEDID,\n wbFormIDCk(DNAM, 'Primary Descriptor', [SNDR]),\n wbFormIDCk(ENAM, 'Exterior Tail', [SNDR]),\n wbFormIDCk(VNAM, 'VATS Descriptor', [SNDR]),\n wbFloat(TNAM, 'VATS Threshold'),\n wbRArray('Keywords', wbFormIDCk(KNAM, 'Keyword', [KYWD])),\n wbRArrayS('Sounds', wbStructSK(RNAM, [0], 'Sound', [\n wbInteger('Reverb Class', itU32, wbReverbClassEnum),\n wbFormIDCk('Descriptor', [SNDR])\n ]))\n ]);\n\n wbRecord(LAYR, 'Layer', [\n wbEDID,\n wbFormIDCk(PNAM, 'Parent', [LAYR])\n ]);\n\n wbRecord(LENS, 'Lens Flare', [\n wbEDID,\n wbFloat(CNAM, 'Color Influence'),\n wbFloat(DNAM, 'Fade Distance Radius Scale'),\n wbInteger(LFSP, 'Count', itU32, nil, cpBenign),\n wbRArrayS('Lens Flare Sprites',\n wbRStructSK([0], 'Flare', [\n wbString(DNAM, 'Lens Flare Sprite ID'),\n wbString(FNAM, 'Texture'),\n wbStruct(LFSD, 'Lens Flare Data', [\n wbFloatColors('Tint'),\n wbFloat('Width'),\n wbFloat('Height'),\n wbFloat('Position'),\n wbFloat('Angular Fade'),\n wbFloat('Opacity'),\n wbInteger('Flags', itU32, wbFlags([\n {0x01} 'Rotates',\n {0x02} 'Shrinks When Occluded'\n ]))\n ])\n ], []),\n cpNormal, False, nil, wbLENSAfterSet\n )\n ]);\n\n {wbRecord(LSPR, 'LSPR', [\n wbEDID\n ]);\n\n wbRecord(MICN, 'MICN', [\n wbEDID\n ]);}\n\n wbRecord(MSWP, 'Material Swap',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00010000} 16, 'Custom Swap'\n ])), [\n wbEDID,\n wbString(FNAM, 'Tree Folder'), {First FNAM}\n wbRArrayS('Material Substitutions',\n wbRStructSK([0], 'Substitution', [\n wbString(BNAM, 'Original Material'),\n wbString(SNAM, 'Replacement Material'),\n wbString(FNAM, 'Tree Folder (obsolete)'), {Unused, will be moved up to First FNAM}\n wbFloat(CNAM, 'Color Remapping Index')\n ], [])\n )\n ]);\n\n wbRecord(NOCM, 'Navigation Mesh Obstacle Manager', [\n wbRArray('Unknown',\n wbRStruct('Unknown', [\n wbInteger(INDX, 'Index', itU32),\n wbRArray('Unknown', wbUnknown(DATA)),\n wbUnknown(INTV),\n wbString(NAM1, 'Model')\n ], [])\n )\n ]);\n\nend;\n\nprocedure DefineFO4s;\nbegin\n wbRecord(NOTE, 'Note', [\n wbEDID,\n wbVMAD,\n wbOBND,\n wbPTRN,\n wbFULL,\n wbMODL,\n wbICON,\n wbYNAM,\n wbZNAM,\n wbInteger(DNAM, 'Type', itU8, wbEnum([\n 'Sound',\n 'Voice',\n 'Program',\n 'Terminal'\n ]), cpNormal, True),\n wbStruct(DATA, '', [ // was DNAM before form version 65. Now holds value and weight\n wbInteger('Value', itU32),\n wbFloat('Weight')\n ]),\n wbUnion(SNAM, 'Data', wbNOTEDataDecider, [\n wbByteArray('Unused', 4),\n wbFormIDCk('Sound', [SNDR]),\n wbFormIDCk('Scene', [SCEN]),\n wbFormIDCk('Terminal', [TERM])\n ]),\n wbString(PNAM, 'Program File')\n ]);\n\n wbRecord(OMOD, 'Object Modification',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000008} 4, 'Legendary Mod',\n {0x00000040} 7, 'Mod Collection'\n ])), [\n wbEDID,\n wbFULL,\n wbDESC,\n wbMODL,\n wbStruct(DATA, 'Data', [\n wbInteger('Include Count', itU32),\n wbInteger('Property Count', itU32),\n wbByteArray('Unused', 2, cpIgnore),\n wbInteger('Form Type', itU32, wbEnum([], [\n Sig2Int(ARMO), 'Armor',\n Sig2Int(NPC_), 'Non-player character',\n Sig2Int(WEAP), 'Weapon',\n Sig2Int(NONE), 'None'\n ])),\n wbByteArray('Unused', 2, cpIgnore),\n wbFormIDCk('Attach Point', [KYWD, NULL]),\n wbArray('Attach Parent Slots', wbFormIDCk('Keyword', [KYWD, NULL]), -1),\n // no way to change these in CK, legacy data leftover?\n wbArray('Items', wbStruct('Item', [\n wbByteArray('Value 1', 4),\n wbByteArray('Value 2', 4)\n ]), -1),\n // should not be sorted\n wbArray('Includes', wbStruct('Include', [\n wbFormIDCk('Mod', [OMOD]),\n wbInteger('Minimum Level', itU8),\n wbInteger('Optional', itU8, wbBoolEnum),\n wbInteger('Don''t Use All', itU8, wbBoolEnum)\n ]), wbOMODDataIncludeCounter, cpNormal, False, nil, wbOMODincludeAfterSet),\n wbObjectModProperties\n ], cpNormal, False, nil, -1, nil, wbOMODdataAfterSet),\n wbArray(MNAM, 'Target OMOD Keywords', wbFormIDCk('Keyword', [KYWD])),\n wbArray(FNAM, 'Filter Keywords', wbFormIDCk('Keyword', [KYWD])),\n wbFormIDCk(LNAM, 'Loose Mod', sigBaseObjects),\n wbInteger(NAM1, 'Priority', itU8),\n wbFLTR\n ]);\n\n wbRecord(OVIS, 'Object Visibility Manager', [\n wbRArray('Unknown',\n wbRStruct('Unknown', [\n wbFormIDCk(INDX, 'Object', [STAT]),\n wbStruct(DATA, 'Object Bounds', [\n wbFloat('X1'),\n wbFloat('Y1'),\n wbFloat('Z1'),\n wbFloat('X2'),\n wbFloat('Y2'),\n wbFloat('Z2')\n ])\n ], [])\n )\n ]);\n\n wbRecord(PKIN, 'Pack-In',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000200} 9, 'Prefab'\n ])), [\n wbEDID,\n wbOBND,\n wbFLTR,\n wbFormIDCk(CNAM, 'Cell', [CELL]),\n wbInteger(VNAM, 'Version', itU32)\n ]);\n\n wbRecord(RFGP, 'Reference Group', [\n wbEDID,\n wbString(NNAM, 'Name'),\n wbFormIDCk(RNAM, 'Reference', sigReferences),\n wbUnknown(PNAM)\n ]);\n\n {wbRecord(RGDL, 'RGDL', [\n wbEDID\n ]);}\n\n wbRecord(SCCO, 'Scene Collection', [\n wbEDID,\n wbFormIDCk(QNAM, 'Quest', [QUST]),\n wbRArray('Scenes',\n wbRStruct('Scene', [\n wbFormIDCk(SNAM, 'Scene', [SCEN]),\n wbStruct(XNAM, 'Unknown', [\n wbInteger('Unknown', itS32),\n wbInteger('Unknown', itS32)\n ])\n ], [])\n ),\n wbUnknown(VNAM, cpNormal, True),\n wbRArray('Unknown', wbStruct(XNAM, 'Unknown', [\n wbInteger('Unknown', itS32),\n wbInteger('Unknown', itS32)\n ])),\n wbUnknown(VNAM, cpNormal, True)\n ]);\n\n wbRecord(SCOL, 'Static Collection',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 4, 'Non Occluder',\n {0x00000200} 9, 'Hidden From Local Map',\n {0x00000400} 10, 'Unknown 10',\n {0x00000800} 11, 'Used as Platform',\n {0x00008000} 15, 'Has Distant LOD',\n {0x02000000} 25, 'Obstacle',\n {0x04000000} 26, 'NavMesh Generation - Filter',\n {0x08000000} 27, 'NavMesh Generation - Bounding Box',\n {0x40000000} 30, 'NavMesh Generation - Ground'\n ])), [\n wbEDID,\n wbOBNDReq,\n wbPTRN,\n wbMODL,\n wbFULL,\n wbFLTR,\n wbRStructsSK('Parts', 'Part', [0], [\n wbFormIDCk(ONAM, 'Static', [ACTI, ALCH, AMMO, BOOK, CONT, DOOR, FURN, MISC, MSTT, STAT, TERM, WEAP]),\n wbArrayS(DATA, 'Placements', wbStruct('Placement', [\n wbStruct('Position', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ]),\n wbStruct('Rotation', [\n wbFloat('X', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Y', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize),\n wbFloat('Z', cpNormal, True, wbRotationFactor, wbRotationScale, nil, RadiansNormalize)\n ]),\n wbFloat('Scale')\n ]), 0, cpNormal, True)\n ], [], cpNormal, True)\n ]);\n\n wbRecord(SCSN, 'Audio Category Snapshot', [\n wbEDID,\n wbInteger(PNAM, 'Priority', itU16),\n wbRArray('Category Multipliers', wbStruct(CNAM, 'Category Multiplier', [\n wbFormIDCk('Categoty', [SNCT]),\n wbFloat('Multiplier')\n ]))\n ]);\n\nend;\n\nprocedure DefineFO4t;\nbegin\n {wbRecord(SKIL, 'SKIL', [\n wbEDID\n ]);}\n\n wbRecord(STAG, 'Animation Sound Tag Set', [\n wbEDID,\n wbRArray('Sounds', wbStruct(TNAM, 'Sound', [\n wbFormIDCk('Sound', [SNDR, NULL]),\n wbString('Action')\n ]))\n ]);\n\n wbRecord(TERM, 'Terminal',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00000004} 4, 'Unknown 4',\n {0x00002000} 13, 'Unknown 13',\n {0x00008000} 15, 'Has Distant LOD',\n {0x00010000} 16, 'Random Anim Start'\n ])), [\n wbEDID,\n wbVMADFragmentedPERK, // same fragments format as in PERK\n wbOBNDReq,\n wbPTRN,\n wbLString(NAM0, 'Header Text'),\n wbLString(WNAM, 'Welcome Text'),\n wbFULL,\n wbMODL,\n wbKSIZ,\n wbKWDAs,\n wbPRPS,\n wbUnknown(PNAM),\n wbFormIDCk(SNAM, 'Looping Sound', [SNDR]),\n wbUnknown(FNAM),\n wbCOCT,\n wbCNTOs,\n wbMNAMFurnitureMarker,\n wbByteArray(WBDT, 'Workbench Data (unused)', 0),\n wbString(XMRK, 'Marker Model'),\n wbSNAMMarkerParams,\n wbInteger(BSIZ, 'Count', itU32, nil, cpBenign),\n wbRArray('Body Text',\n wbRStruct('Item', [\n wbLString(BTXT, 'Text', 0, cpTranslate),\n wbCTDAs\n ], []),\n cpNormal, False, nil, wbTERMDisplayItemsAfterSet\n ),\n wbInteger(ISIZ, 'Count', itU32, nil, cpBenign),\n wbRArray('Menu Items',\n wbRStruct('Menu Item', [\n wbLString(ITXT, 'Item Text', 0, cpTranslate),\n wbLString(RNAM, 'Response Text', 0, cpTranslate),\n wbInteger(ANAM, 'Type', itU8, wbEnum([\n {0} 'Unknown 0',\n {1} 'Unknown 1',\n {2} 'Unknown 2',\n {3} 'Unknown 3',\n {4} 'Submenu - Terminal',\n {5} 'Submenu - Return to Top Level',\n {6} 'Submenu - Force Redraw',\n {7} 'Unknown 7',\n {8} 'Display Text'\n ]), cpNormal, True),\n wbInteger(ITID, 'Item ID', itU16),\n wbLString(UNAM, 'Display Text', 0, cpTranslate),\n wbString(VNAM, 'Show Image'),\n wbFormIDCk(TNAM, 'Submenu', [TERM]),\n wbCTDAs\n ], []),\n cpNormal, False, nil, wbTERMMenuItemsAfterSet\n )\n ]);\n\n {wbRecord(TLOD, 'TLOD', [\n wbEDID\n ]);\n\n wbRecord(TOFT, 'TOFT', [\n wbEDID\n ]);}\n\n wbRecord(TRNS, 'Transform',\n wbFlags(wbRecordFlagsFlags, wbFlagsList([\n {0x00008000} 16, 'Around Origin'\n ])), [\n wbEDID,\n wbStruct(DATA, 'Data', [\n wbPosRot,\n wbFloat('Scale'),\n wbFloat('Zoom Min'),\n wbFloat('Zoom Max')\n ], cpNormal, True, nil, 2)\n ]);\n\n wbRecord(ZOOM, 'Zoom', [\n wbEDID,\n wbStruct(GNAM, 'Data', [\n wbFloat('FOV Mult'),\n wbInteger('Overlay', itU32, wbEnum([\n { 0} 'Default',\n { 1} 'Fine',\n { 2} 'Duplex',\n { 3} 'German',\n { 4} 'Dot',\n { 5} 'Mil-Dot',\n { 6} 'Circle',\n { 7} 'Old Rangefind',\n { 8} 'Modern Rangefind',\n { 9} 'SVD',\n {10} 'Hand Painted',\n {11} 'Binoculars',\n {12} 'Cross',\n {13} 'Double Zero',\n {14} 'Rangefinder 1',\n {15} 'Rangefinder 2',\n {16} 'Rectangle'\n ])),\n wbFormIDCk('Imagespace Modifier', [IMAD, NULL]),\n wbStruct('Camera Offset', [\n wbFloat('X'),\n wbFloat('Y'),\n wbFloat('Z')\n ])\n ])\n ]);\n\nend;\n\nprocedure DefineFO4u;\nbegin\n wbAddGroupOrder(GMST);\n wbAddGroupOrder(KYWD);\n wbAddGroupOrder(LCRT);\n wbAddGroupOrder(AACT);\n wbAddGroupOrder(TRNS);\n wbAddGroupOrder(CMPO);\n wbAddGroupOrder(TXST);\n //wbAddGroupOrder(MICN);\n wbAddGroupOrder(GLOB);\n wbAddGroupOrder(DMGT);\n wbAddGroupOrder(CLAS);\n wbAddGroupOrder(FACT);\n wbAddGroupOrder(HDPT);\n //wbAddGroupOrder(EYES);\n wbAddGroupOrder(RACE);\n wbAddGroupOrder(SOUN);\n wbAddGroupOrder(ASPC);\n //wbAddGroupOrder(SKIL);\n wbAddGroupOrder(MGEF);\n //wbAddGroupOrder(SCPT);{>>> Unused in Skyrim, but contained in Skyrim.esm <<<}\n wbAddGroupOrder(LTEX);\n wbAddGroupOrder(ENCH);\n wbAddGroupOrder(SPEL);\n //wbAddGroupOrder(SCRL);\n wbAddGroupOrder(ACTI);\n wbAddGroupOrder(TACT);\n wbAddGroupOrder(ARMO);\n wbAddGroupOrder(BOOK);\n wbAddGroupOrder(CONT);\n wbAddGroupOrder(DOOR);\n wbAddGroupOrder(INGR);\n wbAddGroupOrder(LIGH);\n wbAddGroupOrder(MISC);\n wbAddGroupOrder(STAT);\n wbAddGroupOrder(SCOL);\n wbAddGroupOrder(MSTT);\n wbAddGroupOrder(GRAS);\n wbAddGroupOrder(TREE);\n wbAddGroupOrder(FLOR);\n wbAddGroupOrder(FURN);\n wbAddGroupOrder(WEAP);\n wbAddGroupOrder(AMMO);\n wbAddGroupOrder(NPC_);\n wbAddGroupOrder(LVLN);\n wbAddGroupOrder(KEYM);\n wbAddGroupOrder(ALCH);\n wbAddGroupOrder(IDLM);\n wbAddGroupOrder(NOTE);\n wbAddGroupOrder(PROJ);\n wbAddGroupOrder(HAZD);\n wbAddGroupOrder(BNDS);\n //wbAddGroupOrder(SLGM);\n wbAddGroupOrder(TERM);\n wbAddGroupOrder(LVLI);\n wbAddGroupOrder(WTHR);\n wbAddGroupOrder(CLMT);\n wbAddGroupOrder(SPGD);\n wbAddGroupOrder(RFCT);\n wbAddGroupOrder(REGN);\n wbAddGroupOrder(NAVI);\n wbAddGroupOrder(CELL);\n //wbAddGroupOrder(REFR);\n //wbAddGroupOrder(ACHR);\n //wbAddGroupOrder(PMIS);\n //wbAddGroupOrder(PARW);\n //wbAddGroupOrder(PGRE);\n //wbAddGroupOrder(PBEA);\n //wbAddGroupOrder(PFLA);\n //wbAddGroupOrder(PCON);\n //wbAddGroupOrder(PBAR);\n //wbAddGroupOrder(PHZD);\n wbAddGroupOrder(WRLD);\n //wbAddGroupOrder(LAND);\n //wbAddGroupOrder(NAVM);\n //wbAddGroupOrder(TLOD);\n //wbAddGroupOrder(DIAL);\n //wbAddGroupOrder(INFO);\n wbAddGroupOrder(QUST);\n wbAddGroupOrder(IDLE);\n wbAddGroupOrder(PACK);\n wbAddGroupOrder(CSTY);\n wbAddGroupOrder(LSCR);\n wbAddGroupOrder(LVSP);\n wbAddGroupOrder(ANIO);\n wbAddGroupOrder(WATR);\n wbAddGroupOrder(EFSH);\n //wbAddGroupOrder(TOFT);\n wbAddGroupOrder(EXPL);\n wbAddGroupOrder(DEBR);\n wbAddGroupOrder(IMGS);\n wbAddGroupOrder(IMAD);\n wbAddGroupOrder(FLST);\n wbAddGroupOrder(PERK);\n wbAddGroupOrder(BPTD);\n wbAddGroupOrder(ADDN);\n wbAddGroupOrder(AVIF);\n wbAddGroupOrder(CAMS);\n wbAddGroupOrder(CPTH);\n wbAddGroupOrder(VTYP);\n wbAddGroupOrder(MATT);\n wbAddGroupOrder(IPCT);\n wbAddGroupOrder(IPDS);\n wbAddGroupOrder(ARMA);\n wbAddGroupOrder(ECZN);\n wbAddGroupOrder(LCTN);\n wbAddGroupOrder(MESG);\n //wbAddGroupOrder(RGDL);{>>> Unused in Skyrim, but contained in Skyrim.esm <<<}\n wbAddGroupOrder(DOBJ);\n wbAddGroupOrder(DFOB);\n wbAddGroupOrder(LGTM);\n wbAddGroupOrder(MUSC);\n wbAddGroupOrder(FSTP);\n wbAddGroupOrder(FSTS);\n wbAddGroupOrder(SMBN);\n wbAddGroupOrder(SMQN);\n wbAddGroupOrder(SMEN);\n wbAddGroupOrder(DLBR);\n wbAddGroupOrder(MUST);\n wbAddGroupOrder(DLVW);\n //wbAddGroupOrder(WOOP);\n //wbAddGroupOrder(SHOU);\n wbAddGroupOrder(EQUP);\n wbAddGroupOrder(RELA);\n wbAddGroupOrder(SCEN);\n wbAddGroupOrder(ASTP);\n wbAddGroupOrder(OTFT);\n wbAddGroupOrder(ARTO);\n wbAddGroupOrder(MATO);\n wbAddGroupOrder(MOVT);\n wbAddGroupOrder(SNDR);\n wbAddGroupOrder(DUAL); // doesn't exist but can be created in CK\n wbAddGroupOrder(SNCT);\n wbAddGroupOrder(SOPM);\n wbAddGroupOrder(COLL);\n wbAddGroupOrder(CLFM);\n wbAddGroupOrder(REVB);\n wbAddGroupOrder(PKIN);\n wbAddGroupOrder(RFGP);\n wbAddGroupOrder(AMDL);\n wbAddGroupOrder(LAYR);\n wbAddGroupOrder(COBJ);\n wbAddGroupOrder(OMOD);\n wbAddGroupOrder(MSWP);\n wbAddGroupOrder(ZOOM);\n wbAddGroupOrder(INNR);\n wbAddGroupOrder(KSSM);\n wbAddGroupOrder(AECH);\n wbAddGroupOrder(SCCO);\n wbAddGroupOrder(AORU);\n wbAddGroupOrder(SCSN);\n wbAddGroupOrder(STAG);\n wbAddGroupOrder(NOCM);\n wbAddGroupOrder(LENS);\n //wbAddGroupOrder(LSPR);\n wbAddGroupOrder(GDRY);\n wbAddGroupOrder(OVIS);\nend;\n\nprocedure DefineFO4;\nbegin\n DefineFO4a;\n DefineFO4b;\n DefineFO4c;\n DefineFO4d;\n DefineFO4e;\n DefineFO4f;\n DefineFO4g;\n DefineFO4h;\n DefineFO4i;\n DefineFO4j;\n DefineFO4k;\n DefineFO4l;\n DefineFO4m;\n DefineFO4n;\n DefineFO4o;\n DefineFO4p;\n DefineFO4q;\n DefineFO4r;\n DefineFO4s;\n DefineFO4t;\n DefineFO4u;\n\n SetLength(wbOfficialDLC, 6);\n wbOfficialDLC[0] := 'DLCRobot.esm';\n wbOfficialDLC[1] := 'DLCWorkshop01.esm';\n wbOfficialDLC[2] := 'DLCCoast.esm';\n wbOfficialDLC[3] := 'DLCWorkshop02.esm';\n wbOfficialDLC[4] := 'DLCWorkshop03.esm';\n wbOfficialDLC[5] := 'DLCNukaWorld.esm';\nend;\n\ninitialization\nend.\n"
},
{
"path": "lib/xedit/wbDefinitionsTES3.pas",
"content": "{*******************************************************************************\n\n The contents of this file are subject to the Mozilla Public License\n Version 1.1 (the \"License\"); you may not use this file except in\n compliance with the License. You may obtain a copy of the License at\n http://www.mozilla.org/MPL/\n\n Software distributed under the License is distributed on an \"AS IS\"\n basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the\n License for the specific language governing rights and limitations\n under the License.\n\n*******************************************************************************}\n//------------------------------------------------------------------------------\n// Placeholder for future expansion\n//------------------------------------------------------------------------------\nunit wbDefinitionsTES3;\n\ninterface\n\nuses\n wbInterface;\n\nvar\n\twbPKDTFlags: IwbFlagsDef;\n\twbServiceFlags: IwbFlagsDef;\n\n\twbAxisEnum: IwbEnumDef;\n\twbBlendModeEnum: IwbEnumDef;\n\twbBlendOpEnum: IwbEnumDef;\n\twbCrimeTypeEnum: IwbEnumDef;\n\twbFormTypeEnum: IwbEnumDef;\n\twbFunctionsEnum: IwbEnumDef;\n\twbMagicSchoolEnum: IwbEnumDef;\n\twbMusicEnum: IwbEnumDef;\n\twbOBMEResolutionInfo: IwbEnumDef;\n\twbPKDTType: IwbEnumDef;\n\twbQuadrantEnum: IwbEnumDef;\n\twbSexEnum: IwbEnumDef;\n\twbSkillEnum: IwbEnumDef;\n\twbSoulGemEnum: IwbEnumDef;\n\twbSpecializationEnum: IwbEnumDef;\n\twbZTestFuncEnum: IwbEnumDef;\n\nprocedure DefineTES3;\n\nimplementation\n\nuses\n Types,\n Classes,\n SysUtils,\n Math,\n Variants;\n\nconst\n ACBS : TwbSignature = 'ACBS';\n ACHR : TwbSignature = 'ACHR';\n ACRE : TwbSignature = 'ACRE';\n TRGT : TwbSignature = 'TRGT';\n ACTI : TwbSignature = 'ACTI';\n AIDT : TwbSignature = 'AIDT';\n ALCH : TwbSignature = 'ALCH';\n AMMO : TwbSignature = 'AMMO';\n ANAM : TwbSignature = 'ANAM';\n ANIO : TwbSignature = 'ANIO';\n APPA : TwbSignature = 'APPA';\n ARMO : TwbSignature = 'ARMO';\n ATTR : TwbSignature = 'ATTR';\n ATXT : TwbSignature = 'ATXT';\n BMDT : TwbSignature = 'BMDT';\n BNAM : TwbSignature = 'BNAM';\n BOOK : TwbSignature = 'BOOK';\n BSGN : TwbSignature = 'BSGN';\n BTXT : TwbSignature = 'BTXT';\n CELL : TwbSignature = 'CELL';\n CLAS : TwbSignature = 'CLAS';\n CLMT : TwbSignature = 'CLMT';\n CLOT : TwbSignature = 'CLOT';\n CNAM : TwbSignature = 'CNAM';\n CNTO : TwbSignature = 'CNTO';\n CONT : TwbSignature = 'CONT';\n CREA : TwbSignature = 'CREA';\n CSAD : TwbSignature = 'CSAD';\n CSCR : TwbSignature = 'CSCR';\n CSDC : TwbSignature = 'CSDC';\n CSDI : TwbSignature = 'CSDI';\n CSDT : TwbSignature = 'CSDT';\n CSTD : TwbSignature = 'CSTD';\n CSTY : TwbSignature = 'CSTY';\n CTDA : TwbSignature = 'CTDA';\n CTDT : TwbSignature = 'CTDT';\n DATA : TwbSignature = 'DATA';\n DATX : TwbSignature = 'DATX';\n DELE : TwbSignature = 'DELE';\n DESC : TwbSignature = 'DESC';\n DIAL : TwbSignature = 'DIAL';\n DNAM : TwbSignature = 'DNAM';\n DOOR : TwbSignature = 'DOOR';\n EDID : TwbSignature = 'EDID';\n EDDX : TwbSignature = 'EDDX';\n EFID : TwbSignature = 'EFID';\n EFIT : TwbSignature = 'EFIT';\n ACVA : TwbSignature = 'ACVA';\n EFII : TwbSignature = 'EFII';\n EFXX : TwbSignature = 'EFXX';\n EFIX : TwbSignature = 'EFIX';\n EFME : TwbSignature = 'EFME';\n EFSH : TwbSignature = 'EFSH';\n ENAM : TwbSignature = 'ENAM';\n ENCH : TwbSignature = 'ENCH';\n ENIT : TwbSignature = 'ENIT';\n ESCE : TwbSignature = 'ESCE';\n EYES : TwbSignature = 'EYES';\n FACT : TwbSignature = 'FACT';\n FGGA : TwbSignature = 'FGGA';\n FGGS : TwbSignature = 'FGGS';\n FGTS : TwbSignature = 'FGTS';\n FLOR : TwbSignature = 'FLOR';\n FLTV : TwbSignature = 'FLTV';\n FNAM : TwbSignature = 'FNAM';\n FULL : TwbSignature = 'FULL';\n FURN : TwbSignature = 'FURN';\n GLOB : TwbSignature = 'GLOB';\n GMST : TwbSignature = 'GMST';\n GNAM : TwbSignature = 'GNAM';\n GRAS : TwbSignature = 'GRAS';\n HAIR : TwbSignature = 'HAIR';\n HCLR : TwbSignature = 'HCLR';\n HEDR : TwbSignature = 'HEDR';\n HNAM : TwbSignature = 'HNAM';\n ICO2 : TwbSignature = 'ICO2';\n ICON : TwbSignature = 'ICON';\n IDLE : TwbSignature = 'IDLE';\n NULL : TwbSignature = 'NULL';\n INAM : TwbSignature = 'INAM';\n INDX : TwbSignature = 'INDX';\n INFO : TwbSignature = 'INFO';\n INGR : TwbSignature = 'INGR';\n JNAM : TwbSignature = 'JNAM';\n KEYM : TwbSignature = 'KEYM';\n KFFZ : TwbSignature = 'KFFZ';\n LAND : TwbSignature = 'LAND';\n LIGH : TwbSignature = 'LIGH';\n LNAM : TwbSignature = 'LNAM';\n LSCR : TwbSignature = 'LSCR';\n LTEX : TwbSignature = 'LTEX';\n LVLC : TwbSignature = 'LVLC';\n LVLD : TwbSignature = 'LVLD';\n LVLF : TwbSignature = 'LVLF';\n LVLI : TwbSignature = 'LVLI';\n LVLO : TwbSignature = 'LVLO';\n LVSP : TwbSignature = 'LVSP';\n MAST : TwbSignature = 'MAST';\n MGEF : TwbSignature = 'MGEF';\n MISC : TwbSignature = 'MISC';\n MNAM : TwbSignature = 'MNAM';\n MO2B : TwbSignature = 'MO2B';\n MO2T : TwbSignature = 'MO2T';\n MO3B : TwbSignature = 'MO3B';\n MO3T : TwbSignature = 'MO3T';\n MO4B : TwbSignature = 'MO4B';\n MO4T : TwbSignature = 'MO4T';\n MOD2 : TwbSignature = 'MOD2';\n MOD3 : TwbSignature = 'MOD3';\n MOD4 : TwbSignature = 'MOD4';\n MODB : TwbSignature = 'MODB';\n MODL : TwbSignature = 'MODL';\n MODT : TwbSignature = 'MODT';\n NAM0 : TwbSignature = 'NAM0';\n NAM1 : TwbSignature = 'NAM1';\n NAM2 : TwbSignature = 'NAM2';\n NAM9 : TwbSignature = 'NAM9';\n NAME : TwbSignature = 'NAME';\n NIFT : TwbSignature = 'NIFT';\n NIFZ : TwbSignature = 'NIFZ';\n NPC_ : TwbSignature = 'NPC_';\n OFST : TwbSignature = 'OFST';\n OBME : TwbSignature = 'OBME';\n ONAM : TwbSignature = 'ONAM';\n PACK : TwbSignature = 'PACK';\n PFIG : TwbSignature = 'PFIG';\n PFPC : TwbSignature = 'PFPC';\n PGAG : TwbSignature = 'PGAG';\n PGRD : TwbSignature = 'PGRD';\n PGRI : TwbSignature = 'PGRI';\n PGRL : TwbSignature = 'PGRL';\n PGRP : TwbSignature = 'PGRP';\n PGRR : TwbSignature = 'PGRR';\n PKDT : TwbSignature = 'PKDT';\n PKID : TwbSignature = 'PKID';\n PLDT : TwbSignature = 'PLDT';\n PNAM : TwbSignature = 'PNAM';\n PSDT : TwbSignature = 'PSDT';\n PTDT : TwbSignature = 'PTDT';\n QNAM : TwbSignature = 'QNAM';\n QSDT : TwbSignature = 'QSDT';\n QSTA : TwbSignature = 'QSTA';\n QSTI : TwbSignature = 'QSTI';\n QSTR : TwbSignature = 'QSTR';\n TPIC : TwbSignature = 'TPIC';\n QUST : TwbSignature = 'QUST';\n RACE : TwbSignature = 'RACE';\n RCLR : TwbSignature = 'RCLR';\n RDAT : TwbSignature = 'RDAT';\n RDGS : TwbSignature = 'RDGS';\n RDMD : TwbSignature = 'RDMD';\n RDMP : TwbSignature = 'RDMP';\n RDOT : TwbSignature = 'RDOT';\n RDSD : TwbSignature = 'RDSD';\n RDWT : TwbSignature = 'RDWT';\n REFR : TwbSignature = 'REFR';\n PLYR : TwbSignature = 'PLYR';\n REGN : TwbSignature = 'REGN';\n RNAM : TwbSignature = 'RNAM';\n ROAD : TwbSignature = 'ROAD';\n RPLD : TwbSignature = 'RPLD';\n RPLI : TwbSignature = 'RPLI';\n SBSP : TwbSignature = 'SBSP';\n SCDA : TwbSignature = 'SCDA';\n SCHD : TwbSignature = 'SCHD';\n SCHR : TwbSignature = 'SCHR';\n SCIT : TwbSignature = 'SCIT';\n SCPT : TwbSignature = 'SCPT';\n SCRI : TwbSignature = 'SCRI';\n SCRO : TwbSignature = 'SCRO';\n SCRV : TwbSignature = 'SCRV';\n SCTX : TwbSignature = 'SCTX';\n SCVR : TwbSignature = 'SCVR';\n SGST : TwbSignature = 'SGST';\n SKIL : TwbSignature = 'SKIL';\n SLCP : TwbSignature = 'SLCP';\n SLGM : TwbSignature = 'SLGM';\n SLSD : TwbSignature = 'SLSD';\n SNAM : TwbSignature = 'SNAM';\n SNDD : TwbSignature = 'SNDD';\n SNDX : TwbSignature = 'SNDX';\n SOUL : TwbSignature = 'SOUL';\n SOUN : TwbSignature = 'SOUN';\n SPEL : TwbSignature = 'SPEL';\n SPIT : TwbSignature = 'SPIT';\n SPLO : TwbSignature = 'SPLO';\n STAT : TwbSignature = 'STAT';\n TCLF : TwbSignature = 'TCLF';\n TCLT : TwbSignature = 'TCLT';\n TES3 : TwbSignature = 'TES3';\n TNAM : TwbSignature = 'TNAM';\n TRDT : TwbSignature = 'TRDT';\n TREE : TwbSignature = 'TREE';\n UNAM : TwbSignature = 'UNAM';\n VCLR : TwbSignature = 'VCLR';\n VHGT : TwbSignature = 'VHGT';\n VNAM : TwbSignature = 'VNAM';\n VNML : TwbSignature = 'VNML';\n VTEX : TwbSignature = 'VTEX';\n VTXT : TwbSignature = 'VTXT';\n WATR : TwbSignature = 'WATR';\n WEAP : TwbSignature = 'WEAP';\n WLST : TwbSignature = 'WLST';\n WNAM : TwbSignature = 'WNAM';\n WRLD : TwbSignature = 'WRLD';\n WTHR : TwbSignature = 'WTHR';\n XACT : TwbSignature = 'XACT';\n XCCM : TwbSignature = 'XCCM';\n XCHG : TwbSignature = 'XCHG';\n XCLC : TwbSignature = 'XCLC';\n XCLL : TwbSignature = 'XCLL';\n XCLR : TwbSignature = 'XCLR';\n XCLW : TwbSignature = 'XCLW';\n XCMT : TwbSignature = 'XCMT';\n XCNT : TwbSignature = 'XCNT';\n XCWT : TwbSignature = 'XCWT';\n XESP : TwbSignature = 'XESP';\n XGLB : TwbSignature = 'XGLB';\n XHLT : TwbSignature = 'XHLT';\n XHRS : TwbSignature = 'XHRS';\n XLCM : TwbSignature = 'XLCM';\n XLOC : TwbSignature = 'XLOC';\n XLOD : TwbSignature = 'XLOD';\n XMRC : TwbSignature = 'XMRC';\n XMRK : TwbSignature = 'XMRK';\n XNAM : TwbSignature = 'XNAM';\n XOWN : TwbSignature = 'XOWN';\n XPCI : TwbSignature = 'XPCI';\n XRGD : TwbSignature = 'XRGD';\n XRNK : TwbSignature = 'XRNK';\n XRTM : TwbSignature = 'XRTM';\n XSCL : TwbSignature = 'XSCL';\n XSED : TwbSignature = 'XSED';\n XSOL : TwbSignature = 'XSOL';\n XTEL : TwbSignature = 'XTEL';\n XTRG : TwbSignature = 'XTRG';\n XXXX : TwbSignature = 'XXXX';\n ZNAM : TwbSignature = 'ZNAM';\n\nvar\n wbEDID: IwbSubRecordDef;\n wbXOWN: IwbSubRecordDef;\n wbXGLB: IwbSubRecordDef;\n wbXRGD: IwbSubRecordDef;\n wbSLSD: IwbSubRecordDef;\n wbBodyDataIndex: IwbSubRecordDef;\n wbSPLO: IwbSubRecordDef;\n wbSPLOs: IwbSubRecordArrayDef;\n wbCNTO: IwbSubRecordDef;\n wbCNTOs: IwbSubRecordArrayDef;\n wbCSDT: IwbSubRecordStructDef;\n wbCSDTs: IwbSubRecordArrayDef;\n wbFULL: IwbSubRecordDef;\n wbFULLReq: IwbSubRecordDef;\n wbXNAM: IwbSubRecordDef;\n wbXNAMs: IwbSubRecordArrayDef;\n wbDESC: IwbSubRecordDef;\n wbXSCL: IwbSubRecordDef;\n wbDATAPosRot : IwbSubRecordDef;\n wbPosRot : IwbStructDef;\n wbMODL: IwbSubRecordStructDef;\n wbCTDA: IwbSubRecordUnionDef;\n wbSCHR: IwbSubRecordUnionDef;\n wbCTDAs: IwbSubRecordArrayDef;\n wbSCROs: IwbSubRecordArrayDef;\n wbPGRP: IwbSubRecordDef;\n wbResultScript: IwbSubRecordStructDef;\n// wbResultScriptOld: IwbSubRecordStructDef;\n wbSCRI: IwbSubRecordDef;\n wbFaceGen: IwbSubRecordStructDef;\n wbENAM: IwbSubRecordDef;\n wbFGGS: IwbSubRecordDef;\n wbXLOD: IwbSubRecordDef;\n wbXESP: IwbSubRecordDef;\n wbICON: IwbSubRecordDef;\n wbEFID: IwbSubRecordDef;\n wbEFIDOBME: IwbSubRecordDef;\n wbEFIT: IwbSubRecordDef;\n wbEFITOBME: IwbSubRecordDef;\n wbEFIX: IwbSubRecordDef;\n wbSCIT: IwbSubRecordStructDef;\n wbSCITOBME: IwbSubRecordStructDef;\n wbEffects: IwbSubRecordUnionDef;\n\nfunction wbClmtMoonsPhaseLength(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n PhaseLength : Byte;\n Masser : Boolean;\n Secunda : Boolean;\nbegin\n Result := '';\n if aType = ctToSortKey then begin\n Result := IntToHex64(aInt, 2);\n end else if aType = ctToStr then begin\n PhaseLength := aInt mod 64;\n Masser := (aInt and 64) <> 0;\n Secunda := (aInt and 128) <> 0;\n if Masser then\n if Secunda then\n Result := 'Masser, Secunda / '\n else\n Result := 'Masser / '\n else\n if Secunda then\n Result := 'Secunda / '\n else\n Result := 'No Moon / ';\n Result := Result + IntToStr(PhaseLength);\n end;\nend;\n\nfunction wbClmtTime(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n Result := TimeToStr( EncodeTime(aInt div 6, (aInt mod 6) * 10, 0, 0) );\nend;\n\nvar\n wbCtdaTypeFlags : IwbFlagsDef;\n\nfunction wbCtdaType(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n s: string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and $F0 of\n $00 : Result := 'Equal to';\n $20 : Result := 'Not equal to';\n $40 : Result := 'Greater than';\n $60 : Result := 'Greater than or equal to';\n $80 : Result := 'Less than';\n $A0 : Result := 'Less than or equal to';\n else\n Result := ''\n end;\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Run on target',\n {0x04} 'Use global'\n ]);\n\n s := wbCtdaTypeFlags.ToString(aInt and $0F, aElement);\n\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n Exit;\n end;\n ctCheck: begin\n case aInt and $F0 of\n $00, $20, $40, $60, $80, $A0 : Result := '';\n else\n Result := ''\n end;\n\n if not Assigned(wbCtdaTypeFlags) then\n wbCtdaTypeFlags := wbFlags([\n {0x01} 'Or',\n {0x02} 'Run on target',\n {0x04} 'Use global'\n ]);\n\n s := wbCtdaTypeFlags.Check(aInt and $0F, aElement);\n\n if s <> '' then\n Result := Result + ' / ' + s;\n end;\n end;\nend;\n\nfunction wbIdleAnam(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and not $80 of\n 0: Result := 'Lower Body';\n 1: Result := 'Left Arm';\n 2: Result := 'Left Hand';\n 3: Result := 'Right Arm';\n 4: Result := 'Special Idle';\n 5: Result := 'Whole Body';\n 6: Result := 'Upper Body';\n else\n Result := '';\n end;\n\n if (aInt and $80) = 0 then\n Result := Result + ', Must return a file';\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2);\n end;\n ctCheck: begin\n case aInt and not $80 of\n 0..6: Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbScaledInt4ToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nconst\n PlusMinus : array[Boolean] of string = ('+', '-');\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n ctToSortKey: begin\n Result := FloatToStrF(aInt / 10000, ffFixed, 99, 4);\n if Length(Result) < 22 then\n Result := StringOfChar('0', 22 - Length(Result)) + Result;\n Result := PlusMinus[aInt < 0] + Result;\n end;\n ctCheck: Result := '';\n end;\nend;\n\nfunction wbScaledInt4ToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n f: Extended;\nbegin\n f := StrToFloat(aString);\n f := f * 10000;\n Result := Round(f);\nend;\n\nfunction wbHideFFFF(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt, 4)\n else if aType = ctToStr then\n if aInt = $FFFF then\n Result := 'None'\n else\n Result := IntToStr(aInt);\nend;\n\nfunction wbAtxtPosition(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n if aType = ctToSortKey then\n Result := IntToHex64(aInt div 17, 2) + IntToHex64(aInt mod 17, 2)\n else if aType = ctCheck then begin\n if (aInt < 0) or (aInt > 288) then\n Result := ''\n else\n Result := '';\n end else if aType = ctToStr then\n Result := IntToStr(aInt) + ' -> ' + IntToStr(aInt div 17) + ':' + IntToStr(aInt mod 17);\nend;\n\nfunction wbWthrDataClassification(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt and not 192 of\n 0: Result := 'None';\n 1: Result := 'Pleasant';\n 2: Result := 'Cloudy';\n 3: Result := 'Rainy';\n 4: Result := 'Snow';\n else\n Result := '';\n end;\n end;\n ctToSortKey: begin\n Result := IntToHex64(aInt, 2)\n end;\n ctCheck: begin\n case aInt and not 192 of\n 0..4: Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbGLOBFNAM(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n case aInt of\n Ord('s'): Result := 'Short';\n Ord('l'): Result := 'Long';\n Ord('f'): Result := 'Float';\n else\n Result := '';\n end;\n end;\n ctToSortKey: Result := Chr(aInt);\n ctCheck: begin\n case aInt of\n Ord('s'), Ord('l'), Ord('f'): Result := '';\n else\n Result := '';\n end;\n end;\n end;\nend;\n\nfunction wbPlacedAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n s: string;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['NAME'];\n if Assigned(Rec) then begin\n s := Trim(Rec.Value);\n if s <> '' then\n Result := 'places ' + s;\n end;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and (Container.ElementType <> etGroupRecord) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := Trim(Container.Name);\n if s <> '' then begin\n if Result <> '' then\n Result := Result + ' ';\n Result := Result + 'in ' + s;\n end;\n end;\nend;\n\nfunction wbCellAddInfo(const aMainRecord: IwbMainRecord): string;\nvar\n Rec: IwbRecord;\n Container: IwbContainer;\n GroupRecord : IwbGroupRecord;\n s: string;\nbegin\n Result := '';\n\n Rec := aMainRecord.RecordBySignature['XCLC'];\n if Assigned(Rec) then\n Result := 'at ' + Rec.Elements[0].Value + ',' + Rec.Elements[1].Value;\n\n Container := aMainRecord.Container;\n while Assigned(Container) and not\n (Supports(Container, IwbGroupRecord, GroupRecord) and (GroupRecord.GroupType = 1)) do\n Container := Container.Container;\n\n if Assigned(Container) then begin\n s := wbFormID.ToString(GroupRecord.GroupLabel, aMainRecord);\n if s <> '' then begin\n if Result <> '' then\n s := s + ' ';\n Result := 'in ' + s + Result;\n end;\n end;\nend;\n\nfunction wbGMSTUnionDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n rEDID: IwbRecord;\n s: string;\nbegin\n Result := 1;\n rEDID := aElement.Container.RecordBySignature[EDID];\n if Assigned(rEDID) then begin\n s := rEDID.Value;\n if Length(s) > 0 then\n case s[1] of\n 's': Result := 0;\n 'f': Result := 2;\n end;\n end;\nend;\n\nfunction wbMISCActorValueDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n MainRecord : IwbMainRecord;\nbegin\n Result := 0;\n\n if not Assigned(aElement) then\n Exit;\n\n MainRecord := aElement.ContainingMainRecord;\n if not Assigned(MainRecord) then\n Exit;\n\n if (MainRecord.Flags._Flags and $000000C0) = $000000C0 then\n Result := 1;\nend;\n\nfunction wbXLOCFillerDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Container.DataSize = 16 then\n Result := 1;\nend;\n\nfunction wbPACKPKDTDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 1;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Container.DataSize = 4 then\n Result := 0;\nend;\n\nfunction wbREFRXSEDDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Container.DataSize = 4 then\n Result := 1;\nend;\n\n\ntype\n TCTDAFunctionParamType = (\n ptNone,\n ptInteger,\n ptVariableName, //Integer\n ptSex, //Enum: Male, Female\n ptActorValue, //Enum: wbActorValue\n ptCrimeType, //?? Enum\n ptAxis, //?? Char\n ptFormType, //?? Enum\n ptQuestStage,\n\n ptObjectReference, //REFR, ACHR, ACRE, PGRE\n ptInventoryObject, //ARMO, BOOK, MISC, WEAP, AMMO, KEYM, ALCH, NOTE, ARMA\n ptActor, //ACHR, ACRE\n ptQuest, //QUST\n ptFaction, //FACT\n ptCell, //CELL\n ptClass, //CLAS\n ptRace, //RACE\n ptActorBase, //NPC_, CREA\n ptGlobal, //GLOB\n ptWeather, //WTHR\n ptPackage, //PACK\n ptOwnerOpt, //FACT, NPC_\n ptBirthsign, //BSGN\n ptFurniture, //FURN\n ptMagicItem, //SPEL\n ptMagicEffect, //MGEF\n ptWorldspace, //WRLD\n ptReferencableObject\n );\n\n PCTDAFunction = ^TCTDAFunction;\n TCTDAFunction = record\n Index: Integer;\n Name: string;\n ParamType1: TCTDAFunctionParamType;\n ParamType2: TCTDAFunctionParamType;\n end;\n\nconst\n wbCTDAFunctions : array[0..168] of TCTDAFunction = (\n (Index: 1; Name: 'GetDistance'; ParamType1: ptObjectReference),\n (Index: 5; Name: 'GetLocked'),\n (Index: 6; Name: 'GetPos'; ParamType1: ptAxis),\n (Index: 8; Name: 'GetAngle'; ParamType1: ptAxis),\n (Index: 10; Name: 'GetStartingPos'; ParamType1: ptAxis),\n (Index: 11; Name: 'GetStartingAngle'; ParamType1: ptAxis),\n (Index: 12; Name: 'GetSecondsPassed'),\n (Index: 14; Name: 'GetActorValue'; ParamType1: ptActorValue),\n (Index: 18; Name: 'GetCurrentTime'),\n (Index: 24; Name: 'GetScale'),\n (Index: 27; Name: 'GetLineOfSight'; ParamType1: ptObjectReference),\n (Index: 32; Name: 'GetInSameCell'; ParamType1: ptObjectReference),\n (Index: 35; Name: 'GetDisabled'),\n (Index: 36; Name: 'MenuMode'; ParamType1: ptInteger),\n (Index: 39; Name: 'GetDisease'),\n (Index: 40; Name: 'GetVampire'),\n (Index: 41; Name: 'GetClothingValue'),\n (Index: 42; Name: 'SameFaction'; ParamType1: ptActor),\n (Index: 43; Name: 'SameRace'; ParamType1: ptActor),\n (Index: 44; Name: 'SameSex'; ParamType1: ptActor),\n (Index: 45; Name: 'GetDetected'; ParamType1: ptActor),\n (Index: 46; Name: 'GetDead'),\n (Index: 47; Name: 'GetItemCount'; ParamType1: ptInventoryObject),\n (Index: 48; Name: 'GetGold'),\n (Index: 49; Name: 'GetSleeping'),\n (Index: 50; Name: 'GetTalkedToPC'),\n (Index: 53; Name: 'GetScriptVariable'; ParamType1: ptObjectReference; ParamType2: ptVariableName),\n (Index: 56; Name: 'GetQuestRunning'; ParamType1: ptQuest),\n (Index: 58; Name: 'GetStage'; ParamType1: ptQuest),\n (Index: 59; Name: 'GetStageDone'; ParamType1: ptQuest; ParamType2: ptQuestStage),\n (Index: 60; Name: 'GetFactionRankDifference'; ParamType1: ptFaction; ParamType2: ptActor),\n (Index: 61; Name: 'GetAlarmed'),\n (Index: 62; Name: 'IsRaining'),\n (Index: 63; Name: 'GetAttacked'),\n (Index: 64; Name: 'GetIsCreature'),\n (Index: 65; Name: 'GetLockLevel'),\n (Index: 66; Name: 'GetShouldAttack'; ParamType1: ptActor),\n (Index: 67; Name: 'GetInCell'; ParamType1: ptCell),\n (Index: 68; Name: 'GetIsClass'; ParamType1: ptClass),\n (Index: 69; Name: 'GetIsRace'; ParamType1: ptRace),\n (Index: 70; Name: 'GetIsSex'; ParamType1: ptSex),\n (Index: 71; Name: 'GetInFaction'; ParamType1: ptFaction),\n (Index: 72; Name: 'GetIsID'; ParamType1: ptReferencableObject),\n (Index: 73; Name: 'GetFactionRank'; ParamType1: ptFaction),\n (Index: 74; Name: 'GetGlobalValue'; ParamType1: ptGlobal),\n (Index: 75; Name: 'IsSnowing'),\n (Index: 76; Name: 'GetDisposition'; ParamType1: ptActor),\n (Index: 77; Name: 'GetRandomPercent'),\n (Index: 79; Name: 'GetQuestVariable'; ParamType1: ptQuest; ParamType2: ptVariableName),\n (Index: 80; Name: 'GetLevel'),\n (Index: 81; Name: 'GetArmorRating'),\n (Index: 84; Name: 'GetDeadCount'; ParamType1: ptActorBase),\n (Index: 91; Name: 'GetIsAlerted'),\n (Index: 98; Name: 'GetPlayerControlsDisabled'),\n (Index: 99; Name: 'GetHeadingAngle'; ParamType1: ptObjectReference),\n (Index: 101; Name: 'IsWeaponOut'),\n (Index: 102; Name: 'IsTorchOut'),\n (Index: 103; Name: 'IsShieldOut'),\n (Index: 104; Name: 'IsYielding'),\n (Index: 106; Name: 'IsFacingUp'),\n (Index: 107; Name: 'GetKnockedState'),\n (Index: 108; Name: 'GetWeaponAnimType'),\n (Index: 109; Name: 'GetWeaponSkillType'),\n (Index: 110; Name: 'GetCurrentAIPackage'),\n (Index: 111; Name: 'IsWaiting'),\n (Index: 112; Name: 'IsIdlePlaying'),\n (Index: 116; Name: 'GetCrimeGold'),\n (Index: 122; Name: 'GetCrime'; ParamType1: ptActor; ParamType2: ptCrimeType),\n (Index: 125; Name: 'IsGuard'),\n (Index: 127; Name: 'CanPayCrimeGold'),\n (Index: 128; Name: 'GetFatiguePercentage'),\n (Index: 129; Name: 'GetPCIsClass'; ParamType1: ptClass),\n (Index: 130; Name: 'GetPCIsRace'; ParamType1: ptRace),\n (Index: 131; Name: 'GetPCIsSex'; ParamType1: ptSex),\n (Index: 132; Name: 'GetPCInFaction'; ParamType1: ptFaction),\n (Index: 133; Name: 'SameFactionAsPC'),\n (Index: 134; Name: 'SameRaceAsPC'),\n (Index: 135; Name: 'SameSexAsPC'),\n (Index: 136; Name: 'GetIsReference'; ParamType1: ptObjectReference),\n (Index: 141; Name: 'IsTalking'),\n (Index: 142; Name: 'GetWalkSpeed'),\n (Index: 143; Name: 'GetCurrentAIProcedure'),\n (Index: 144; Name: 'GetTrespassWarningLevel'),\n (Index: 145; Name: 'IsTrespassing'),\n (Index: 146; Name: 'IsInMyOwnedCell'),\n (Index: 147; Name: 'GetWindSpeed'),\n (Index: 148; Name: 'GetCurrentWeatherPercent'),\n (Index: 149; Name: 'GetIsCurrentWeather'; ParamType1: ptWeather),\n (Index: 150; Name: 'IsContinuingPackagePCNear'),\n (Index: 153; Name: 'CanHaveFlames'),\n (Index: 154; Name: 'HasFlames'),\n (Index: 157; Name: 'GetOpenState'),\n (Index: 159; Name: 'GetSitting'),\n (Index: 160; Name: 'GetFurnitureMarkerID'),\n (Index: 161; Name: 'GetIsCurrentPackage'; ParamType1: ptPackage),\n (Index: 162; Name: 'IsCurrentFurnitureRef'; ParamType1: ptObjectReference),\n (Index: 163; Name: 'IsCurrentFurnitureObj'; ParamType1: ptFurniture),\n (Index: 170; Name: 'GetDayOfWeek'),\n (Index: 171; Name: 'IsPlayerInJail'),\n (Index: 172; Name: 'GetTalkedToPCParam'; ParamType1: ptActor),\n (Index: 175; Name: 'IsPCSleeping'),\n (Index: 176; Name: 'IsPCAMurderer'),\n (Index: 180; Name: 'GetDetectionLevel'; ParamType1: ptActor),\n (Index: 182; Name: 'GetEquipped'; ParamType1: ptInventoryObject),\n (Index: 185; Name: 'IsSwimming'),\n (Index: 190; Name: 'GetAmountSoldStolen'),\n (Index: 193; Name: 'GetPCExpelled'; ParamType1: ptFaction),\n (Index: 195; Name: 'GetPCFactionMurder'; ParamType1: ptFaction),\n (Index: 197; Name: 'GetPCFactionSteal'; ParamType1: ptFaction),\n (Index: 199; Name: 'GetPCFactionAttack'; ParamType1: ptFaction),\n (Index: 201; Name: 'GetPCFactionSubmitAuthority'; ParamType1: ptFaction),\n (Index: 203; Name: 'GetDestroyed'),\n (Index: 214; Name: 'HasMagicEffect'; ParamType1: ptMagicEffect),\n (Index: 215; Name: 'GetDoorDefaultOpen'),\n (Index: 223; Name: 'IsSpellTarget'; ParamType1: ptMagicItem),\n (Index: 224; Name: 'GetIsPlayerBirthsign'; ParamType1: ptBirthsign),\n (Index: 225; Name: 'GetPersuasionNumber'),\n (Index: 227; Name: 'HasVampireFed'),\n (Index: 228; Name: 'GetIsClassDefault'; ParamType1: ptClass),\n (Index: 229; Name: 'GetClassDefaultMatch'),\n (Index: 230; Name: 'GetInCellParam'; ParamType1: ptCell; ParamType2: ptObjectReference),\n (Index: 237; Name: 'GetIsGhost'),\n (Index: 242; Name: 'GetUnconscious'),\n (Index: 244; Name: 'GetRestrained'),\n (Index: 246; Name: 'GetIsUsedItem'; ParamType1: ptReferencableObject),\n (Index: 247; Name: 'GetIsUsedItemType'; ParamType1: ptFormType),\n (Index: 249; Name: 'GetPCFame'),\n (Index: 251; Name: 'GetPCInfamy'),\n (Index: 254; Name: 'GetIsPlayableRace'),\n (Index: 255; Name: 'GetOffersServicesNow'),\n (Index: 258; Name: 'GetUsedItemLevel'),\n (Index: 259; Name: 'GetUsedItemActivate'),\n (Index: 264; Name: 'GetBarterGold'),\n (Index: 265; Name: 'IsTimePassing'),\n (Index: 266; Name: 'IsPleasant'),\n (Index: 267; Name: 'IsCloudy'),\n (Index: 274; Name: 'GetArmorRatingUpperBody'),\n (Index: 277; Name: 'GetBaseActorValue'; ParamType1: ptActorValue),\n (Index: 278; Name: 'IsOwner'; ParamType1: ptOwnerOpt),\n (Index: 280; Name: 'IsCellOwner'; ParamType1: ptCell; ParamType2: ptOwnerOpt),\n (Index: 282; Name: 'IsHorseStolen'),\n (Index: 285; Name: 'IsLeftUp'),\n (Index: 286; Name: 'IsSneaking'),\n (Index: 287; Name: 'IsRunning'),\n (Index: 288; Name: 'GetFriendHit'; ParamType1: ptActor),\n (Index: 289; Name: 'IsInCombat'),\n (Index: 300; Name: 'IsInInterior'),\n (Index: 305; Name: 'GetInvestmentGold'),\n (Index: 306; Name: 'IsActorUsingATorch'),\n (Index: 309; Name: 'IsXBox'),\n (Index: 310; Name: 'GetInWorldspace'; ParamType1: ptWorldSpace),\n (Index: 312; Name: 'GetPCMiscStat'; ParamType1: ptInteger),\n (Index: 313; Name: 'IsActorEvil'),\n (Index: 314; Name: 'IsActorAVictim'),\n (Index: 315; Name: 'GetTotalPersuasionNumber'),\n (Index: 318; Name: 'GetIdleDoneOnce'),\n (Index: 320; Name: 'GetNoRumors'),\n (Index: 323; Name: 'WhichServiceMenu'),\n (Index: 327; Name: 'IsRidingHorse'),\n (Index: 329; Name: 'IsTurnArrest'),\n (Index: 332; Name: 'IsInDangerousWater'),\n (Index: 338; Name: 'GetIgnoreFriendlyHits'),\n (Index: 339; Name: 'IsPlayersLastRiddenHorse'),\n (Index: 353; Name: 'IsActor'),\n (Index: 354; Name: 'IsEssential'),\n (Index: 358; Name: 'IsPlayerMovingIntoNewSpace'),\n (Index: 361; Name: 'GetTimeDead'),\n (Index: 362; Name: 'GetPlayerHasLastRiddenHorse'),\n (Index: 365; Name: 'GetPlayerInSEWorld')\n );\n\nvar\n wbCTDAFunctionEditInfo : string;\n\nfunction wbCTDAParamDescFromIndex(aIndex: Integer): PCTDAFunction;\nvar\n L, H, I, C: Integer;\nbegin\n Result := nil;\n\n L := Low(wbCTDAFunctions);\n H := High(wbCTDAFunctions);\n while L <= H do begin\n I := (L + H) shr 1;\n C := CmpW32(wbCTDAFunctions[I].Index, aIndex);\n if C < 0 then\n L := I + 1\n else begin\n H := I - 1;\n if C = 0 then begin\n L := I;\n Result := @wbCTDAFunctions[L];\n end;\n end;\n end;\nend;\n\nfunction wbCTDACompValueDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n if Integer(Container.ElementByName['Type'].NativeValue) and $04 <> 0 then\n Result := 1;\nend;\n\nfunction wbEFITOBMEParamDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n ParamInfo: Variant;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n ParamInfo := Container.ElementNativeValues['..\\EFME\\EFIT Param Info'];\n if VarIsNull(ParamInfo) or VarIsEmpty(ParamInfo) then\n else\n Result := ParamInfo;\nend;\n\nfunction wbEFIXParamDecider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n ParamInfo: Variant;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n ParamInfo := Container.ElementNativeValues['..\\EFME\\EFIX Param Info'];\n if VarIsNull(ParamInfo) or VarIsEmpty(ParamInfo) then\n else\n Result := ParamInfo;\nend;\n\nfunction wbCTDAParam1Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n if Assigned(Desc) then\n Result := Succ(Integer(Desc.ParamType1));\nend;\n\nfunction wbCTDAParam2Decider(aBasePtr: Pointer; aEndPtr: Pointer; const aElement: IwbElement): Integer;\nvar\n Desc: PCTDAFunction;\n Container: IwbContainer;\nbegin\n Result := 0;\n if not Assigned(aElement) then Exit;\n Container := GetContainerFromUnion(aElement);\n if not Assigned(Container) then Exit;\n\n Desc := wbCTDAParamDescFromIndex(Container.ElementByName['Function'].NativeValue);\n if Assigned(Desc) then\n Result := Succ(Integer(Desc.ParamType2));\nend;\n{\nfunction wbCTDAFunction(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Desc: PCTDAFunction;\nbegin\n Result := '';\n case aType of\n ctToStr: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := Desc.Name\n else\n Result := '';\n end;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctCheck: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := ''\n else\n Result := '';\n end;\n end;\nend;\n}\nfunction wbCTDAFunctionToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Desc : PCTDAFunction;\n i : Integer;\nbegin\n Result := '';\n case aType of\n ctToStr, ctToEditValue: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := Desc.Name\n else if aType = ctToEditValue then\n Result := IntToStr(aInt)\n else\n Result := '';\n end;\n ctToSortKey: Result := IntToHex(aInt, 8);\n ctCheck: begin\n Desc := wbCTDAParamDescFromIndex(aInt);\n if Assigned(Desc) then\n Result := ''\n else\n Result := '';\n end;\n ctEditType:\n Result := 'ComboBox';\n ctEditInfo: begin\n Result := wbCTDAFunctionEditInfo;\n if Result = '' then begin\n with TStringList.Create do try\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n Add(wbCTDAFunctions[i].Name);\n Sort;\n Result := CommaText;\n finally\n Free;\n end;\n wbCTDAFunctionEditInfo := Result;\n end;\n end;\n end;\nend;\n\nfunction wbCTDAFunctionToInt(const aString: string; const aElement: IwbElement): Int64;\nvar\n i: Integer;\nbegin\n for i := Low(wbCTDAFunctions) to High(wbCTDAFunctions) do\n with wbCTDAFunctions[i] do\n if SameText(Name, aString) then begin\n Result := Index;\n Exit;\n end;\n Result := StrToInt64(aString);\nend;\n\nfunction wbCTDAParam2VariableNameToStr(aInt: Int64; const aElement: IwbElement; aType: TwbCallbackType): string;\nvar\n Container : IwbContainerElementRef;\n Param1 : IwbElement;\n MainRecord : IwbMainRecord;\n BaseRecord : IwbMainRecord;\n ScriptRef : IwbElement;\n Script : IwbMainRecord;\n Variables : TStringList;\n LocalVars : IwbContainerElementRef;\n LocalVar : IwbContainerElementRef;\n i, j : Integer;\n s : string;\nbegin\n case aType of\n ctToStr: Result := IntToStr(aInt) + ' ';\n ctToEditValue: Result := IntToStr(aInt);\n ctToSortKey: begin\n Result := IntToHex64(aInt, 8);\n Exit;\n end;\n ctCheck: Result := '