From: DeaDDooMER Date: Thu, 7 Sep 2023 16:40:46 +0000 (+0300) Subject: system: implement zip support again X-Git-Url: https://deadsoftware.ru/gitweb?p=d2df-editor.git;a=commitdiff_plain;h=952e5c9c629e44e260c55f2756d72a199d8d9052 system: implement zip support again --- diff --git a/lang/editor.ru_RU.lng b/lang/editor.ru_RU.lng index 29bf4c9..164410c 100644 --- a/lang/editor.ru_RU.lng +++ b/lang/editor.ru_RU.lng @@ -1222,10 +1222,14 @@ g_language.MsgWadSpecialMap = "" g_language.MsgWadSpecialTexs$ = "" g_language.MsgWadSpecialTexs = "<СПЕЦТЕКСТУРЫ>" -g_language.MsgFileFilterAll$ = "Doom 2D: Forever Maps (*.wad)|*.wad|Doom 2D: Forever 0.30 Maps (*.ini)|*.ini|All Files (*.*)|*.*" -g_language.MsgFileFilterAll = "Карты Doom 2D: Forever (*.wad)|*.wad|Старые карты Doom 2D: Forever 0.30 (*.ini)|*.ini|Все файлы (*.*)|*.*" -g_language.MsgFileFilterWad$ = "Doom 2D: Forever Maps (*.wad)|*.wad|All Files (*.*)|*.*" -g_language.MsgFileFilterWad = "Карты Doom 2D: Forever (*.wad)|*.wad|Все файлы (*.*)|*.*" +g_language.MsgFileFilterSaveDFWAD$ = "DFWAD Packed Doom 2D: Forever Maps (*.wad)|*.wad" +g_language.MsgFileFilterSaveDFWAD = "Карты Doom 2D: Forever упакованные в DFWAD (*.wad)|*.wad" +g_language.MsgFileFilterSaveDFZIP$ = "DFZIP Packed Doom 2D: Forever Maps (*.dfz)|*.dfz" +g_language.MsgFileFilterSaveDFZIP = "Карты Doom 2D: Forever упакованные в DFZIP (*.dfz)|*.dfz" +g_language.MsgFileFilterAll$ = "Doom 2D: Forever Maps (*.dfz, *.wad)|*.wad;*.dfz|Doom 2D: Forever 0.30 Maps (*.ini)|*.ini|All Files (*.*)|*.*" +g_language.MsgFileFilterAll = "Карты Doom 2D: Forever Maps (*.dfz, *.wad)|*.wad;*.dfz|Старые карты Doom 2D: Forever 0.30 (*.ini)|*.ini|Все файлы (*.*)|*.*" +g_language.MsgFileFilterWad$ = "Doom 2D: Forever Maps (*.dfz, *.wad)|*.wad;*.dfz|All Files (*.*)|*.*" +g_language.MsgFileFilterWad = "Карты Doom 2D: Forever (*.dfz, *.wad)|*.wad;*.dfz|Все файлы (*.*)|*.*" g_language.MsgFileFilterExeMac$ = "Doom 2D Forever.app|*.app|Doom 2D Forever (Unix Executable)|Doom2DF;*" g_language.MsgFileFilterExeMac = "Doom 2D Forever.app|*.app|Doom 2D Forever (Исполняемый файл)|Doom2DF;*" g_language.MsgFileFilterExeWin$ = "Doom2DF.exe|Doom2DF.exe;*.exe" diff --git a/src/editor/Editor.lpr b/src/editor/Editor.lpr index eaf830d..6075985 100644 --- a/src/editor/Editor.lpr +++ b/src/editor/Editor.lpr @@ -16,6 +16,8 @@ uses MAPWRITER in '../shared/MAPWRITER.pas', MAPDEF in '../shared/MAPDEF.pas', WADEDITOR in '../shared/WADEDITOR.pas', + WADEDITOR_dfwad in '../shared/WADEDITOR_dfwad.pas', + WADEDITOR_dfzip in '../shared/WADEDITOR_dfzip.pas', WADSTRUCT in '../shared/WADSTRUCT.pas', CONFIG in '../shared/CONFIG.pas', f_about in 'f_about.pas' {AboutForm}, diff --git a/src/editor/f_addresource_texture.pas b/src/editor/f_addresource_texture.pas index 13adf3c..b2551c5 100644 --- a/src/editor/f_addresource_texture.pas +++ b/src/editor/f_addresource_texture.pas @@ -61,7 +61,6 @@ var ResourceName: String; Data: Pointer; Size: Integer; - Sign: Array [0..4] of Char; Sections, Resources: SArray; a: Integer; @@ -86,16 +85,6 @@ begin WAD.FreeWAD(); -// Проверка сигнатуры. Если есть - это WAD внутри WAD: - CopyMemory(@Sign[0], Data, 5); - - if not (Sign = DFWAD_SIGNATURE) then - begin - WAD.Free(); - FreeMem(Data); - Exit; - end; - // Пробуем прочитать данные: if not WAD.ReadMemory(Data, Size) then begin diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 2bd2fc6..186e507 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -6351,7 +6351,7 @@ begin g_ProcessResourceStr(OpenedMap, FileName, Section, Res); - SaveMap(FileName+':\'+Res); + SaveMap(FileName+':\'+Res, ''); end; procedure TMainForm.aOpenMapExecute(Sender: TObject); @@ -6607,35 +6607,59 @@ begin end; procedure TMainForm.aSaveMapAsExecute(Sender: TObject); -var - idx: Integer; + var i, idx: Integer; list: TStringList; fmt: String; begin - SaveDialog.Filter := MsgFileFilterWad; - - if not SaveDialog.Execute() then - Exit; + list := TStringList.Create(); - SaveMapForm.GetMaps(SaveDialog.FileName, True); + // TODO: get loclized strings automatically from language files + SaveDialog.DefaultExt := '.dfz'; + SaveDialog.FilterIndex := 1; + SaveDialog.Filter := ''; + gWADEditorFactory.GetRegistredEditors(list); + for i := 0 to list.Count - 1 do + begin + if list[i] = 'DFZIP' then + SaveDialog.FilterIndex := i + 1; - if SaveMapForm.ShowModal() <> mrOK then - Exit; + if i <> 0 then + SaveDialog.Filter := SaveDialog.Filter + '|'; - SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName); - OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text; - OpenedWAD := SaveDialog.FileName; + if list[i] = 'DFWAD' then + SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFWAD + else if list[i] = 'DFZIP' then + SaveDialog.Filter := SaveDialog.Filter + MsgFileFilterSaveDFZIP + else + SaveDialog.Filter := SaveDialog.Filter + list[i] + '|*.*'; + end; - idx := RecentFiles.IndexOf(OpenedMap); -// Такая карта уже недавно открывалась: - if idx >= 0 then - RecentFiles.Delete(idx); - RecentFiles.Insert(0, OpenedMap); - RefreshRecentMenu; + if SaveDialog.Execute() then + begin + i := SaveDialog.FilterIndex - 1; + if (i >= 0) and (i < list.Count) then fmt := list[i] else fmt := ''; - SaveMap(OpenedMap); + SaveMapForm.GetMaps(SaveDialog.FileName, True, fmt); + if SaveMapForm.ShowModal() = mrOK then + begin + SaveDialog.InitialDir := ExtractFileDir(SaveDialog.FileName); + OpenedMap := SaveDialog.FileName+':\'+SaveMapForm.eMapName.Text; + OpenedWAD := SaveDialog.FileName; + + idx := RecentFiles.IndexOf(OpenedMap); + // Такая карта уже недавно открывалась: + if idx >= 0 then + RecentFiles.Delete(idx); + RecentFiles.Insert(0, OpenedMap); + RefreshRecentMenu; + + SaveMap(OpenedMap, fmt); + + gMapInfo.FileName := SaveDialog.FileName; + gMapInfo.MapName := SaveMapForm.eMapName.Text; + UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName); + end; + end; - gMapInfo.FileName := SaveDialog.FileName; - gMapInfo.MapName := SaveMapForm.eMapName.Text; - UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName); + list.Free(); end; procedure TMainForm.aSelectAllExecute(Sender: TObject); @@ -6929,7 +6953,7 @@ begin newWad := newWad + '.wad' end; tempMap := newWAD + ':\' + TEST_MAP_NAME; - SaveMap(tempMap); + SaveMap(tempMap, ''); // Опции игры: opt := 32 + 64; diff --git a/src/editor/f_packmap.pas b/src/editor/f_packmap.pas index 911700b..9aaccfe 100644 --- a/src/editor/f_packmap.pas +++ b/src/editor/f_packmap.pas @@ -150,7 +150,7 @@ begin msection := eMSection.Text; // Сохраняем карту в память: - data := SaveMap(''); + data := SaveMap('', ''); if data = nil then Exit; diff --git a/src/editor/f_savemap.pas b/src/editor/f_savemap.pas index e57fb79..a78e600 100644 --- a/src/editor/f_savemap.pas +++ b/src/editor/f_savemap.pas @@ -17,7 +17,7 @@ type Panel2: TPanel; eMapName: TEdit; - procedure GetMaps(FileName: String; placeName: Boolean); + procedure GetMaps(FileName: String; placeName: Boolean; ArchiveFormat: String); procedure FormActivate(Sender: TObject); procedure eMapNameChange(Sender: TObject); procedure lbMapListClick(Sender: TObject); @@ -84,9 +84,9 @@ begin SaveMapForm.ModalResult := mrCancel; end; -procedure TSaveMapForm.GetMaps(FileName: String; placeName: Boolean); +procedure TSaveMapForm.GetMaps(FileName: String; placeName: Boolean; ArchiveFormat: String); var - WAD: TWADEditor_1; + WAD: TWADEditor; a, max_num, j: Integer; ResList: SArray; Data: Pointer; @@ -98,8 +98,21 @@ begin lbMapList.Items.Clear(); max_num := 1; - WAD := TWADEditor_1.Create(); - WAD.ReadFile(FileName); + if ArchiveFormat = '' then + begin + // format not specified -> try open automatically and append to it (or create new default) + WAD := gWADEditorFactory.OpenFile(FileName); + if WAD = nil then + WAD := gWADEditorFactory.CreateDefaultEditor(); + end + else + begin + // format specified -> appned using exactly this format (overwrite if not compatible) + WAD := gWADEditorFactory.CreateEditor(ArchiveFormat); + if WAD.ReadFile(FileName) = False then + WAD.FreeWAD(); + end; + ResList := WAD.GetResourcesList(''); if ResList <> nil then diff --git a/src/editor/g_language.pas b/src/editor/g_language.pas index 3f7c5de..a443502 100644 --- a/src/editor/g_language.pas +++ b/src/editor/g_language.pas @@ -627,8 +627,10 @@ Interface MsgWadSpecialMap = ''; MsgWadSpecialTexs = ''; - MsgFileFilterAll = 'Doom 2D: Forever Maps (*.wad)|*.wad|Doom 2D: Forever 0.30 Maps (*.ini)|*.ini|All Files (*.*)|*.*'; - MsgFileFilterWad = 'Doom 2D: Forever Maps (*.wad)|*.wad|All Files (*.*)|*.*'; + MsgFileFilterSaveDFWAD = 'DFWAD Packed Doom 2D: Forever Maps (*.wad)|*.wad'; + MsgFileFilterSaveDFZIP = 'DFZIP Packed Doom 2D: Forever Maps (*.dfz)|*.dfz'; + MsgFileFilterAll = 'Doom 2D: Forever Maps (*.dfz, *.wad)|*.wad;*.dfz|Doom 2D: Forever 0.30 Maps (*.ini)|*.ini|All Files (*.*)|*.*'; + MsgFileFilterWad = 'Doom 2D: Forever Maps (*.dfz, *.wad)|*.wad;*.dfz|All Files (*.*)|*.*'; MsgFileFilterExeMac = 'Doom 2D Forever.app|*.app|Doom 2D Forever (Unix Executable)|Doom2DF;*'; MsgFileFilterExeWin = 'Doom2DF.exe|Doom2DF.exe;*.exe'; MsgFileFilterExeUnix = 'Doom2DF|Doom2DF;*'; diff --git a/src/editor/g_map.pas b/src/editor/g_map.pas index a93a75a..d206791 100644 --- a/src/editor/g_map.pas +++ b/src/editor/g_map.pas @@ -233,7 +233,7 @@ function IsSpecialTexture(TextureName: String): Boolean; function SpecialTextureID(TextureName: String): DWORD; procedure ClearMap(); -function SaveMap(Res: String): Pointer; +function SaveMap(Res, ArchiveFormat: String): Pointer; function LoadMap(Res: String): Boolean; function LoadMapOld(_FileName: String): Boolean; procedure DrawMap(); @@ -1051,9 +1051,9 @@ begin Result := TEXTURE_SPECIAL_ACID2; end; -function SaveMap(Res: String): Pointer; +function SaveMap(Res, ArchiveFormat: String): Pointer; var - WAD: TWADEditor_1; + WAD: TWADEditor; MapWriter: TMapWriter_1; textures: TTexturesRec1Array; panels: TPanelsRec1Array; @@ -1086,11 +1086,22 @@ begin // Открываем WAD, если надо: if Res <> '' then begin - WAD := TWADEditor_1.Create(); g_ProcessResourceStr(Res, FileName, SectionName, ResName); - if not WAD.ReadFile(FileName) then - WAD.FreeWAD(); + if ArchiveFormat = '' then + begin + // format not specified -> try open automatically and append to it (or create new default) + WAD := gWADEditorFactory.OpenFile(FileName); + if WAD = nil then + WAD := gWADEditorFactory.CreateDefaultEditor(); + end + else + begin + // format specified -> appned using exactly this format (overwrite if not compatible) + WAD := gWADEditorFactory.CreateEditor(ArchiveFormat); + if WAD.ReadFile(FileName) = False then + WAD.FreeWAD(); + end; WAD.CreateImage(); end; diff --git a/src/shared/WADEDITOR.pas b/src/shared/WADEDITOR.pas index 5e0573e..db62d0e 100644 --- a/src/shared/WADEDITOR.pas +++ b/src/shared/WADEDITOR.pas @@ -1,919 +1,449 @@ -unit WADEDITOR; +{$INCLUDE ../shared/a_modes.inc} -{ ------------------------------------ -WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08 +unit WADEDITOR; -Ïîääåðæêà âàäîâ âåðñèè 1 ------------------------------------ -} +// TWADEditor errors: +// - Create = DFWAD_NOERROR +// - FreeWAD = DFWAD_NOERROR +// - ReadFile -> DFWAD_ERROR_WADNOTFOUND, DFWAD_ERROR_CANTOPENWAD, DFWAD_ERROR_FILENOTWAD, DFWAD_ERROR_WRONGVERSION, DFWAD_ERROR_READWAD, DFWAD_NOERROR +// - ReadMemory -> DFWAD_ERROR_FILENOTWAD, DFWAD_ERROR_WRONGVERSION, DFWAD_NOERROR +// - CreateImage -> DFWAD_ERROR_WADNOTLOADED, DFWAD_OPENED_MEMORY, DFWAD_ERROR_CANTOPENWAD, DFWAD_NOERROR +// - AddResource (pointer) +// - AddResource (filename) -> DFWAD_ERROR_CANTOPENWAD, DFWAD_ERROR_READWAD, DFWAD_NOERROR +// - AddAlias +// - AddSection +// - RemoveResource +// - SaveTo +// - HaveResource +// - HaveSection +// - GetResource -> DFWAD_ERROR_WADNOTLOADED, DFWAD_ERROR_RESOURCENOTFOUND, DFWAD_ERROR_CANTOPENWAD, DFWAD_NOERROR +// - GetSectionList +// - GetResourcesList interface -uses WADSTRUCT; - -type - SArray = array of ShortString; - - TWADEditor_1 = class(TObject) - private - FResData: Pointer; - FResTable: packed array of TResourceTableRec_1; - FHeader: TWADHeaderRec_1; - FDataSize: LongWord; - FOffset: LongWord; - FFileName: string; - FWADOpened: Byte; - FLastError: Integer; - FVersion: Byte; - function LastErrorString(): string; - function GetResName(ResName: string): Char16; - public - constructor Create(); - destructor Destroy(); override; - procedure FreeWAD(); - function ReadFile(FileName: string): Boolean; - function ReadMemory(Data: Pointer; Len: LongWord): Boolean; - procedure CreateImage(); - function AddResource(Data: Pointer; Len: LongWord; Name: string; - Section: string): Boolean; overload; - function AddResource(FileName, Name, Section: string): Boolean; overload; - function AddAlias(Res, Alias: string): Boolean; - procedure AddSection(Name: string); - procedure RemoveResource(Section, Resource: string); - procedure SaveTo(FileName: string); - function HaveResource(Section, Resource: string): Boolean; - function HaveSection(Section: string): Boolean; - function GetResource(Section, Resource: string; var pData: Pointer; - var Len: Integer): Boolean; - function GetSectionList(): SArray; - function GetResourcesList(Section: string): SArray; - - property GetLastError: Integer read FLastError; - property GetLastErrorStr: string read LastErrorString; - property GetResourcesCount: Word read FHeader.RecordsCount; - property GetVersion: Byte read FVersion; - end; - -const - DFWAD_NOERROR = 0; - DFWAD_ERROR_WADNOTFOUND = -1; - DFWAD_ERROR_CANTOPENWAD = -2; - DFWAD_ERROR_RESOURCENOTFOUND = -3; - DFWAD_ERROR_FILENOTWAD = -4; - DFWAD_ERROR_WADNOTLOADED = -5; - DFWAD_ERROR_READRESOURCE = -6; - DFWAD_ERROR_READWAD = -7; - DFWAD_ERROR_WRONGVERSION = -8; - - - procedure g_ProcessResourceStr(ResourceStr: String; var FileName, - SectionName, ResourceName: String); overload; - procedure g_ProcessResourceStr(ResourceStr: String; FileName, - SectionName, ResourceName: PString); overload; - -implementation - -uses - SysUtils, BinEditor, ZLib, utils, e_log; - -const - DFWAD_OPENED_NONE = 0; - DFWAD_OPENED_FILE = 1; - DFWAD_OPENED_MEMORY = 2; - -procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; - OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); -var - strm: TZStreamRec; - P: Pointer; - BufInc: Integer; -begin - FillChar(strm, sizeof(strm), 0); - BufInc := (InBytes + 255) and not 255; - if OutEstimate = 0 then - OutBytes := BufInc - else - OutBytes := OutEstimate; - GetMem(OutBuf, OutBytes); - try - strm.next_in := InBuf; - strm.avail_in := InBytes; - strm.next_out := OutBuf; - strm.avail_out := OutBytes; - inflateInit_(strm, zlib_version, sizeof(strm)); - try - while inflate(strm, Z_FINISH) <> Z_STREAM_END do - begin - P := OutBuf; - Inc(OutBytes, BufInc); - ReallocMem(OutBuf, OutBytes); - strm.next_out := PByteF(PChar(OutBuf) + (PChar(strm.next_out) - PChar(P))); - strm.avail_out := BufInc; - end; - finally - inflateEnd(strm); + uses Classes; + + const + DFWAD_NOERROR = 0; + DFWAD_ERROR_WADNOTFOUND = -1; + DFWAD_ERROR_CANTOPENWAD = -2; + DFWAD_ERROR_RESOURCENOTFOUND = -3; + DFWAD_ERROR_FILENOTWAD = -4; + DFWAD_ERROR_WADNOTLOADED = -5; + DFWAD_ERROR_READRESOURCE = -6; + DFWAD_ERROR_READWAD = -7; + DFWAD_ERROR_WRONGVERSION = -8; + + type + SArray = array of ShortString; + + TWADEditor = class abstract(TObject) + public + function ReadFile(FileName: string): Boolean; + + function ReadFile2(FileName: string): Boolean; virtual; abstract; + function ReadMemory(Data: Pointer; Len: LongWord): Boolean; virtual; abstract; + procedure FreeWAD(); virtual; abstract; + procedure CreateImage(); virtual; abstract; + function AddResource(Data: Pointer; Len: LongWord; Name: string; Section: string): Boolean; virtual; abstract; overload; + function AddResource(FileName, Name, Section: string): Boolean; overload; virtual; abstract; + function AddAlias(Res, Alias: string): Boolean; virtual; abstract; + procedure AddSection(Name: string); virtual; abstract; + procedure RemoveResource(Section, Resource: string); virtual; abstract; + procedure SaveTo(FileName: string); virtual; abstract; + function HaveResource(Section, Resource: string): Boolean; virtual; abstract; + function HaveSection(Section: string): Boolean; virtual; abstract; + function GetResource(Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; virtual; abstract; + function GetSectionList(): SArray; virtual; abstract; + function GetResourcesList(Section: string): SArray; virtual; abstract; + + function GetLastError: Integer; virtual; abstract; + function GetLastErrorStr: String; virtual; abstract; + function GetResourcesCount: Word; virtual; abstract; + function GetVersion: Byte; virtual; abstract; end; - ReallocMem(OutBuf, strm.total_out); - OutBytes := strm.total_out; - except - FreeMem(OutBuf); - raise - end; -end; - -procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; - out OutBuf: Pointer; out OutBytes: Integer); -var - strm: TZStreamRec; - P: Pointer; -begin - FillChar(strm, sizeof(strm), 0); - OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; - GetMem(OutBuf, OutBytes); - try - strm.next_in := InBuf; - strm.avail_in := InBytes; - strm.next_out := OutBuf; - strm.avail_out := OutBytes; - deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)); - try - while deflate(strm, Z_FINISH) <> Z_STREAM_END do - begin - P := OutBuf; - Inc(OutBytes, 256); - ReallocMem(OutBuf, OutBytes); - strm.next_out := PByteF(PtrUInt(OutBuf + (strm.next_out - P))); - strm.avail_out := 256; - end; - finally - deflateEnd(strm); - end; - ReallocMem(OutBuf, strm.total_out); - OutBytes := strm.total_out; - except - FreeMem(OutBuf); - raise - end; -end; - -procedure g_ProcessResourceStr(ResourceStr: String; var FileName, - SectionName, ResourceName: String); -var - a, i: Integer; - -begin - for i := Length(ResourceStr) downto 1 do - if ResourceStr[i] = ':' then - Break; - FileName := Copy(ResourceStr, 1, i-1); + TWADEditorClass = class of TWADEditor; - for a := i+1 to Length(ResourceStr) do - if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break; + TWADEditorMapping = class sealed(TObject) + private + FName: String; + FWADEditorClass: TWADEditorClass; + public + constructor CreateEx(const name: String; const eclass: TWADEditorClass); + property Name: String read FName; + property WADEditorClass: TWADEditorClass read FWADEditorClass; + end; - ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a)); - SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2); -end; + TWADEditorFactory = class sealed(TObject) + private + FMappings: TStringList; + FDefault: TWADEditorClass; + public + constructor Create; + destructor Destroy; override; + procedure RegisterEditor(const name: String; const eclass: TWADEditorClass); + procedure SetDefaultEditor(const name: String); + function CreateEditor(const name: String): TWADEditor; + function CreateDefaultEditor(): TWADEditor; + function OpenFile(FileName: String): TWADEditor; + function OpenMemory(Data: Pointer; Len: Integer): TWADEditor; + procedure GetRegistredEditors(var list: TStringList); + end; -procedure g_ProcessResourceStr(ResourceStr: AnsiString; FileName, - SectionName, ResourceName: PAnsiString); -var - a, i, l1, l2: Integer; + // TWADEditor_1 deprecated + TWADEditor_1 = class sealed(TObject) + private + FBase: TWADEditor; + public + constructor Create(); + destructor Destroy(); override; + procedure FreeWAD(); + function ReadFile(FileName: string): Boolean; + function ReadMemory(Data: Pointer; Len: LongWord): Boolean; + procedure CreateImage(); + function AddResource(Data: Pointer; Len: LongWord; Name: string; Section: string): Boolean; overload; + function AddResource(FileName, Name, Section: string): Boolean; overload; + function AddAlias(Res, Alias: string): Boolean; + procedure AddSection(Name: string); + procedure RemoveResource(Section, Resource: string); + procedure SaveTo(FileName: string); + function HaveResource(Section, Resource: string): Boolean; + function HaveSection(Section: string): Boolean; + function GetResource(Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; + function GetSectionList(): SArray; + function GetResourcesList(Section: string): SArray; + + function GetLastError: Integer; + function GetLastErrorStr: String; + function GetResourcesCount: Word; + function GetVersion: Byte; + end; -begin - for i := Length(ResourceStr) downto 1 do - if ResourceStr[i] = ':' then - Break; + procedure g_ProcessResourceStr(ResourceStr: String; var FileName, SectionName, ResourceName: String); overload; + procedure g_ProcessResourceStr(ResourceStr: String; FileName, SectionName, ResourceName: PString); overload; - if FileName <> nil then - begin - FileName^ := Copy(ResourceStr, 1, i-1); - l1 := Length(FileName^); - end - else - l1 := 0; + function gWADEditorFactory: TWADEditorFactory; - for a := i+1 to Length(ResourceStr) do - if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break; +implementation - if ResourceName <> nil then - begin - ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a)); - l2 := Length(ResourceName^); - end - else - l2 := 0; + uses SysUtils, utils; - if SectionName <> nil then - SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2); -end; + var + uWADEditorFactory: TWADEditorFactory; -{ TWADEditor_1 } + procedure g_ProcessResourceStr(ResourceStr: String; var FileName, SectionName, ResourceName: String); + var a, i: Integer; + begin + for i := Length(ResourceStr) downto 1 do + if ResourceStr[i] = ':' then + Break; -function TWADEditor_1.AddResource(Data: Pointer; Len: LongWord; Name: string; - Section: string): Boolean; -var - ResCompressed: Pointer; - ResCompressedSize: Integer; - a, b: Integer; -begin - Result := False; + FileName := Copy(ResourceStr, 1, i-1); - SetLength(FResTable, Length(FResTable)+1); + for a := i+1 to Length(ResourceStr) do + if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break; - if Section = '' then - begin - if Length(FResTable) > 1 then - for a := High(FResTable) downto 1 do - FResTable[a] := FResTable[a-1]; + ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a)); + SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2); + end; - a := 0; - end - else - begin - Section := AnsiUpperCase(Section); - b := -1; - - for a := 0 to High(FResTable) do - if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then - begin - for b := High(FResTable) downto a+2 do - FResTable[b] := FResTable[b-1]; + procedure g_ProcessResourceStr(ResourceStr: AnsiString; FileName, SectionName, ResourceName: PAnsiString); + var a, i, l1, l2: Integer; + begin + for i := Length(ResourceStr) downto 1 do + if ResourceStr[i] = ':' then + Break; - b := a+1; - Break; - end; - - if b = -1 then - begin - SetLength(FResTable, Length(FResTable)-1); - Exit; - end; - a := b; - end; - - ResCompressed := nil; - ResCompressedSize := 0; - CompressBuf(Data, Len, ResCompressed, ResCompressedSize); - if ResCompressed = nil then Exit; - e_WriteLog('Fuck me (D)', MSG_NOTIFY); - - if FResData = nil then FResData := AllocMem(ResCompressedSize) - else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize)); - - FDataSize := FDataSize+LongWord(ResCompressedSize); - - CopyMemory(Pointer(PChar(FResData)+FDataSize-PChar(ResCompressedSize)), - ResCompressed, ResCompressedSize); - FreeMemory(ResCompressed); - - Inc(FHeader.RecordsCount); - - with FResTable[a] do - begin - ResourceName := GetResName(Name); - Address := FOffset; - Length := ResCompressedSize; - end; - - FOffset := FOffset+Cardinal(ResCompressedSize); - - Result := True; -end; - -function TWADEditor_1.AddAlias(Res, Alias: string): Boolean; -var - a, b: Integer; - ares: Char16; -begin - Result := False; - - if FResTable = nil then Exit; - - b := -1; - ares := GetResName(Alias); - for a := 0 to High(FResTable) do - if FResTable[a].ResourceName = Res then - begin - b := a; - Break; - end; - - if b = -1 then Exit; - - Inc(FHeader.RecordsCount); - - SetLength(FResTable, Length(FResTable)+1); - - with FResTable[High(FResTable)] do - begin - ResourceName := ares; - Address := FResTable[b].Address; - Length := FResTable[b].Length; - end; - - Result := True; -end; - -function TWADEditor_1.AddResource(FileName, Name, Section: string): Boolean; -var - ResCompressed: Pointer; - ResCompressedSize: Integer; - ResourceFile: File; - TempResource: Pointer; - OriginalSize: Integer; - a, b: Integer; -begin - Result := False; - - AssignFile(ResourceFile, findFileCIStr(FileName)); - - try - Reset(ResourceFile, 1); - except - FLastError := DFWAD_ERROR_CANTOPENWAD; - Exit; - end; - - OriginalSize := FileSize(ResourceFile); - GetMem(TempResource, OriginalSize); - - try - BlockRead(ResourceFile, TempResource^, OriginalSize); - except - FLastError := DFWAD_ERROR_READWAD; - FreeMemory(TempResource); - CloseFile(ResourceFile); - Exit; - end; - - CloseFile(ResourceFile); - - ResCompressed := nil; - ResCompressedSize := 0; - CompressBuf(TempResource, OriginalSize, ResCompressed, ResCompressedSize); - FreeMemory(TempResource); - if ResCompressed = nil then Exit; - - SetLength(FResTable, Length(FResTable)+1); - - if Section = '' then - begin - if Length(FResTable) > 1 then - for a := High(FResTable) downto 1 do - FResTable[a] := FResTable[a-1]; - - a := 0; - end - else - begin - Section := AnsiUpperCase(Section); - b := -1; - - for a := 0 to High(FResTable) do - if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then - begin - for b := High(FResTable) downto a+2 do - FResTable[b] := FResTable[b-1]; - - b := a+1; - Break; - end; - - if b = -1 then - begin - FreeMemory(ResCompressed); - SetLength(FResTable, Length(FResTable)-1); - Exit; - end; - - a := b; - end; - - if FResData = nil then FResData := AllocMem(ResCompressedSize) - else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize)); - - FDataSize := FDataSize+LongWord(ResCompressedSize); - CopyMemory(Pointer(PChar(FResData)+FDataSize-PChar(ResCompressedSize)), - ResCompressed, ResCompressedSize); - FreeMemory(ResCompressed); - - Inc(FHeader.RecordsCount); - - with FResTable[a] do - begin - ResourceName := GetResName(Name); - Address := FOffset; - Length := ResCompressedSize; - end; - - FOffset := FOffset+Cardinal(ResCompressedSize); - - Result := True; -end; - -procedure TWADEditor_1.AddSection(Name: string); -begin - if Name = '' then Exit; - - Inc(FHeader.RecordsCount); - - SetLength(FResTable, Length(FResTable)+1); - with FResTable[High(FResTable)] do - begin - ResourceName := GetResName(Name); - Address := $00000000; - Length := $00000000; - end; -end; - -constructor TWADEditor_1.Create(); -begin - FResData := nil; - FResTable := nil; - FDataSize := 0; - FOffset := 0; - FHeader.RecordsCount := 0; - FFileName := ''; - FWADOpened := DFWAD_OPENED_NONE; - FLastError := DFWAD_NOERROR; - FVersion := DFWAD_VERSION; -end; - -procedure TWADEditor_1.CreateImage(); -var - WADFile: File; - b: LongWord; -begin - if FWADOpened = DFWAD_OPENED_NONE then - begin - FLastError := DFWAD_ERROR_WADNOTLOADED; - Exit; - end; - - if FWADOpened = DFWAD_OPENED_MEMORY then Exit; - - if FResData <> nil then FreeMem(FResData); - - try - AssignFile(WADFile, findFileCIStr(FFileName)); - Reset(WADFile, 1); - - b := 6+SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable); - - FDataSize := LongWord(FileSize(WADFile))-b; - - GetMem(FResData, FDataSize); - - Seek(WADFile, b); - BlockRead(WADFile, FResData^, FDataSize); - - CloseFile(WADFile); - - FOffset := FDataSize; - except - FLastError := DFWAD_ERROR_CANTOPENWAD; - CloseFile(WADFile); - Exit; - end; - - FLastError := DFWAD_NOERROR; -end; - -destructor TWADEditor_1.Destroy(); -begin - FreeWAD(); - - inherited; -end; - -procedure TWADEditor_1.FreeWAD(); -begin - if FResData <> nil then FreeMem(FResData); - FResTable := nil; - FDataSize := 0; - FOffset := 0; - FHeader.RecordsCount := 0; - FFileName := ''; - FWADOpened := DFWAD_OPENED_NONE; - FLastError := DFWAD_NOERROR; - FVersion := DFWAD_VERSION; -end; - -function TWADEditor_1.GetResName(ResName: string): Char16; -begin - ZeroMemory(@Result[0], 16); - if ResName = '' then Exit; - - ResName := Trim(UpperCase(ResName)); - if Length(ResName) > 16 then SetLength(ResName, 16); - - CopyMemory(@Result[0], @ResName[1], Length(ResName)); -end; - -function TWADEditor_1.HaveResource(Section, Resource: string): Boolean; -var - a: Integer; - CurrentSection: string; -begin - Result := False; - - if FResTable = nil then Exit; - - CurrentSection := ''; - Section := AnsiUpperCase(Section); - Resource := AnsiUpperCase(Resource); - - for a := 0 to High(FResTable) do - begin - if FResTable[a].Length = 0 then - begin - CurrentSection := FResTable[a].ResourceName; - Continue; - end; - - if (FResTable[a].ResourceName = Resource) and - (CurrentSection = Section) then - begin - Result := True; - Break; - end; - end; -end; - -function TWADEditor_1.HaveSection(Section: string): Boolean; -var - a: Integer; -begin - Result := False; - - if FResTable = nil then Exit; - if Section = '' then - begin - Result := True; - Exit; - end; - - Section := AnsiUpperCase(Section); - - for a := 0 to High(FResTable) do - if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then - begin - Result := True; - Exit; - end; -end; - -function TWADEditor_1.GetResource(Section, Resource: string; - var pData: Pointer; var Len: Integer): Boolean; -var - a: LongWord; - i: Integer; - WADFile: File; - CurrentSection: string; - TempData: Pointer; - OutBytes: Integer; -begin - Result := False; + if FileName <> nil then + begin + FileName^ := Copy(ResourceStr, 1, i-1); + l1 := Length(FileName^); + end + else + l1 := 0; - CurrentSection := ''; - - if FWADOpened = DFWAD_OPENED_NONE then - begin - FLastError := DFWAD_ERROR_WADNOTLOADED; - Exit; - end; + for a := i+1 to Length(ResourceStr) do + if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break; - Section := toLowerCase1251(Section); - Resource := toLowerCase1251(Resource); - - i := -1; - for a := 0 to High(FResTable) do - begin - if FResTable[a].Length = 0 then - begin - CurrentSection := toLowerCase1251(FResTable[a].ResourceName); - Continue; + if ResourceName <> nil then + begin + ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a)); + l2 := Length(ResourceName^); + end + else + l2 := 0; + + if SectionName <> nil then + SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2); end; - if (toLowerCase1251(FResTable[a].ResourceName) = Resource) and - (CurrentSection = Section) then +{ TWADEditor } + + function TWADEditor.ReadFile(FileName: String): Boolean; + var fname: String; begin - i := a; - Break; + fname := findFileCIStr(FileName); + Result := ReadFile2(fname); end; - end; - if i = -1 then - begin - FLastError := DFWAD_ERROR_RESOURCENOTFOUND; - Exit; - end; - - if FWADOpened = DFWAD_OPENED_FILE then - begin - try - AssignFile(WADFile, findFileCIStr(FFileName)); - Reset(WADFile, 1); - - Seek(WADFile, FResTable[i].Address+6+ - LongWord(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))); - TempData := GetMemory(FResTable[i].Length); - BlockRead(WADFile, TempData^, FResTable[i].Length); - DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes); - FreeMem(TempData); - - Len := OutBytes; - - CloseFile(WADFile); - except - FLastError := DFWAD_ERROR_CANTOPENWAD; - CloseFile(WADFile); - Exit; - end; - end - else - begin - TempData := GetMemory(FResTable[i].Length); - CopyMemory(TempData, Pointer(PtrUInt(FResData)+FResTable[i].Address+6+ - PtrUInt(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))), - FResTable[i].Length); - DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes); - FreeMem(TempData); - - Len := OutBytes; - end; - - FLastError := DFWAD_NOERROR; - Result := True; -end; - -function TWADEditor_1.GetResourcesList(Section: string): SArray; -var - a: Integer; - CurrentSection: Char16; -begin - Result := nil; - - if FResTable = nil then Exit; - if Length(Section) > 16 then Exit; - - CurrentSection := ''; - - for a := 0 to High(FResTable) do - begin - if FResTable[a].Length = 0 then - begin - CurrentSection := FResTable[a].ResourceName; - Continue; - end; +{ TWADEditorMapping } - if CurrentSection = Section then + constructor TWADEditorMapping.CreateEx(const name: String; const eclass: TWADEditorClass); begin - SetLength(Result, Length(Result)+1); - Result[High(Result)] := FResTable[a].ResourceName; + Create; + FName := name; + FWADEditorClass := eclass; end; - end; -end; -function TWADEditor_1.GetSectionList(): SArray; -var - i: DWORD; -begin - Result := nil; +{ TWADEditorFactory } - if FResTable = nil then Exit; + constructor TWADEditorFactory.Create; + begin + FMappings := TStringList.Create(); + FDefault := nil; + end; - if FResTable[0].Length <> 0 then - begin - SetLength(Result, 1); - Result[0] := ''; - end; + destructor TWADEditorFactory.Destroy; + var i: Integer; + begin + for i := 0 to FMappings.Count - 1 do + FMappings.Objects[i].Free(); + FMappings.Free(); + FDefault := nil; + end; - for i := 0 to High(FResTable) do - if FResTable[i].Length = 0 then - begin - SetLength(Result, Length(Result)+1); - Result[High(Result)] := FResTable[i].ResourceName; - end; -end; - -function TWADEditor_1.LastErrorString(): string; -begin - case FLastError of - DFWAD_NOERROR: Result := ''; - DFWAD_ERROR_WADNOTFOUND: Result := 'DFWAD file not found'; - DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFWAD file'; - DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found'; - DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFWAD'; - DFWAD_ERROR_WADNOTLOADED: Result := 'DFWAD file is not loaded'; - DFWAD_ERROR_READRESOURCE: Result := 'Read resource error'; - DFWAD_ERROR_READWAD: Result := 'Read DFWAD error'; - end; -end; - -function TWADEditor_1.ReadFile(FileName: string): Boolean; -var - WADFile: File; - Signature: array[0..4] of Char; - a: Integer; -begin - FreeWAD(); - - Result := False; - - if not FileExists(FileName) then - begin - FLastError := DFWAD_ERROR_WADNOTFOUND; - Exit; - end; - - FFileName := FileName; - - AssignFile(WADFile, findFileCIStr(FFileName)); - - try - Reset(WADFile, 1); - except - FLastError := DFWAD_ERROR_CANTOPENWAD; - Exit; - end; - - try - BlockRead(WADFile, Signature, 5); - if Signature <> DFWAD_SIGNATURE then - begin - FLastError := DFWAD_ERROR_FILENOTWAD; - CloseFile(WADFile); - Exit; - end; + procedure TWADEditorFactory.RegisterEditor(const name: String; const eclass: TWADEditorClass); + begin + if FMappings.IndexOf(UpperCase(name)) <> -1 then + raise Exception.Create('Registering a duplicate WAD Editor name <' + name + '>'); + if FDefault = nil then + FDefault := eclass; + FMappings.AddObject(UpperCase(name), TWADEditorMapping.CreateEx(name, eclass)); + end; - BlockRead(WADFile, FVersion, 1); - if FVersion <> DFWAD_VERSION then + procedure TWADEditorFactory.SetDefaultEditor(const name: String); + var i: Integer; begin - FLastError := DFWAD_ERROR_WRONGVERSION; - CloseFile(WADFile); - Exit; + i := FMappings.IndexOf(UpperCase(name)); + if i = -1 then + raise Exception.Create('No WAD Editor was registred by the name <' + name + '>'); + FDefault := TWADEditorMapping(FMappings.Objects[i]).WADEditorClass; end; - BlockRead(WADFile, FHeader, SizeOf(TWADHeaderRec_1)); - SetLength(FResTable, FHeader.RecordsCount); - if FResTable <> nil then + function TWADEditorFactory.CreateEditor(const name: String): TWADEditor; + var i: Integer; begin - BlockRead(WADFile, FResTable[0], SizeOf(TResourceTableRec_1)*FHeader.RecordsCount); + if name = '' then + begin + Result := CreateDefaultEditor(); + end + else + begin + i := FMappings.IndexOf(UpperCase(name)); + if i = -1 then + raise Exception.Create('No WAD Editor was registred by the name <' + name + '>'); + Result := TWADEditorMapping(FMappings.Objects[i]).WADEditorClass.Create(); + end; + end; - for a := 0 to High(FResTable) do - if FResTable[a].Length <> 0 then - FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+ - SizeOf(TResourceTableRec_1)*Length(FResTable))); + function TWADEditorFactory.CreateDefaultEditor(): TWADEditor; + begin + if FDefault = nil then + raise Exception.Create('No default WAD Editor was registred'); + Result := FDefault.Create(); end; - CloseFile(WADFile); - except - FLastError := DFWAD_ERROR_READWAD; - CloseFile(WADFile); - Exit; - end; + function TWADEditorFactory.OpenFile(FileName: String): TWADEditor; + var i: Integer; tmp: TWADEditor; fname: String; + begin + Result := nil; + if FMappings <> nil then + begin + fname := findFileCIStr(FileName); + for i := 0 to FMappings.Count - 1 do + begin + tmp := gWADEditorFactory.CreateEditor(FMappings[i]); + if tmp.ReadFile2(fname) then + begin + Result := tmp; + break; + end; + FreeAndNil(tmp); + end; + end; + end; - FWADOpened := DFWAD_OPENED_FILE; - FLastError := DFWAD_NOERROR; - Result := True; -end; + function TWADEditorFactory.OpenMemory(Data: Pointer; Len: Integer): TWADEditor; + var i: Integer; tmp: TWADEditor; + begin + Result := nil; + if FMappings <> nil then + begin + for i := 0 to FMappings.Count - 1 do + begin + tmp := gWADEditorFactory.CreateEditor(FMappings[i]); + if tmp.ReadMemory(Data, Len) then + begin + Result := tmp; + break; + end; + FreeAndNil(tmp); + end; + end; + end; -function TWADEditor_1.ReadMemory(Data: Pointer; Len: LongWord): Boolean; -var - Signature: array[0..4] of Char; - a: Integer; -begin - FreeWAD(); + procedure TWADEditorFactory.GetRegistredEditors(var list: TStringList); + var i: Integer; + begin + list.Clear(); + for i := 0 to FMappings.Count - 1 do + list.Add(TWADEditorMapping(FMappings.Objects[i]).Name); + end; - Result := False; + function gWADEditorFactory: TWADEditorFactory; + begin + if not Assigned(uWADEditorFactory) then + uWADEditorFactory := TWADEditorFactory.Create(); + Result := uWADEditorFactory; + end; - CopyMemory(@Signature[0], Data, 5); - if Signature <> DFWAD_SIGNATURE then - begin - FLastError := DFWAD_ERROR_FILENOTWAD; - Exit; - end; +{ TWADEditor_1 } - CopyMemory(@FVersion, Pointer(PtrUInt(Data)+5), 1); - if FVersion <> DFWAD_VERSION then - begin - FLastError := DFWAD_ERROR_WRONGVERSION; - Exit; - end; + constructor TWADEditor_1.Create(); + begin + FBase := gWADEditorFactory.CreateDefaultEditor(); + end; - CopyMemory(@FHeader, Pointer(PtrUInt(Data)+6), SizeOf(TWADHeaderRec_1)); + destructor TWADEditor_1.Destroy(); + begin + if FBase <> nil then + FBase.Free(); + inherited; + end; - SetLength(FResTable, FHeader.RecordsCount); - if FResTable <> nil then - begin - CopyMemory(@FResTable[0], Pointer(PtrUInt(Data)+6+SizeOf(TWADHeaderRec_1)), - SizeOf(TResourceTableRec_1)*FHeader.RecordsCount); + procedure TWADEditor_1.CreateImage(); + begin + FBase.CreateImage(); + end; - for a := 0 to High(FResTable) do - if FResTable[a].Length <> 0 then - FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+ - SizeOf(TResourceTableRec_1)*Length(FResTable))); - end; + procedure TWADEditor_1.FreeWAD(); + begin + FBase.FreeWAD(); + end; - GetMem(FResData, Len); - CopyMemory(FResData, Data, Len); + function TWADEditor_1.ReadFile(FileName: String): Boolean; + var tmp: TWADEditor; + begin + Result := FBase.ReadFile(FileName); + if Result = False then + begin + tmp := gWADEditorFactory.OpenFile(FileName); + if tmp <> nil then + begin + FreeAndNil(FBase); + FBase := tmp; + Result := True; + end; + end; + end; - FWADOpened := DFWAD_OPENED_MEMORY; - FLastError := DFWAD_NOERROR; + function TWADEditor_1.ReadMemory(Data: Pointer; Len: LongWord): Boolean; + var tmp: TWADEditor; + begin + Result := FBase.ReadMemory(Data, Len); + if Result = False then + begin + tmp := gWADEditorFactory.OpenMemory(Data, Len); + if tmp <> nil then + begin + FreeAndNil(FBase); + FBase := tmp; + Result := True; + end; + end; + end; - Result := True; -end; + procedure TWADEditor_1.SaveTo(FileName: string); + var fname: AnsiString; + begin + fname := findFileCIStr(FileName); + FBase.SaveTo(fname); + end; -procedure TWADEditor_1.RemoveResource(Section, Resource: string); -var - a, i: Integer; - CurrentSection: Char16; - b, c, d: LongWord; -begin - if FResTable = nil then Exit; + function TWADEditor_1.AddAlias(Res, Alias: string): Boolean; + begin + Result := FBase.AddAlias(Res, Alias); + end; - e_WriteLog('Fuck me (B) ' + Section + ' ' + Resource, MSG_NOTIFY); + function TWADEditor_1.AddResource(Data: Pointer; Len: LongWord; Name: string; Section: string): Boolean; + begin + Result := FBase.AddResource(Data, Len, Name, Section); + end; - i := -1; - b := 0; - c := 0; - CurrentSection := ''; + function TWADEditor_1.AddResource(FileName, Name, Section: string): Boolean; + var fname: AnsiString; + begin + fname := findFileCIStr(FileName); + Result := FBase.AddResource(fname, Name, Section); + end; - for a := 0 to High(FResTable) do - begin - if FResTable[a].Length = 0 then + procedure TWADEditor_1.AddSection(Name: string); begin - CurrentSection := FResTable[a].ResourceName; - Continue; + FBase.AddSection(Name); end; - if (FResTable[a].ResourceName = Resource) and - (CurrentSection = Section) then + function TWADEditor_1.GetSectionList(): SArray; begin - i := a; - b := FResTable[a].Length; - c := FResTable[a].Address; - Break; + Result := FBase.GetSectionList(); end; - end; - if i = -1 then Exit; + function TWADEditor_1.HaveSection(Section: string): Boolean; + begin + Result := FBase.HaveSection(Section); + end; - e_WriteLog('Fuck me (C) ' + Section + ' ' + Resource, MSG_NOTIFY); - - for a := i to High(FResTable)-1 do - FResTable[a] := FResTable[a+1]; + function TWADEditor_1.GetResourcesList(Section: string): SArray; + begin + Result := FBase.GetResourcesList(Section); + end; - SetLength(FResTable, Length(FResTable)-1); - - d := 0; - for a := 0 to High(FResTable) do - if (FResTable[a].Length <> 0) and (FResTable[a].Address > c) then - begin - FResTable[a].Address := FResTable[a].Address-b; - d := d+FResTable[a].Length; + function TWADEditor_1.HaveResource(Section, Resource: string): Boolean; + begin + Result := FBase.HaveResource(Section, Resource); end; - CopyMemory(Pointer(PtrUInt(FResData)+c), Pointer(PtrUInt(FResData)+c+b), d); - - FDataSize := FDataSize-b; - FOffset := FOffset-b; - ReallocMem(FResData, FDataSize); + function TWADEditor_1.GetResource(Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; + begin + Result := FBase.GetResource(Section, Resource, pData, Len); + end; - FHeader.RecordsCount := FHeader.RecordsCount-1; -end; + procedure TWADEditor_1.RemoveResource(Section, Resource: string); + begin + FBase.RemoveResource(Section, Resource); + end; -procedure TWADEditor_1.SaveTo(FileName: string); -var - WADFile: File; - sign: string; - ver: Byte; - Header: TWADHeaderRec_1; - i: Integer; -begin - sign := DFWAD_SIGNATURE; - ver := DFWAD_VERSION; + function TWADEditor_1.GetLastError: Integer; + begin + Result := FBase.GetLastError(); + end; - Header.RecordsCount := Length(FResTable); + function TWADEditor_1.GetLastErrorStr: String; + begin + Result := FBase.GetLastErrorStr(); + end; - if FResTable <> nil then - for i := 0 to High(FResTable) do - if FResTable[i].Length <> 0 then - FResTable[i].Address := FResTable[i].Address+6+SizeOf(TWADHeaderRec_1)+ - SizeOf(TResourceTableRec_1)*Header.RecordsCount; + function TWADEditor_1.GetResourcesCount: Word; + begin + Result := FBase.GetResourcesCount(); + end; - AssignFile(WADFile, FileName); - Rewrite(WADFile, 1); - BlockWrite(WADFile, sign[1], 5); - BlockWrite(WADFile, ver, 1); - BlockWrite(WADFile, Header, SizeOf(TWADHeaderRec_1)); - if FResTable <> nil then BlockWrite(WADFile, FResTable[0], - SizeOf(TResourceTableRec_1)*Header.RecordsCount); - if FResData <> nil then BlockWrite(WADFile, FResData^, FDataSize); - CloseFile(WADFile); -end; + function TWADEditor_1.GetVersion: Byte; + begin + Result := FBase.GetVersion; + end; +finalization + FreeAndNil(uWADEditorFactory); end. diff --git a/src/shared/WADEDITOR_dfwad.pas b/src/shared/WADEDITOR_dfwad.pas new file mode 100644 index 0000000..a13b35b --- /dev/null +++ b/src/shared/WADEDITOR_dfwad.pas @@ -0,0 +1,886 @@ +unit WADEDITOR_dfwad; + +{ +----------------------------------- +WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08 + +Ïîääåðæêà âàäîâ âåðñèè 1 +----------------------------------- +} + +interface + +uses WADEDITOR, WADSTRUCT; + +type + TWADEditor_1 = class sealed(WADEDITOR.TWADEditor) + private + FResData: Pointer; + FResTable: packed array of TResourceTableRec_1; + FHeader: TWADHeaderRec_1; + FDataSize: LongWord; + FOffset: LongWord; + FFileName: string; + FWADOpened: Byte; + FLastError: Integer; + FVersion: Byte; + function LastErrorString(): string; + function GetResName(ResName: string): Char16; + public + constructor Create(); + destructor Destroy(); override; + procedure FreeWAD(); override; + function ReadFile2(FileName: string): Boolean; override; + function ReadMemory(Data: Pointer; Len: LongWord): Boolean; override; + procedure CreateImage(); override; + function AddResource(Data: Pointer; Len: LongWord; Name: string; + Section: string): Boolean; override; overload; + function AddResource(FileName, Name, Section: string): Boolean; override; overload; + function AddAlias(Res, Alias: string): Boolean; override; + procedure AddSection(Name: string); override; + procedure RemoveResource(Section, Resource: string); override; + procedure SaveTo(FileName: string); override; + function HaveResource(Section, Resource: string): Boolean; override; + function HaveSection(Section: string): Boolean; override; + function GetResource(Section, Resource: string; var pData: Pointer; + var Len: Integer): Boolean; override; + function GetSectionList(): SArray; override; + function GetResourcesList(Section: string): SArray; override; + + function GetLastError: Integer; override; + function GetLastErrorStr: String; override; + function GetResourcesCount: Word; override; + function GetVersion: Byte; override; + + // property GetLastError: Integer read FLastError; + // property GetLastErrorStr: string read LastErrorString; + // property GetResourcesCount: Word read FHeader.RecordsCount; + // property GetVersion: Byte read FVersion; + end; + +const + DFWAD_NOERROR = 0; + DFWAD_ERROR_WADNOTFOUND = -1; + DFWAD_ERROR_CANTOPENWAD = -2; + DFWAD_ERROR_RESOURCENOTFOUND = -3; + DFWAD_ERROR_FILENOTWAD = -4; + DFWAD_ERROR_WADNOTLOADED = -5; + DFWAD_ERROR_READRESOURCE = -6; + DFWAD_ERROR_READWAD = -7; + DFWAD_ERROR_WRONGVERSION = -8; + +implementation + +uses + SysUtils, BinEditor, ZLib, utils, e_log; + +const + DFWAD_OPENED_NONE = 0; + DFWAD_OPENED_FILE = 1; + DFWAD_OPENED_MEMORY = 2; + +procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; + OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer); +var + strm: TZStreamRec; + P: Pointer; + BufInc: Integer; +begin + FillChar(strm, sizeof(strm), 0); + BufInc := (InBytes + 255) and not 255; + if OutEstimate = 0 then + OutBytes := BufInc + else + OutBytes := OutEstimate; + GetMem(OutBuf, OutBytes); + try + strm.next_in := InBuf; + strm.avail_in := InBytes; + strm.next_out := OutBuf; + strm.avail_out := OutBytes; + inflateInit_(strm, zlib_version, sizeof(strm)); + try + while inflate(strm, Z_FINISH) <> Z_STREAM_END do + begin + P := OutBuf; + Inc(OutBytes, BufInc); + ReallocMem(OutBuf, OutBytes); + strm.next_out := PByteF(PChar(OutBuf) + (PChar(strm.next_out) - PChar(P))); + strm.avail_out := BufInc; + end; + finally + inflateEnd(strm); + end; + ReallocMem(OutBuf, strm.total_out); + OutBytes := strm.total_out; + except + FreeMem(OutBuf); + raise + end; +end; + +procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; + out OutBuf: Pointer; out OutBytes: Integer); +var + strm: TZStreamRec; + P: Pointer; +begin + FillChar(strm, sizeof(strm), 0); + OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; + GetMem(OutBuf, OutBytes); + try + strm.next_in := InBuf; + strm.avail_in := InBytes; + strm.next_out := OutBuf; + strm.avail_out := OutBytes; + deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)); + try + while deflate(strm, Z_FINISH) <> Z_STREAM_END do + begin + P := OutBuf; + Inc(OutBytes, 256); + ReallocMem(OutBuf, OutBytes); + strm.next_out := PByteF(PtrUInt(OutBuf + (strm.next_out - P))); + strm.avail_out := 256; + end; + finally + deflateEnd(strm); + end; + ReallocMem(OutBuf, strm.total_out); + OutBytes := strm.total_out; + except + FreeMem(OutBuf); + raise + end; +end; + +{ TWADEditor_1 } + +function TWADEditor_1.AddResource(Data: Pointer; Len: LongWord; Name: string; + Section: string): Boolean; +var + ResCompressed: Pointer; + ResCompressedSize: Integer; + a, b: Integer; +begin + Result := False; + + SetLength(FResTable, Length(FResTable)+1); + + if Section = '' then + begin + if Length(FResTable) > 1 then + for a := High(FResTable) downto 1 do + FResTable[a] := FResTable[a-1]; + + a := 0; + end + else + begin + Section := AnsiUpperCase(Section); + b := -1; + + for a := 0 to High(FResTable) do + if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then + begin + for b := High(FResTable) downto a+2 do + FResTable[b] := FResTable[b-1]; + + b := a+1; + Break; + end; + + if b = -1 then + begin + SetLength(FResTable, Length(FResTable)-1); + Exit; + end; + a := b; + end; + + ResCompressed := nil; + ResCompressedSize := 0; + CompressBuf(Data, Len, ResCompressed, ResCompressedSize); + if ResCompressed = nil then Exit; + e_WriteLog('Fuck me (D)', MSG_NOTIFY); + + if FResData = nil then FResData := AllocMem(ResCompressedSize) + else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize)); + + FDataSize := FDataSize+LongWord(ResCompressedSize); + + CopyMemory(Pointer(PChar(FResData)+FDataSize-PChar(ResCompressedSize)), + ResCompressed, ResCompressedSize); + FreeMemory(ResCompressed); + + Inc(FHeader.RecordsCount); + + with FResTable[a] do + begin + ResourceName := GetResName(Name); + Address := FOffset; + Length := ResCompressedSize; + end; + + FOffset := FOffset+Cardinal(ResCompressedSize); + + Result := True; +end; + +function TWADEditor_1.AddAlias(Res, Alias: string): Boolean; +var + a, b: Integer; + ares: Char16; +begin + Result := False; + + if FResTable = nil then Exit; + + b := -1; + ares := GetResName(Alias); + for a := 0 to High(FResTable) do + if FResTable[a].ResourceName = Res then + begin + b := a; + Break; + end; + + if b = -1 then Exit; + + Inc(FHeader.RecordsCount); + + SetLength(FResTable, Length(FResTable)+1); + + with FResTable[High(FResTable)] do + begin + ResourceName := ares; + Address := FResTable[b].Address; + Length := FResTable[b].Length; + end; + + Result := True; +end; + +function TWADEditor_1.AddResource(FileName, Name, Section: string): Boolean; +var + ResCompressed: Pointer; + ResCompressedSize: Integer; + ResourceFile: File; + TempResource: Pointer; + OriginalSize: Integer; + a, b: Integer; +begin + Result := False; + + AssignFile(ResourceFile, FileName); + + try + Reset(ResourceFile, 1); + except + FLastError := DFWAD_ERROR_CANTOPENWAD; + Exit; + end; + + OriginalSize := FileSize(ResourceFile); + GetMem(TempResource, OriginalSize); + + try + BlockRead(ResourceFile, TempResource^, OriginalSize); + except + FLastError := DFWAD_ERROR_READWAD; + FreeMemory(TempResource); + CloseFile(ResourceFile); + Exit; + end; + + CloseFile(ResourceFile); + + ResCompressed := nil; + ResCompressedSize := 0; + CompressBuf(TempResource, OriginalSize, ResCompressed, ResCompressedSize); + FreeMemory(TempResource); + if ResCompressed = nil then Exit; + + SetLength(FResTable, Length(FResTable)+1); + + if Section = '' then + begin + if Length(FResTable) > 1 then + for a := High(FResTable) downto 1 do + FResTable[a] := FResTable[a-1]; + + a := 0; + end + else + begin + Section := AnsiUpperCase(Section); + b := -1; + + for a := 0 to High(FResTable) do + if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then + begin + for b := High(FResTable) downto a+2 do + FResTable[b] := FResTable[b-1]; + + b := a+1; + Break; + end; + + if b = -1 then + begin + FreeMemory(ResCompressed); + SetLength(FResTable, Length(FResTable)-1); + Exit; + end; + + a := b; + end; + + if FResData = nil then FResData := AllocMem(ResCompressedSize) + else ReallocMem(FResData, FDataSize+Cardinal(ResCompressedSize)); + + FDataSize := FDataSize+LongWord(ResCompressedSize); + CopyMemory(Pointer(PChar(FResData)+FDataSize-PChar(ResCompressedSize)), + ResCompressed, ResCompressedSize); + FreeMemory(ResCompressed); + + Inc(FHeader.RecordsCount); + + with FResTable[a] do + begin + ResourceName := GetResName(Name); + Address := FOffset; + Length := ResCompressedSize; + end; + + FOffset := FOffset+Cardinal(ResCompressedSize); + + Result := True; +end; + +procedure TWADEditor_1.AddSection(Name: string); +begin + if Name = '' then Exit; + + Inc(FHeader.RecordsCount); + + SetLength(FResTable, Length(FResTable)+1); + with FResTable[High(FResTable)] do + begin + ResourceName := GetResName(Name); + Address := $00000000; + Length := $00000000; + end; +end; + +constructor TWADEditor_1.Create(); +begin + FResData := nil; + FResTable := nil; + FDataSize := 0; + FOffset := 0; + FHeader.RecordsCount := 0; + FFileName := ''; + FWADOpened := DFWAD_OPENED_NONE; + FLastError := DFWAD_NOERROR; + FVersion := DFWAD_VERSION; +end; + +procedure TWADEditor_1.CreateImage(); +var + WADFile: File; + b: LongWord; +begin + if FWADOpened = DFWAD_OPENED_NONE then + begin + FLastError := DFWAD_ERROR_WADNOTLOADED; + Exit; + end; + + if FWADOpened = DFWAD_OPENED_MEMORY then Exit; + + if FResData <> nil then FreeMem(FResData); + + try + AssignFile(WADFile, FFileName); + Reset(WADFile, 1); + + b := 6+SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable); + + FDataSize := LongWord(FileSize(WADFile))-b; + + GetMem(FResData, FDataSize); + + Seek(WADFile, b); + BlockRead(WADFile, FResData^, FDataSize); + + CloseFile(WADFile); + + FOffset := FDataSize; + except + FLastError := DFWAD_ERROR_CANTOPENWAD; + CloseFile(WADFile); + Exit; + end; + + FLastError := DFWAD_NOERROR; +end; + +destructor TWADEditor_1.Destroy(); +begin + FreeWAD(); + + inherited; +end; + +procedure TWADEditor_1.FreeWAD(); +begin + if FResData <> nil then FreeMem(FResData); + FResTable := nil; + FDataSize := 0; + FOffset := 0; + FHeader.RecordsCount := 0; + FFileName := ''; + FWADOpened := DFWAD_OPENED_NONE; + FLastError := DFWAD_NOERROR; + FVersion := DFWAD_VERSION; +end; + +function TWADEditor_1.GetResName(ResName: string): Char16; +begin + ZeroMemory(@Result[0], 16); + if ResName = '' then Exit; + + ResName := Trim(UpperCase(ResName)); + if Length(ResName) > 16 then SetLength(ResName, 16); + + CopyMemory(@Result[0], @ResName[1], Length(ResName)); +end; + +function TWADEditor_1.HaveResource(Section, Resource: string): Boolean; +var + a: Integer; + CurrentSection: string; +begin + Result := False; + + if FResTable = nil then Exit; + + CurrentSection := ''; + Section := AnsiUpperCase(Section); + Resource := AnsiUpperCase(Resource); + + for a := 0 to High(FResTable) do + begin + if FResTable[a].Length = 0 then + begin + CurrentSection := FResTable[a].ResourceName; + Continue; + end; + + if (FResTable[a].ResourceName = Resource) and + (CurrentSection = Section) then + begin + Result := True; + Break; + end; + end; +end; + +function TWADEditor_1.HaveSection(Section: string): Boolean; +var + a: Integer; +begin + Result := False; + + if FResTable = nil then Exit; + if Section = '' then + begin + Result := True; + Exit; + end; + + Section := AnsiUpperCase(Section); + + for a := 0 to High(FResTable) do + if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then + begin + Result := True; + Exit; + end; +end; + +function TWADEditor_1.GetResource(Section, Resource: string; + var pData: Pointer; var Len: Integer): Boolean; +var + a: LongWord; + i: Integer; + WADFile: File; + CurrentSection: string; + TempData: Pointer; + OutBytes: Integer; +begin + Result := False; + + CurrentSection := ''; + + if FWADOpened = DFWAD_OPENED_NONE then + begin + FLastError := DFWAD_ERROR_WADNOTLOADED; + Exit; + end; + + Section := toLowerCase1251(Section); + Resource := toLowerCase1251(Resource); + + i := -1; + for a := 0 to High(FResTable) do + begin + if FResTable[a].Length = 0 then + begin + CurrentSection := toLowerCase1251(FResTable[a].ResourceName); + Continue; + end; + + if (toLowerCase1251(FResTable[a].ResourceName) = Resource) and + (CurrentSection = Section) then + begin + i := a; + Break; + end; + end; + + if i = -1 then + begin + FLastError := DFWAD_ERROR_RESOURCENOTFOUND; + Exit; + end; + + if FWADOpened = DFWAD_OPENED_FILE then + begin + try + AssignFile(WADFile, FFileName); + Reset(WADFile, 1); + + Seek(WADFile, FResTable[i].Address+6+ + LongWord(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))); + TempData := GetMemory(FResTable[i].Length); + BlockRead(WADFile, TempData^, FResTable[i].Length); + DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes); + FreeMem(TempData); + + Len := OutBytes; + + CloseFile(WADFile); + except + FLastError := DFWAD_ERROR_CANTOPENWAD; + CloseFile(WADFile); + Exit; + end; + end + else + begin + TempData := GetMemory(FResTable[i].Length); + CopyMemory(TempData, Pointer(PtrUInt(FResData)+FResTable[i].Address+6+ + PtrUInt(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))), + FResTable[i].Length); + DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes); + FreeMem(TempData); + + Len := OutBytes; + end; + + FLastError := DFWAD_NOERROR; + Result := True; +end; + +function TWADEditor_1.GetResourcesList(Section: string): SArray; +var + a: Integer; + CurrentSection: Char16; +begin + Result := nil; + + if FResTable = nil then Exit; + if Length(Section) > 16 then Exit; + + CurrentSection := ''; + + for a := 0 to High(FResTable) do + begin + if FResTable[a].Length = 0 then + begin + CurrentSection := FResTable[a].ResourceName; + Continue; + end; + + if CurrentSection = Section then + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)] := FResTable[a].ResourceName; + end; + end; +end; + +function TWADEditor_1.GetSectionList(): SArray; +var + i: DWORD; +begin + Result := nil; + + if FResTable = nil then Exit; + + if FResTable[0].Length <> 0 then + begin + SetLength(Result, 1); + Result[0] := ''; + end; + + for i := 0 to High(FResTable) do + if FResTable[i].Length = 0 then + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)] := FResTable[i].ResourceName; + end; +end; + +function TWADEditor_1.LastErrorString(): string; +begin + case FLastError of + DFWAD_NOERROR: Result := ''; + DFWAD_ERROR_WADNOTFOUND: Result := 'DFWAD file not found'; + DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFWAD file'; + DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found'; + DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFWAD'; + DFWAD_ERROR_WADNOTLOADED: Result := 'DFWAD file is not loaded'; + DFWAD_ERROR_READRESOURCE: Result := 'Read resource error'; + DFWAD_ERROR_READWAD: Result := 'Read DFWAD error'; + end; +end; + +function TWADEditor_1.ReadFile2(FileName: string): Boolean; +var + WADFile: File; + Signature: array[0..4] of Char; + a: Integer; +begin + FreeWAD(); + + Result := False; + + if not FileExists(FileName) then + begin + FLastError := DFWAD_ERROR_WADNOTFOUND; + Exit; + end; + + FFileName := FileName; + + AssignFile(WADFile, FFileName); + + try + Reset(WADFile, 1); + except + FLastError := DFWAD_ERROR_CANTOPENWAD; + Exit; + end; + + try + BlockRead(WADFile, Signature, 5); + if Signature <> DFWAD_SIGNATURE then + begin + FLastError := DFWAD_ERROR_FILENOTWAD; + CloseFile(WADFile); + Exit; + end; + + BlockRead(WADFile, FVersion, 1); + if FVersion <> DFWAD_VERSION then + begin + FLastError := DFWAD_ERROR_WRONGVERSION; + CloseFile(WADFile); + Exit; + end; + + BlockRead(WADFile, FHeader, SizeOf(TWADHeaderRec_1)); + SetLength(FResTable, FHeader.RecordsCount); + if FResTable <> nil then + begin + BlockRead(WADFile, FResTable[0], SizeOf(TResourceTableRec_1)*FHeader.RecordsCount); + + for a := 0 to High(FResTable) do + if FResTable[a].Length <> 0 then + FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+ + SizeOf(TResourceTableRec_1)*Length(FResTable))); + end; + + CloseFile(WADFile); + except + FLastError := DFWAD_ERROR_READWAD; + CloseFile(WADFile); + Exit; + end; + + FWADOpened := DFWAD_OPENED_FILE; + FLastError := DFWAD_NOERROR; + Result := True; +end; + +function TWADEditor_1.ReadMemory(Data: Pointer; Len: LongWord): Boolean; +var + Signature: array[0..4] of Char; + a: Integer; +begin + FreeWAD(); + + Result := False; + + CopyMemory(@Signature[0], Data, 5); + if Signature <> DFWAD_SIGNATURE then + begin + FLastError := DFWAD_ERROR_FILENOTWAD; + Exit; + end; + + CopyMemory(@FVersion, Pointer(PtrUInt(Data)+5), 1); + if FVersion <> DFWAD_VERSION then + begin + FLastError := DFWAD_ERROR_WRONGVERSION; + Exit; + end; + + CopyMemory(@FHeader, Pointer(PtrUInt(Data)+6), SizeOf(TWADHeaderRec_1)); + + SetLength(FResTable, FHeader.RecordsCount); + if FResTable <> nil then + begin + CopyMemory(@FResTable[0], Pointer(PtrUInt(Data)+6+SizeOf(TWADHeaderRec_1)), + SizeOf(TResourceTableRec_1)*FHeader.RecordsCount); + + for a := 0 to High(FResTable) do + if FResTable[a].Length <> 0 then + FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+ + SizeOf(TResourceTableRec_1)*Length(FResTable))); + end; + + GetMem(FResData, Len); + CopyMemory(FResData, Data, Len); + + FWADOpened := DFWAD_OPENED_MEMORY; + FLastError := DFWAD_NOERROR; + + Result := True; +end; + +procedure TWADEditor_1.RemoveResource(Section, Resource: string); +var + a, i: Integer; + CurrentSection: Char16; + b, c, d: LongWord; +begin + if FResTable = nil then Exit; + + e_WriteLog('Fuck me (B) ' + Section + ' ' + Resource, MSG_NOTIFY); + + i := -1; + b := 0; + c := 0; + CurrentSection := ''; + + for a := 0 to High(FResTable) do + begin + if FResTable[a].Length = 0 then + begin + CurrentSection := FResTable[a].ResourceName; + Continue; + end; + + if (FResTable[a].ResourceName = Resource) and + (CurrentSection = Section) then + begin + i := a; + b := FResTable[a].Length; + c := FResTable[a].Address; + Break; + end; + end; + + if i = -1 then Exit; + + e_WriteLog('Fuck me (C) ' + Section + ' ' + Resource, MSG_NOTIFY); + + for a := i to High(FResTable)-1 do + FResTable[a] := FResTable[a+1]; + + SetLength(FResTable, Length(FResTable)-1); + + d := 0; + for a := 0 to High(FResTable) do + if (FResTable[a].Length <> 0) and (FResTable[a].Address > c) then + begin + FResTable[a].Address := FResTable[a].Address-b; + d := d+FResTable[a].Length; + end; + + CopyMemory(Pointer(PtrUInt(FResData)+c), Pointer(PtrUInt(FResData)+c+b), d); + + FDataSize := FDataSize-b; + FOffset := FOffset-b; + ReallocMem(FResData, FDataSize); + + FHeader.RecordsCount := FHeader.RecordsCount-1; +end; + +procedure TWADEditor_1.SaveTo(FileName: string); +var + WADFile: File; + sign: string; + ver: Byte; + Header: TWADHeaderRec_1; + i: Integer; +begin + sign := DFWAD_SIGNATURE; + ver := DFWAD_VERSION; + + Header.RecordsCount := Length(FResTable); + + if FResTable <> nil then + for i := 0 to High(FResTable) do + if FResTable[i].Length <> 0 then + FResTable[i].Address := FResTable[i].Address+6+SizeOf(TWADHeaderRec_1)+ + SizeOf(TResourceTableRec_1)*Header.RecordsCount; + + AssignFile(WADFile, FileName); + Rewrite(WADFile, 1); + BlockWrite(WADFile, sign[1], 5); + BlockWrite(WADFile, ver, 1); + BlockWrite(WADFile, Header, SizeOf(TWADHeaderRec_1)); + if FResTable <> nil then BlockWrite(WADFile, FResTable[0], + SizeOf(TResourceTableRec_1)*Header.RecordsCount); + if FResData <> nil then BlockWrite(WADFile, FResData^, FDataSize); + CloseFile(WADFile); +end; + +function TWADEditor_1.GetLastError: Integer; +begin + Result := FLastError; +end; + +function TWADEditor_1.GetLastErrorStr: String; +begin + Result := LastErrorString(); +end; + +function TWADEditor_1.GetResourcesCount: Word; +begin + Result := FHeader.RecordsCount; +end; + +function TWADEditor_1.GetVersion: Byte; +begin + Result := FVersion; +end; + +begin + gWADEditorFactory.RegisterEditor('DFWAD', TWADEditor_1); +end. diff --git a/src/shared/WADEDITOR_dfzip.pas b/src/shared/WADEDITOR_dfzip.pas new file mode 100644 index 0000000..f7abf9e --- /dev/null +++ b/src/shared/WADEDITOR_dfzip.pas @@ -0,0 +1,1043 @@ +{$INCLUDE ../shared/a_modes.inc} + +unit WADEDITOR_dfzip; + +// Implementation restrictions: +// - File must start with LFH or EOCD signature +// - EOCD must be located strictly at the end of file +// - Multi-disk ZIP files are not supported +// - UTF-8 not supported yet, expected WIN1251 encoding +// - ZIP64 not supported +// - Encryption not supported +// - Zero-length file names not supported +// - CDR holds most actual data about file, LFH mostly ignored +// - Attributes, comments and extra data are ignored and not saved +// - Store and Deflate compression supported + +interface + + uses Classes, WADEDITOR; + + type + TResource = record + name: AnsiString; + pos: UInt32; + csize: UInt32; + usize: UInt32; + comp: UInt32; + chksum: UInt32; + stream: TMemoryStream; + end; + + TSection = record + name: AnsiString; + list: array of TResource; + end; + + PResource = ^TResource; + PSection = ^TSection; + + TZIPEditor = class sealed(WADEDITOR.TWADEditor) + private + FSection: array of TSection; + FStream: TStream; + FLastError: Integer; + FVersion: Byte; + + function FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer; + function FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection; + function InsertSectionRAW(name: AnsiString): PSection; + + function FindSectionID(name: AnsiString): Integer; + function FindSection(name: AnsiString): PSection; + function InsertSection(name: AnsiString): PSection; + + function InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc: UInt32): PResource; + function Preload(p: PResource): Boolean; + function GetSourceStream(p: PResource): TStream; + + function ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc: UInt32): Boolean; + function ReadCDR(s: TStream): Boolean; + function FindEOCD(s: TStream): Boolean; + function ReadEOCD(s: TStream): Boolean; + + procedure WriteLFH(s: TStream; comp, crc, csize, usize: UInt32; const afname: AnsiString); + procedure WriteCDR(s: TStream; comp, crc, csize, usize, attr, offset: UInt32; const afname: AnsiString); + procedure SaveToStream(s: TStream); + + public + constructor Create(); + destructor Destroy(); override; + procedure FreeWAD(); override; + function ReadFile2(FileName: string): Boolean; override; + function ReadMemory(Data: Pointer; Len: LongWord): Boolean; override; + procedure CreateImage(); override; + function AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean; override; overload; + function AddResource(FileName, Name, Section: String): Boolean; override; overload; + function AddAlias(Res, Alias: String): Boolean; override; + procedure AddSection(Name: String); override; + procedure RemoveResource(Section, Resource: String); override; + procedure SaveTo(FileName: String); override; + function HaveResource(Section, Resource: String): Boolean; override; + function HaveSection(Section: string): Boolean; override; + function GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean; override; + function GetSectionList(): SArray; override; + function GetResourcesList(Section: String): SArray; override; + + function GetLastError: Integer; override; + function GetLastErrorStr: String; override; + function GetResourcesCount: Word; override; + function GetVersion: Byte; override; + end; + +implementation + + uses SysUtils, StrUtils, zstream, crc, e_log; + + const + ZIP_SIGN_CDR = 'PK'#1#2; + ZIP_SIGN_LFH = 'PK'#3#4; + ZIP_SIGN_EOCD = 'PK'#5#6; + + const + ZIP_COMP_STORE = 0; + ZIP_COMP_DEFLATE = 8; + + const + ZIP_SYSTEM = 0; // DOS / FAT + ZIP_VERSION = 20; // Min version + ZIP_MAXVERSION = 63; // Max supported version + + procedure ToSectionFile(fname: AnsiString; out section, name: AnsiString); inline; + var i: SizeInt; + begin + i := LastDelimiter('/', fname); + section := Copy(fname, 1, i - 1); + name := Copy(fname, i + 1) + end; + + function GetFileName(const Section, Name: AnsiString): AnsiString; inline; + begin + if Section = '' then + Result := Name + else + Result := Section + '/' + Name; + end; + + function PrepString(const s: AnsiString; caseSensitive, extSensitive: Boolean): AnsiString; inline; + var i: Integer; + begin + Result := s; + if caseSensitive = False then + begin + Result := UpperCase(Result); + end; + if extSensitive = False then + begin + i := Pos('.', Result); // fix dotfiles + if i > 1 then + SetLength(Result, i - 1); + end; + end; + + function FindResourceIDRAW(p: PSection; name: AnsiString; caseSensitive, extSensitive: Boolean): Integer; + var i: Integer; pname: AnsiString; + begin + if p <> nil then + begin + pname := PrepString(name, caseSensitive, extSensitive); + for i := 0 to High(p.list) do + begin + if PrepString(p.list[i].name, caseSensitive, extSensitive) = pname then + begin + Result := i; + exit; + end; + end; + end; + Result := -1; + end; + + function FindResourceID(p: PSection; name: AnsiString): Integer; + var i: Integer; + begin + i := FindResourceIDRAW(p, name, True, True); // CaSeNaMe.Ext + if i < 0 then + begin + i := FindResourceIDRAW(p, name, False, True); // CASENAME.EXT + if i < 0 then + begin + i := FindResourceIDRAW(p, name, True, False); // CaSeNaMe + if i < 0 then + begin + i := FindResourceIDRAW(p, name, False, False); // CASENAME + end; + end; + end; + Result := i; + end; + + function FindResource(p: PSection; name: AnsiString): PResource; + var i: Integer; + begin + i := FindResourceID(p, name); + if i >= 0 then + Result := @p.list[i] + else + Result := nil; + end; + + + + function TZIPEditor.FindSectionIDRAW(name: AnsiString; caseSensitive: Boolean): Integer; + var i: Integer; pname: AnsiString; + begin + if FSection <> nil then + begin + pname := PrepString(name, caseSensitive, True); + for i := 0 to High(FSection) do + begin + if PrepString(FSection[i].name, caseSensitive, True) = pname then + begin + Result := i; + exit; + end; + end; + end; + Result := -1; + end; + + function TZIPEditor.FindSectionRAW(name: AnsiString; caseSensitive: Boolean): PSection; + var i: Integer; + begin + i := FindSectionIDRAW(name, caseSensitive); + if i >= 0 then + Result := @FSection[i] + else + Result := nil; + end; + + function TZIPEditor.InsertSectionRAW(name: AnsiString): PSection; + var i: Integer; + begin + if FSection = nil then i := 0 else i := Length(FSection); + SetLength(FSection, i + 1); + FSection[i] := Default(TSection); + FSection[i].name := name; + Result := @FSection[i]; + end; + + + + function TZIPEditor.FindSectionID(name: AnsiString): Integer; + var fixName: AnsiString; + begin + fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall); + Result := FindSectionIDRAW(fixName, True); // CaSeNaMe + if Result < 0 then + Result := FindSectionIDRAW(fixName, False); // CASENAME + end; + + function TZIPEditor.FindSection(name: AnsiString): PSection; + var fixName: AnsiString; + begin + fixName := StringReplace(name, '\', '/', [rfReplaceAll], TStringReplaceAlgorithm.sraManySmall); + Result := FindSectionRAW(fixName, True); // CaSeNaMe + if Result = nil then + Result := FindSectionRAW(fixName, False); // CASENAME + end; + + function TZIPEditor.InsertSection(name: AnsiString): PSection; + begin + Result := FindSection(name); + if Result = nil then + Result := InsertSectionRAW(name); + end; + + + + function TZIPEditor.InsertFileInfo(const section, name: AnsiString; pos, csize, usize, comp, crc: UInt32): PResource; + var p: PSection; i: Integer; + begin + p := FindSectionRAW(section, True); + if p = nil then + p := InsertSectionRAW(section); + if p.list = nil then i := 0 else i := Length(p.list); + SetLength(p.list, i + 1); + p.list[i] := Default(TResource); + p.list[i].name := name; + p.list[i].pos := pos; + p.list[i].csize := csize; + p.list[i].usize := usize; + p.list[i].comp := comp; + p.list[i].chksum := crc; + p.list[i].stream := nil; + Result := @p.list[i]; + end; + + + + function TZIPEditor.AddAlias(Res, Alias: String): Boolean; + begin + // Hard-links not supported in ZIP + // However, they never created by editor + Result := False; + end; + + function TZIPEditor.AddResource(Data: Pointer; Len: LongWord; Name, Section: String): Boolean; + const compress: Boolean = True; + const level: TCompressionLevel = TCompressionLevel.clMax; + var s: TMemoryStream; cs: TCompressionStream; p: PResource; + var comp, crc: UInt32; + begin + Result := False; + if Name <> '' then + begin + s := TMemoryStream.Create(); + try + if compress and (Len > 0) then + begin + cs := TCompressionStream.Create(level, s, True); + try + cs.WriteBuffer(PByte(Data)[0], Len); + cs.Flush(); + comp := ZIP_COMP_DEFLATE; + finally + cs.Free(); + end; + end; + if (Len = 0) or (compress = False) or (s.Size >= Len) then + begin + s.Seek(0, TSeekOrigin.soBeginning); + s.SetSize(Len); + s.WriteBuffer(PByte(Data)[0], Len); + comp := ZIP_COMP_STORE; + Assert(s.Size = Len); + end; + crc := crc32(0, nil, 0); + crc := crc32(crc, data, len); + p := InsertFileInfo(Section, Name, $ffffffff, s.Size, Len, comp, crc); + p.stream := s; + Result := True; + except + s.Free(); + raise; + end; + end; + end; + + function TZIPEditor.AddResource(FileName, Name, Section: String): Boolean; + var s: TFileStream; ptr: PByte; + begin + Result := False; + FLastError := DFWAD_ERROR_READWAD; + try + s := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite); + try + GetMem(ptr, s.Size); + try + s.ReadBuffer(ptr[0], s.Size); + Result := AddResource(ptr, s.Size, Name, Section); + if Result = True then FLastError := DFWAD_NOERROR; + finally + FreeMem(ptr); + end; + finally + s.Free(); + end; + except on e: EFOpenError do + FLastError := DFWAD_ERROR_CANTOPENWAD; + end; + end; + + constructor TZIPEditor.Create(); + begin + FSection := nil; + FStream := nil; + FLastError := DFWAD_NOERROR; + FVersion := ZIP_VERSION; + FreeWAD(); + end; + + destructor TZIPEditor.Destroy(); + begin + FreeWAD(); + inherited; + end; + + procedure TZIPEditor.FreeWAD(); + var i, j: Integer; + begin + if FSection <> nil then + begin + for i := 0 to High(FSection) do + begin + if FSection[i].list <> nil then + begin + for j := 0 to High(FSection[i].list) do + begin + if FSection[i].list[j].stream <> nil then + begin + FreeAndNil(FSection[i].list[j].stream); + end; + end; + SetLength(FSection[i].list, 0); + end; + end; + SetLength(FSection, 0); + end; + if FStream <> nil then + begin + FreeAndNil(FStream); + end; + FLastError := DFWAD_NOERROR; + FVersion := ZIP_VERSION; + end; + + function TZIPEditor.Preload(p: PResource): Boolean; + var s: TMemoryStream; + begin + Result := False; + if p <> nil then + begin + Result := p.stream <> nil; + if (p.stream = nil) and (FStream <> nil) then + begin + s := TMemoryStream.Create(); + try + if p.csize > 0 then + begin + FStream.Seek(p.pos, TSeekOrigin.soBeginning); + s.CopyFrom(FStream, p.csize); + end; + Assert(s.Size = p.csize); // wtf, random size if copied zero bytes! + p.stream := s; + Result := True; + except + s.Free(); + raise; + end; + end; + end; + end; + + procedure TZIPEditor.CreateImage(); + var i, j: Integer; + begin + if FStream = nil then + begin + FLastError := DFWAD_ERROR_WADNOTLOADED; + end + else if FStream is TMemoryStream then + begin + FLastError := DFWAD_NOERROR; + end + else + begin + if FSection <> nil then + begin + for i := 0 to High(FSection) do + begin + if FSection[i].list <> nil then + begin + for j := 0 to High(FSection[i].list) do + begin + if Preload(@FSection[i].list[j]) = False then + begin + FLastError := DFWAD_ERROR_CANTOPENWAD; + exit; + end; + end; + end; + end; + end; + FreeAndNil(FStream); + FLastError := DFWAD_NOERROR; + end; + end; + + procedure TZIPEditor.AddSection(Name: String); + begin + if InsertSection(Name) = nil then + raise Exception.Create('ZIP: AddSection: failed to add section'); + end; + + function TZIPEditor.HaveResource(Section, Resource: String): Boolean; + begin + Result := FindResource(FindSection(Section), Resource) <> nil; + end; + + function TZIPEditor.HaveSection(Section: String): Boolean; + begin + Result := FindSection(Section) <> nil; + end; + + function TZIPEditor.GetSourceStream(p: PResource): TStream; + var src: TStream; + begin + src := nil; + if p.stream <> nil then + begin + src := p.stream; + src.Seek(0, TSeekOrigin.soBeginning); + end + else if FStream <> nil then + begin + src := FStream; + src.Seek(p.pos, TSeekOrigin.soBeginning); + end; + Result := src; + end; + + function TZIPEditor.GetResource(Section, Resource: String; var pData: Pointer; var Len: Integer): Boolean; + var p: PResource; ptr: PByte; src: TStream; tmp: TDecompressionStream; crc: UInt32; + begin + FLastError := DFWAD_ERROR_CANTOPENWAD; + Result := False; + pData := nil; + Len := 0; + p := FindResource(FindSection(Section), Resource); + if p <> nil then + begin + src := GetSourceStream(p); + if src <> nil then + begin + case p.comp of + ZIP_COMP_STORE: + if p.csize = p.usize then + begin + GetMem(ptr, p.usize); + try + src.ReadBuffer(ptr[0], p.usize); + Result := True; + except + FreeMem(ptr); + end; + end; + ZIP_COMP_DEFLATE: + begin + tmp := TDecompressionStream.Create(src, True); + try + GetMem(ptr, p.usize); + try + tmp.ReadBuffer(ptr[0], p.usize); + Result := True; + except + FreeMem(ptr); + end; + finally + tmp.Free(); + end; + end; + end; + end + else + begin + FLastError := DFWAD_ERROR_WADNOTLOADED; + end; + if Result = True then + begin + crc := crc32(0, nil, 0); + crc := crc32(crc, ptr, p.usize); + Result := crc = p.chksum; + if Result = True then + begin + pData := ptr; + Len := p.usize; + FLastError := DFWAD_NOERROR; + end + else + begin + FreeMem(ptr); + end; + end; + end + else + begin + FLastError := DFWAD_ERROR_RESOURCENOTFOUND; + end; + end; + + function TZIPEditor.GetResourcesList(Section: String): SArray; + var p: PSection; i: Integer; + begin + Result := nil; + p := FindSection(Section); + if (p <> nil) and (p.list <> nil) then + begin + SetLength(Result, Length(p.list)); + for i := 0 to High(p.list) do + begin + Result[i] := p.list[i].name; + end; + end; + end; + + function TZIPEditor.GetSectionList(): SArray; + var i: Integer; + begin + Result := nil; + if FSection <> nil then + begin + SetLength(Result, Length(FSection)); + for i := 0 to High(FSection) do + begin + Result[i] := FSection[i].name; + end; + end; + end; + + function TZIPEditor.ReadLFH(s: TStream; fname: AnsiString; xcsize, xusize, xcomp, xcrc: UInt32): Boolean; + var sig: packed array [0..3] of Char; + var v, flags, comp: UInt16; + var mtime, crc, csize, usize: UInt32; + var fnlen, extlen: UInt16; + var datapos: UInt64; + var section, name: AnsiString; + begin + Result := False; + if s.Position + 30 <= s.Size then + begin + s.ReadBuffer(sig[0], 4); + if sig = ZIP_SIGN_LFH then + begin + v := LEtoN(s.ReadWord()); + flags := LEtoN(s.ReadWord()); + comp := LEtoN(s.ReadWord()); + mtime := LEtoN(s.ReadDWord()); + crc := LEtoN(s.ReadDWord()); + csize := LEtoN(s.ReadDWord()); + usize := LEtoN(s.ReadDWord()); + fnlen := LEtoN(s.ReadWord()); + extlen := LEtoN(s.ReadWord()); + datapos := s.Position + fnlen + extlen; + if datapos + xcsize <= s.Size then + begin + // Valid Record Size + ToSectionFile(fname, section, name); + if name = '' then + Result := InsertSection(section) <> nil + else + Result := InsertFileInfo(section, name, datapos, xcsize, xusize, xcomp, xcrc) <> nil; + end; + end; + end; + end; + + function TZIPEditor.ReadCDR(s: TStream): Boolean; + var sig: packed array [0..3] of Char; + var v, va, vb, flags, comp: UInt16; + var mtime, crc, csize, usize: UInt32; + var fnlen, extlen, comlen, disk, iattr: UInt16; + var eattr, offset: UInt32; + var next: UInt64; + var name: PChar; + begin + Result := False; + s.ReadBuffer(sig[0], 4); + if sig = ZIP_SIGN_CDR then + begin + // Valid Central Directory Signature + v := LEtoN(s.ReadWord()); + va := s.ReadByte(); // Min Version + vb := s.ReadByte(); // Min System + flags := LEtoN(s.ReadWord()); + comp := LEtoN(s.ReadWord()); + mtime := LEtoN(s.ReadDWord()); + crc := LEtoN(s.ReadDWord()); + csize := LEtoN(s.ReadDWord()); + usize := LEtoN(s.ReadDWord()); + fnlen := LEtoN(s.ReadWord()); + extlen := LEtoN(s.ReadWord()); + comlen := LEtoN(s.ReadWord()); + disk := LEtoN(s.ReadWord()); + iattr := LEtoN(s.ReadWord()); + eattr := LEtoN(s.ReadDWord()); + offset := LEtoN(s.ReadDWord()); + next := s.Position + fnlen + extlen + comlen; + FVersion := va; + if va <= ZIP_MAXVERSION then + begin + if (flags and ((1 << 0) or (1 << 6) or (1 << 13))) = 0 then + begin + // TODO: check bit 11 (UTF8 name and comment) + if (csize <> $ffffffff) and (usize <> $ffffffff) and (disk <> $ffff) and (offset <> $ffffffff) then + begin + // Old Style ZIP + if disk = 0 then + begin + // Single Volume ZIP + if (next <= s.Size) and (fnlen > 0) then + begin + // Valid Central Directory Entry + GetMem(name, UInt32(fnlen) + 1); + try + s.ReadBuffer(name[0], fnlen); + name[fnlen] := #0; + s.Seek(offset, TSeekOrigin.soBeginning); + Result := ReadLFH(s, name, csize, usize, comp, crc); + finally + s.Seek(next, TSeekOrigin.soBeginning); + FreeMem(name); + end; + end; + end; + end + else + begin + // ZIP64 + FLastError := DFWAD_ERROR_WRONGVERSION; + end; + end + else + begin + // Encrypted file + FLastError := DFWAD_ERROR_READWAD; + end; + end + else + begin + // Unsupported version + FLastError := DFWAD_ERROR_WRONGVERSION; + end; + end; + end; + + function TZIPEditor.FindEOCD(s: TStream): Boolean; + const maxedir = 20; // end of central directory entry + const maxecdir = maxedir + 65536; // + comment + var sig: packed array [0..3] of Char; off, lim: Int64; + begin + Result := False; + if s.Size >= maxedir then + begin + if s.Size < maxecdir then lim := s.Size else lim := maxecdir; + lim := lim - maxedir; + off := maxedir; + while (off <= lim) and (Result = False) do + begin + s.Seek(s.Size - off, TSeekOrigin.soBeginning); + s.ReadBuffer(sig[0], 4); + Result := sig = ZIP_SIGN_EOCD; + Inc(off); + end; + end; + end; + + function TZIPEditor.ReadEOCD(s: TStream): Boolean; + var sig: packed array [0..3] of Char; + var idisk, ndisk, nrec, total, comlen: UInt16; + var csize, cpos, i: UInt32; + begin + Result := False; + FLastError := DFWAD_ERROR_FILENOTWAD; + FVersion := 0; + s.ReadBuffer(sig[0], 4); + if (sig = ZIP_SIGN_LFH) or (sig = ZIP_SIGN_EOCD) then + begin + if FindEOCD(s) then + begin + // End of Central Directory found + FLastError := DFWAD_ERROR_READWAD; + idisk := LEtoN(s.ReadWord()); + ndisk := LEtoN(s.ReadWord()); + nrec := LEtoN(s.ReadWord()); + total := LEtoN(s.ReadWord()); + csize := LEtoN(s.ReadDWord()); + cpos := LEtoN(s.ReadDWord()); + comlen := LEtoN(s.ReadWord()); + if (idisk <> $ffff) and (ndisk <> $ffff) and (nrec <> $ffff) and (total <> $ffff) and (csize <> $ffffffff) and (cpos <> $ffffffff) then + begin + // Old Style ZIP + if s.Position + comlen = s.Size then + begin + // Valid End of Central Directory size (located exactly at the end of file) + if (idisk = 0) and (ndisk = 0) and (nrec = total) then + begin + // Single volume ZIP + if (UInt64(cpos) + csize <= s.Size) then + begin + // Valid Cental Directry Record position and size + Result := True; + if total > 0 then + begin + // At least one Central Directry present + i := 0; + s.Seek(cpos, TSeekOrigin.soBeginning); + while (i < nrec) and (Result = True) do + begin + Result := ReadCDR(s); + Inc(i); + end; + // if Result = False then + // writeln('Invalid Central Directory #', i - 1); + end; + end; + end; + end; + end + else + begin + // ZIP64 + FLastError := DFWAD_ERROR_WRONGVERSION; + end; + end; + end; + end; + + function TZIPEditor.ReadFile2(FileName: String): Boolean; + var s: TFileStream; + begin + FreeWAD(); + Result := False; + try + s := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite); + try + Result := ReadEOCD(s); + if Result = True then + begin + FStream := s; + FLastError := DFWAD_NOERROR; + end + else + begin + FStream := nil; + s.Free(); + end; + except + s.Free(); + end; + except on e: EFOpenError do + if FileExists(FileName) then + FLastError := DFWAD_ERROR_CANTOPENWAD + else + FLastError := DFWAD_ERROR_WADNOTFOUND; + end; + end; + + function TZIPEditor.ReadMemory(Data: Pointer; Len: LongWord): Boolean; + var s: TMemoryStream; + begin + FreeWAD(); + Result := False; + s := TMemoryStream.Create; + try + s.SetSize(Len); + s.WriteBuffer(PByte(Data)[0], Len); + s.Seek(0, soBeginning); + Result := ReadEOCD(s); + if Result = True then + begin + FStream := s; + FLastError := DFWAD_NOERROR; + end + else + begin + FStream := nil; + s.Free(); + end; + except + s.Free(); + raise; + end; + end; + + procedure TZIPEditor.RemoveResource(Section, Resource: String); + var p: PSection; i: Integer; + begin + p := FindSection(Section); + i := FindResourceID(p, Resource); + if i >= 0 then + begin + if p.list[i].stream <> nil then + FreeAndNil(p.list[i].stream); + for i := i + 1 to High(p.list) do + begin + p.list[i - 1] := p.list[i]; + end; + SetLength(p.list, High(p.list)); + end; + end; + + procedure TZIPEditor.WriteLFH(s: TStream; comp, crc, csize, usize: UInt32; const afname: AnsiString); + var fname: PChar; flen: UInt16; + begin + fname := PChar(afname); + flen := Length(fname); + s.WriteBuffer(ZIP_SIGN_LFH, 4); // LFH Signature + s.WriteByte(ZIP_VERSION); // Min version + s.WriteByte(ZIP_SYSTEM); // System + s.WriteWord(NtoLE(0)); // Flags + s.WriteWord(NtoLE(comp)); // Compression method + s.WriteDWord(NtoLE(0)); // Modification time/date + s.WriteDWord(NtoLE(crc)); // CRC-32 + s.WriteDWord(NtoLE(csize)); // Compressed size + s.WriteDWord(NtoLE(usize)); // Decompressed size + s.WriteWord(NtoLE(flen)); // Name field length + s.WriteWord(NtoLE(0)); // Extra field length + s.WriteBuffer(fname[0], flen); // File Name + end; + + procedure TZIPEditor.WriteCDR(s: TStream; comp, crc, csize, usize, attr, offset: UInt32; const afname: AnsiString); + var fname: PChar; flen: UInt16; + begin + fname := PChar(afname); + flen := Length(fname); + s.WriteBuffer(ZIP_SIGN_CDR, 4); // CDR Signature + s.WriteByte(ZIP_MAXVERSION); // Used version + s.WriteByte(ZIP_SYSTEM); // Used system + s.WriteByte(ZIP_VERSION); // Min version + s.WriteByte(ZIP_SYSTEM); // Min system + s.WriteWord(NtoLE(0)); // Flags + s.WriteWord(NtoLE(comp)); // Compression method + s.WriteDWord(NtoLE(0)); // Modification time/date + s.WriteDWord(NtoLE(crc)); // CRC-32 + s.WriteDWord(NtoLE(csize)); // Compressed size + s.WriteDWord(NtoLE(usize)); // Decompressed size + s.WriteWord(NtoLE(flen)); // Name field length + s.WriteWord(NtoLE(0)); // Extra field length + s.WriteWord(NtoLE(0)); // Comment field length + s.WriteWord(NtoLE(0)); // Disk + s.WriteWord(NtoLE(0)); // Internal attributes + s.WriteDWord(NtoLE(attr)); // External attributes + s.WriteDWord(NtoLE(offset)); // LFH offset + s.WriteBuffer(fname[0], flen); // File Name + end; + + procedure TZIPEditor.SaveToStream(s: TStream); + var i, j: Integer; + var start, offset, loffset, size, zcrc, count: UInt32; + var p: PResource; + var afname: AnsiString; + begin + // Write LFH headers and data + start := s.Position; + zcrc := crc32(0, nil, 0); + if FSection <> nil then + begin + for i := 0 to High(FSection) do + begin + if FSection[i].list <> nil then + begin + for j := 0 to High(FSection[i].list) do + begin + p := @FSection[i].list[j]; + afname := GetFileName(FSection[i].name, p.name); + WriteLFH(s, p.comp, p.chksum, p.csize, p.usize, afname); + if p.stream <> nil then + begin + Assert(p.stream.Size = p.csize); + p.stream.SaveToStream(s); + end + else if FStream <> nil then + begin + FStream.Seek(p.pos, TSeekOrigin.soBeginning); + s.CopyFrom(FStream, p.csize); + end + else + begin + raise Exception.Create('ZIP: SaveToStream: No data source available'); + end; + end; + end + else + begin + afname := GetFileName(FSection[i].name, ''); + WriteLFH(s, ZIP_COMP_STORE, zcrc, 0, 0, afname); + end; + end; + end; + // Write CDR headers + count := 0; + loffset := start; + offset := s.Position - start; + if FSection <> nil then + begin + for i := 0 to High(FSection) do + begin + if FSection[i].list <> nil then + begin + for j := 0 to High(FSection[i].list) do + begin + p := @FSection[i].list[j]; + afname := GetFileName(FSection[i].name, p.name); + WriteCDR(s, p.comp, p.chksum, p.csize, p.usize, 0, loffset - start, afname); + loffset := loffset + 30 + Length(afname) + p.csize; + Inc(count); + end; + end + else + begin + afname := GetFileName(FSection[i].name, ''); + WriteCDR(s, ZIP_COMP_STORE, zcrc, 0, 0, $10, loffset - start, afname); + loffset := loffset + 30 + Length(afname) + 0; + Inc(count); + end; + end; + end; + Assert(loffset = offset); + Assert(count < $ffff); + size := s.Position - start - offset; + // Write EOCD header + s.WriteBuffer(ZIP_SIGN_EOCD, 4); // EOCD Signature + s.WriteWord(NtoLE(0)); // Disk + s.WriteWord(NtoLE(0)); // Num of Disks + s.WriteWord(NtoLE(count)); // Num of CDRs + s.WriteWord(NtoLE(count)); // Total CDR entries + s.WriteDWord(NtoLE(size)); // Central Directory size + s.WriteDWord(NtoLE(offset)); // Central Directory offset + s.WriteWord(NtoLE(0)); // Comment field length + end; + + procedure TZIPEditor.SaveTo(FileName: String); + var s: TFileStream; + begin + s := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(s); + finally + s.Free(); + end; + end; + + function TZIPEditor.GetLastError: Integer; + begin + Result := FLastError; + end; + + function TZIPEditor.GetLastErrorStr: String; + begin + case FLastError of + DFWAD_NOERROR: Result := ''; + DFWAD_ERROR_WADNOTFOUND: Result := 'DFZIP file not found'; + DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFZIP file'; + DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found'; + DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFZIP'; + DFWAD_ERROR_WADNOTLOADED: Result := 'DFZIP file is not loaded'; + DFWAD_ERROR_READRESOURCE: Result := 'Read resource error'; + DFWAD_ERROR_READWAD: Result := 'Read DFZIP error'; + otherwise Result := ''; + end; + end; + + function TZIPEditor.GetResourcesCount: Word; + var i: Integer; + begin + Result := 0; + if FSection <> nil then + begin + Result := Result + Length(FSection); + for i := 0 to High(FSection) do + if FSection[i].list <> nil then + Result := Result + Length(FSection[i].list); + end; + end; + + function TZIPEditor.GetVersion: Byte; + begin + Result := FVersion; + end; + +begin + gWADEditorFactory.RegisterEditor('DFZIP', TZIPEditor); +end.