1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
20 -----------------------------------
21 WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08
23 Ïîääåðæêà âàäîâ âåðñèè 1
24 -----------------------------------
28 -----------------------------------
29 WADSTRUCT.PAS ÂÅÐÑÈß ÎÒ 24.09.06
31 Ïîääåðæêà âàäîâ âåðñèè 1
32 -----------------------------------
34 Ñòðóêòóðà DFWAD-ôàéëà âåðñèè 1:
35 ------------------------------------------
36 SIGNATURE | Byte[5] | 'DFWAD'
38 HEADER | TWADHeaderRec_1 |
39 RESRECORD1 | TResourceTableRec_1 |
40 ... | ................... |
41 RESRECORDN | TResourceTableRec_1 |
43 ------------------------------------------
49 SArray
= array of ShortString;
50 Char16
= packed array[0..15] of Char;
52 TWADHeaderRec_1
= packed record
56 TResourceTableRec_1
= packed record
62 TWADEditor_1
= class(TObject
)
65 FResTable
: packed array of TResourceTableRec_1
;
66 FHeader
: TWADHeaderRec_1
;
73 function LastErrorString(): string;
74 function GetResName(ResName
: string): Char16
;
77 destructor Destroy(); override;
79 function ReadFile(FileName
: string): Boolean;
80 function ReadMemory(Data
: Pointer; Len
: LongWord): Boolean;
81 procedure CreateImage();
82 function AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
83 Section
: string): Boolean; overload
;
84 function AddResource(FileName
, Name
, Section
: string): Boolean; overload
;
85 function AddAlias(Res
, Alias
: string): Boolean;
86 procedure AddSection(Name
: string);
87 procedure RemoveResource(Section
, Resource
: string);
88 procedure SaveTo(FileName
: string);
89 function HaveResource(Section
, Resource
: string): Boolean;
90 function HaveSection(Section
: string): Boolean;
91 function GetResource(Section
, Resource
: string; var pData
: Pointer;
92 var Len
: Integer): Boolean;
93 function GetSectionList(): SArray
;
94 function GetResourcesList(Section
: string): SArray
;
96 property GetLastError
: Integer read FLastError
;
97 property GetLastErrorStr
: string read LastErrorString
;
98 property GetResourcesCount
: Word read FHeader
.RecordsCount
;
99 property GetVersion
: Byte read FVersion
;
103 DFWAD_SIGNATURE
= 'DFWAD';
108 DFWAD_ERROR_WADNOTFOUND
= -1;
109 DFWAD_ERROR_CANTOPENWAD
= -2;
110 DFWAD_ERROR_RESOURCENOTFOUND
= -3;
111 DFWAD_ERROR_FILENOTWAD
= -4;
112 DFWAD_ERROR_WADNOTLOADED
= -5;
113 DFWAD_ERROR_READRESOURCE
= -6;
114 DFWAD_ERROR_READWAD
= -7;
115 DFWAD_ERROR_WRONGVERSION
= -8;
118 procedure g_ProcessResourceStr(ResourceStr
: String; var FileName
,
119 SectionName
, ResourceName
: String); overload
;
120 procedure g_ProcessResourceStr(ResourceStr
: String; FileName
,
121 SectionName
, ResourceName
: PString); overload
;
126 SysUtils
, BinEditor
, ZLib
;
129 DFWAD_OPENED_NONE
= 0;
130 DFWAD_OPENED_FILE
= 1;
131 DFWAD_OPENED_MEMORY
= 2;
133 procedure DecompressBuf(const InBuf
: Pointer; InBytes
: Integer;
134 OutEstimate
: Integer; out OutBuf
: Pointer; out OutBytes
: Integer);
140 FillChar(strm
, sizeof(strm
), 0);
141 BufInc
:= (InBytes
+ 255) and not 255;
142 if OutEstimate
= 0 then
145 OutBytes
:= OutEstimate
;
146 GetMem(OutBuf
, OutBytes
);
148 strm
.next_in
:= InBuf
;
149 strm
.avail_in
:= InBytes
;
150 strm
.next_out
:= OutBuf
;
151 strm
.avail_out
:= OutBytes
;
152 inflateInit_(strm
, zlib_version
, sizeof(strm
));
154 while inflate(strm
, Z_FINISH
) <> Z_STREAM_END
do
157 Inc(OutBytes
, BufInc
);
158 ReallocMem(OutBuf
, OutBytes
);
159 strm
.next_out
:= PByteF(PChar(OutBuf
) + (PChar(strm
.next_out
) - PChar(P
)));
160 strm
.avail_out
:= BufInc
;
165 ReallocMem(OutBuf
, strm
.total_out
);
166 OutBytes
:= strm
.total_out
;
173 procedure g_ProcessResourceStr(ResourceStr
: String; var FileName
,
174 SectionName
, ResourceName
: String);
179 for i
:= Length(ResourceStr
) downto 1 do
180 if ResourceStr
[i
] = ':' then
183 FileName
:= Copy(ResourceStr
, 1, i
-1);
185 for a
:= i
+1 to Length(ResourceStr
) do
186 if (ResourceStr
[a
] = '\') or (ResourceStr
[a
] = '/') then Break
;
188 ResourceName
:= Copy(ResourceStr
, a
+1, Length(ResourceStr
)-Abs(a
));
189 SectionName
:= Copy(ResourceStr
, i
+1, Length(ResourceStr
)-Length(ResourceName
)-Length(FileName
)-2);
192 procedure g_ProcessResourceStr(ResourceStr
: AnsiString; FileName
,
193 SectionName
, ResourceName
: PAnsiString);
195 a
, i
, l1
, l2
: Integer;
198 for i
:= Length(ResourceStr
) downto 1 do
199 if ResourceStr
[i
] = ':' then
202 if FileName
<> nil then
204 FileName
^ := Copy(ResourceStr
, 1, i
-1);
205 l1
:= Length(FileName
^);
210 for a
:= i
+1 to Length(ResourceStr
) do
211 if (ResourceStr
[a
] = '\') or (ResourceStr
[a
] = '/') then Break
;
213 if ResourceName
<> nil then
215 ResourceName
^ := Copy(ResourceStr
, a
+1, Length(ResourceStr
)-Abs(a
));
216 l2
:= Length(ResourceName
^);
221 if SectionName
<> nil then
222 SectionName
^ := Copy(ResourceStr
, i
+1, Length(ResourceStr
)-l2
-l1
-2);
227 function TWADEditor_1
.AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
228 Section
: string): Boolean;
230 ResCompressed
: Pointer;
231 ResCompressedSize
: Integer;
236 SetLength(FResTable
, Length(FResTable
)+1);
240 if Length(FResTable
) > 1 then
241 for a
:= High(FResTable
) downto 1 do
242 FResTable
[a
] := FResTable
[a
-1];
248 Section
:= AnsiUpperCase(Section
);
251 for a
:= 0 to High(FResTable
) do
252 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
254 for b
:= High(FResTable
) downto a
+2 do
255 FResTable
[b
] := FResTable
[b
-1];
263 SetLength(FResTable
, Length(FResTable
)-1);
269 ResCompressed
:= nil;
270 ResCompressedSize
:= 0;
271 Compress(Data
, @Len
, ResCompressed
, ResCompressedSize
);
272 if ResCompressed
= nil then Exit
;
274 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
275 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
277 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
279 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
280 ResCompressed
, ResCompressedSize
);
281 FreeMemory(ResCompressed
);
283 Inc(FHeader
.RecordsCount
);
287 ResourceName
:= GetResName(Name
);
289 Length
:= ResCompressedSize
;
292 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
297 function TWADEditor_1
.AddAlias(Res
, Alias
: string): Boolean;
304 if FResTable
= nil then Exit
;
307 ares
:= GetResName(Alias
);
308 for a
:= 0 to High(FResTable
) do
309 if FResTable
[a
].ResourceName
= Res
then
317 Inc(FHeader
.RecordsCount
);
319 SetLength(FResTable
, Length(FResTable
)+1);
321 with FResTable
[High(FResTable
)] do
323 ResourceName
:= ares
;
324 Address
:= FResTable
[b
].Address
;
325 Length
:= FResTable
[b
].Length
;
331 function TWADEditor_1
.AddResource(FileName
, Name
, Section
: string): Boolean;
333 ResCompressed
: Pointer;
334 ResCompressedSize
: Integer;
336 TempResource
: Pointer;
337 OriginalSize
: Integer;
342 AssignFile(ResourceFile
, FileName
);
345 Reset(ResourceFile
, 1);
347 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
351 OriginalSize
:= FileSize(ResourceFile
);
352 GetMem(TempResource
, OriginalSize
);
355 BlockRead(ResourceFile
, TempResource
^, OriginalSize
);
357 FLastError
:= DFWAD_ERROR_READWAD
;
358 FreeMemory(TempResource
);
359 CloseFile(ResourceFile
);
363 CloseFile(ResourceFile
);
365 ResCompressed
:= nil;
366 ResCompressedSize
:= 0;
367 Compress(TempResource
, @OriginalSize
, ResCompressed
, ResCompressedSize
);
368 FreeMemory(TempResource
);
369 if ResCompressed
= nil then Exit
;
371 SetLength(FResTable
, Length(FResTable
)+1);
375 if Length(FResTable
) > 1 then
376 for a
:= High(FResTable
) downto 1 do
377 FResTable
[a
] := FResTable
[a
-1];
383 Section
:= AnsiUpperCase(Section
);
386 for a
:= 0 to High(FResTable
) do
387 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
389 for b
:= High(FResTable
) downto a
+2 do
390 FResTable
[b
] := FResTable
[b
-1];
398 FreeMemory(ResCompressed
);
399 SetLength(FResTable
, Length(FResTable
)-1);
406 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
407 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
409 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
410 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
411 ResCompressed
, ResCompressedSize
);
412 FreeMemory(ResCompressed
);
414 Inc(FHeader
.RecordsCount
);
418 ResourceName
:= GetResName(Name
);
420 Length
:= ResCompressedSize
;
423 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
428 procedure TWADEditor_1
.AddSection(Name
: string);
430 if Name
= '' then Exit
;
432 Inc(FHeader
.RecordsCount
);
434 SetLength(FResTable
, Length(FResTable
)+1);
435 with FResTable
[High(FResTable
)] do
437 ResourceName
:= GetResName(Name
);
438 Address
:= $00000000;
443 constructor TWADEditor_1
.Create();
449 FHeader
.RecordsCount
:= 0;
451 FWADOpened
:= DFWAD_OPENED_NONE
;
452 FLastError
:= DFWAD_NOERROR
;
453 FVersion
:= DFWAD_VERSION
;
456 procedure TWADEditor_1
.CreateImage();
461 if FWADOpened
= DFWAD_OPENED_NONE
then
463 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
467 if FWADOpened
= DFWAD_OPENED_MEMORY
then Exit
;
469 if FResData
<> nil then FreeMem(FResData
);
472 AssignFile(WADFile
, FFileName
);
475 b
:= 6+SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
);
477 FDataSize
:= LongWord(FileSize(WADFile
))-b
;
479 GetMem(FResData
, FDataSize
);
482 BlockRead(WADFile
, FResData
^, FDataSize
);
486 FOffset
:= FDataSize
;
488 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
493 FLastError
:= DFWAD_NOERROR
;
496 destructor TWADEditor_1
.Destroy();
503 procedure TWADEditor_1
.FreeWAD();
505 if FResData
<> nil then FreeMem(FResData
);
509 FHeader
.RecordsCount
:= 0;
511 FWADOpened
:= DFWAD_OPENED_NONE
;
512 FLastError
:= DFWAD_NOERROR
;
513 FVersion
:= DFWAD_VERSION
;
516 function TWADEditor_1
.GetResName(ResName
: string): Char16
;
518 ZeroMemory(@Result
[0], 16);
519 if ResName
= '' then Exit
;
521 ResName
:= Trim(UpperCase(ResName
));
522 if Length(ResName
) > 16 then SetLength(ResName
, 16);
524 CopyMemory(@Result
[0], @ResName
[1], Length(ResName
));
527 function TWADEditor_1
.HaveResource(Section
, Resource
: string): Boolean;
530 CurrentSection
: string;
534 if FResTable
= nil then Exit
;
536 CurrentSection
:= '';
537 Section
:= AnsiUpperCase(Section
);
538 Resource
:= AnsiUpperCase(Resource
);
540 for a
:= 0 to High(FResTable
) do
542 if FResTable
[a
].Length
= 0 then
544 CurrentSection
:= FResTable
[a
].ResourceName
;
548 if (FResTable
[a
].ResourceName
= Resource
) and
549 (CurrentSection
= Section
) then
557 function TWADEditor_1
.HaveSection(Section
: string): Boolean;
563 if FResTable
= nil then Exit
;
570 Section
:= AnsiUpperCase(Section
);
572 for a
:= 0 to High(FResTable
) do
573 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
580 function TWADEditor_1
.GetResource(Section
, Resource
: string;
581 var pData
: Pointer; var Len
: Integer): Boolean;
586 CurrentSection
: string;
592 CurrentSection
:= '';
594 if FWADOpened
= DFWAD_OPENED_NONE
then
596 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
600 Section
:= UpperCase(Section
);
601 Resource
:= UpperCase(Resource
);
604 for a
:= 0 to High(FResTable
) do
606 if FResTable
[a
].Length
= 0 then
608 CurrentSection
:= FResTable
[a
].ResourceName
;
612 if (FResTable
[a
].ResourceName
= Resource
) and
613 (CurrentSection
= Section
) then
622 FLastError
:= DFWAD_ERROR_RESOURCENOTFOUND
;
626 if FWADOpened
= DFWAD_OPENED_FILE
then
629 AssignFile(WADFile
, FFileName
);
632 Seek(WADFile
, FResTable
[i
].Address
+6+
633 LongWord(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
634 TempData
:= GetMemory(FResTable
[i
].Length
);
635 BlockRead(WADFile
, TempData
^, FResTable
[i
].Length
);
636 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
643 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
650 TempData
:= GetMemory(FResTable
[i
].Length
);
651 CopyMemory(TempData
, Pointer(NativeUInt(FResData
)+FResTable
[i
].Address
+6+
652 LongWord(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
))),
653 FResTable
[i
].Length
);
654 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
660 FLastError
:= DFWAD_NOERROR
;
664 function TWADEditor_1
.GetResourcesList(Section
: string): SArray
;
667 CurrentSection
: Char16
;
671 if FResTable
= nil then Exit
;
672 if Length(Section
) > 16 then Exit
;
674 CurrentSection
:= '';
676 for a
:= 0 to High(FResTable
) do
678 if FResTable
[a
].Length
= 0 then
680 CurrentSection
:= FResTable
[a
].ResourceName
;
684 if CurrentSection
= Section
then
686 SetLength(Result
, Length(Result
)+1);
687 Result
[High(Result
)] := FResTable
[a
].ResourceName
;
692 function TWADEditor_1
.GetSectionList(): SArray
;
698 if FResTable
= nil then Exit
;
700 if FResTable
[0].Length
<> 0 then
702 SetLength(Result
, 1);
706 for i
:= 0 to High(FResTable
) do
707 if FResTable
[i
].Length
= 0 then
709 SetLength(Result
, Length(Result
)+1);
710 Result
[High(Result
)] := FResTable
[i
].ResourceName
;
714 function TWADEditor_1
.LastErrorString(): string;
717 DFWAD_NOERROR
: Result
:= '';
718 DFWAD_ERROR_WADNOTFOUND
: Result
:= 'DFWAD file not found';
719 DFWAD_ERROR_CANTOPENWAD
: Result
:= 'Can''t open DFWAD file';
720 DFWAD_ERROR_RESOURCENOTFOUND
: Result
:= 'Resource not found';
721 DFWAD_ERROR_FILENOTWAD
: Result
:= 'File is not DFWAD';
722 DFWAD_ERROR_WADNOTLOADED
: Result
:= 'DFWAD file is not loaded';
723 DFWAD_ERROR_READRESOURCE
: Result
:= 'Read resource error';
724 DFWAD_ERROR_READWAD
: Result
:= 'Read DFWAD error';
725 else Result
:= 'Unknown DFWAD error';
729 function TWADEditor_1
.ReadFile(FileName
: string): Boolean;
732 Signature
: array[0..4] of Char;
739 if not FileExists(FileName
) then
741 FLastError
:= DFWAD_ERROR_WADNOTFOUND
;
745 FFileName
:= FileName
;
747 AssignFile(WADFile
, FFileName
);
752 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
757 BlockRead(WADFile
, Signature
, 5);
758 if Signature
<> DFWAD_SIGNATURE
then
760 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
765 BlockRead(WADFile
, FVersion
, 1);
766 if FVersion
<> DFWAD_VERSION
then
768 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
773 BlockRead(WADFile
, FHeader
, SizeOf(TWADHeaderRec_1
));
774 SetLength(FResTable
, FHeader
.RecordsCount
);
775 if FResTable
<> nil then
777 BlockRead(WADFile
, FResTable
[0], SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
779 for a
:= 0 to High(FResTable
) do
780 if FResTable
[a
].Length
<> 0 then
781 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
782 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
787 FLastError
:= DFWAD_ERROR_READWAD
;
792 FWADOpened
:= DFWAD_OPENED_FILE
;
793 FLastError
:= DFWAD_NOERROR
;
797 function TWADEditor_1
.ReadMemory(Data
: Pointer; Len
: LongWord): Boolean;
799 Signature
: array[0..4] of Char;
806 CopyMemory(@Signature
[0], Data
, 5);
807 if Signature
<> DFWAD_SIGNATURE
then
809 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
813 CopyMemory(@FVersion
, Pointer(NativeUInt(Data
)+5), 1);
814 if FVersion
<> DFWAD_VERSION
then
816 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
820 CopyMemory(@FHeader
, Pointer(NativeUInt(Data
)+6), SizeOf(TWADHeaderRec_1
));
822 SetLength(FResTable
, FHeader
.RecordsCount
);
823 if FResTable
<> nil then
825 CopyMemory(@FResTable
[0], Pointer(NativeUInt(Data
)+6+SizeOf(TWADHeaderRec_1
)),
826 SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
828 for a
:= 0 to High(FResTable
) do
829 if FResTable
[a
].Length
<> 0 then
830 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
831 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
834 GetMem(FResData
, Len
);
835 CopyMemory(FResData
, Data
, Len
);
837 FWADOpened
:= DFWAD_OPENED_MEMORY
;
838 FLastError
:= DFWAD_NOERROR
;
843 procedure TWADEditor_1
.RemoveResource(Section
, Resource
: string);
846 CurrentSection
: Char16
;
849 if FResTable
= nil then Exit
;
854 CurrentSection
:= '';
856 for a
:= 0 to High(FResTable
) do
858 if FResTable
[a
].Length
= 0 then
860 CurrentSection
:= FResTable
[a
].ResourceName
;
864 if (FResTable
[a
].ResourceName
= Resource
) and
865 (CurrentSection
= Section
) then
868 b
:= FResTable
[a
].Length
;
869 c
:= FResTable
[a
].Address
;
876 for a
:= i
to High(FResTable
)-1 do
877 FResTable
[a
] := FResTable
[a
+1];
879 SetLength(FResTable
, Length(FResTable
)-1);
882 for a
:= 0 to High(FResTable
) do
883 if (FResTable
[a
].Length
<> 0) and (FResTable
[a
].Address
> c
) then
885 FResTable
[a
].Address
:= FResTable
[a
].Address
-b
;
886 d
:= d
+FResTable
[a
].Length
;
889 CopyMemory(Pointer(LongWord(FResData
)+c
), Pointer(LongWord(FResData
)+c
+b
), d
);
891 FDataSize
:= FDataSize
-b
;
892 FOffset
:= FOffset
-b
;
893 ReallocMem(FResData
, FDataSize
);
895 FHeader
.RecordsCount
:= FHeader
.RecordsCount
-1;
898 procedure TWADEditor_1
.SaveTo(FileName
: string);
903 Header
: TWADHeaderRec_1
;
906 sign
:= DFWAD_SIGNATURE
;
907 ver
:= DFWAD_VERSION
;
909 Header
.RecordsCount
:= Length(FResTable
);
911 if FResTable
<> nil then
912 for i
:= 0 to High(FResTable
) do
913 if FResTable
[i
].Length
<> 0 then
914 FResTable
[i
].Address
:= FResTable
[i
].Address
+6+SizeOf(TWADHeaderRec_1
)+
915 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
;
917 AssignFile(WADFile
, FileName
);
919 BlockWrite(WADFile
, sign
[1], 5);
920 BlockWrite(WADFile
, ver
, 1);
921 BlockWrite(WADFile
, Header
, SizeOf(TWADHeaderRec_1
));
922 if FResTable
<> nil then BlockWrite(WADFile
, FResTable
[0],
923 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
);
924 if FResData
<> nil then BlockWrite(WADFile
, FResData
^, FDataSize
);