4 -----------------------------------
5 WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08
7 Ïîääåðæêà âàäîâ âåðñèè 1
8 -----------------------------------
16 SArray
= array of ShortString;
18 TWADEditor_1
= class(TObject
)
21 FResTable
: packed array of TResourceTableRec_1
;
22 FHeader
: TWADHeaderRec_1
;
29 function LastErrorString(): string;
30 function GetResName(ResName
: string): Char16
;
33 destructor Destroy(); override;
35 function ReadFile(FileName
: string): Boolean;
36 function ReadMemory(Data
: Pointer; Len
: LongWord): Boolean;
37 procedure CreateImage();
38 function AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
39 Section
: string): Boolean; overload
;
40 function AddResource(FileName
, Name
, Section
: string): Boolean; overload
;
41 function AddAlias(Res
, Alias
: string): Boolean;
42 procedure AddSection(Name
: string);
43 procedure RemoveResource(Section
, Resource
: string);
44 procedure SaveTo(FileName
: string);
45 function HaveResource(Section
, Resource
: string): Boolean;
46 function HaveSection(Section
: string): Boolean;
47 function GetResource(Section
, Resource
: string; var pData
: Pointer;
48 var Len
: Integer): Boolean;
49 function GetSectionList(): SArray
;
50 function GetResourcesList(Section
: string): SArray
;
52 property GetLastError
: Integer read FLastError
;
53 property GetLastErrorStr
: string read LastErrorString
;
54 property GetResourcesCount
: Word read FHeader
.RecordsCount
;
55 property GetVersion
: Byte read FVersion
;
60 DFWAD_ERROR_WADNOTFOUND
= -1;
61 DFWAD_ERROR_CANTOPENWAD
= -2;
62 DFWAD_ERROR_RESOURCENOTFOUND
= -3;
63 DFWAD_ERROR_FILENOTWAD
= -4;
64 DFWAD_ERROR_WADNOTLOADED
= -5;
65 DFWAD_ERROR_READRESOURCE
= -6;
66 DFWAD_ERROR_READWAD
= -7;
67 DFWAD_ERROR_WRONGVERSION
= -8;
70 procedure g_ProcessResourceStr(ResourceStr
: String; var FileName
,
71 SectionName
, ResourceName
: String); overload
;
72 procedure g_ProcessResourceStr(ResourceStr
: String; FileName
,
73 SectionName
, ResourceName
: PString); overload
;
78 SysUtils
, BinEditor
, ZLib
, utils
, e_log
;
81 DFWAD_OPENED_NONE
= 0;
82 DFWAD_OPENED_FILE
= 1;
83 DFWAD_OPENED_MEMORY
= 2;
85 procedure DecompressBuf(const InBuf
: Pointer; InBytes
: Integer;
86 OutEstimate
: Integer; out OutBuf
: Pointer; out OutBytes
: Integer);
92 FillChar(strm
, sizeof(strm
), 0);
93 BufInc
:= (InBytes
+ 255) and not 255;
94 if OutEstimate
= 0 then
97 OutBytes
:= OutEstimate
;
98 GetMem(OutBuf
, OutBytes
);
100 strm
.next_in
:= InBuf
;
101 strm
.avail_in
:= InBytes
;
102 strm
.next_out
:= OutBuf
;
103 strm
.avail_out
:= OutBytes
;
104 inflateInit_(strm
, zlib_version
, sizeof(strm
));
106 while inflate(strm
, Z_FINISH
) <> Z_STREAM_END
do
109 Inc(OutBytes
, BufInc
);
110 ReallocMem(OutBuf
, OutBytes
);
111 strm
.next_out
:= PByteF(PChar(OutBuf
) + (PChar(strm
.next_out
) - PChar(P
)));
112 strm
.avail_out
:= BufInc
;
117 ReallocMem(OutBuf
, strm
.total_out
);
118 OutBytes
:= strm
.total_out
;
125 procedure CompressBuf(const InBuf
: Pointer; InBytes
: Integer;
126 out OutBuf
: Pointer; out OutBytes
: Integer);
131 FillChar(strm
, sizeof(strm
), 0);
132 OutBytes
:= ((InBytes
+ (InBytes
div 10) + 12) + 255) and not 255;
133 GetMem(OutBuf
, OutBytes
);
135 strm
.next_in
:= InBuf
;
136 strm
.avail_in
:= InBytes
;
137 strm
.next_out
:= OutBuf
;
138 strm
.avail_out
:= OutBytes
;
139 deflateInit_(strm
, Z_BEST_COMPRESSION
, zlib_version
, sizeof(strm
));
141 while deflate(strm
, Z_FINISH
) <> Z_STREAM_END
do
145 ReallocMem(OutBuf
, OutBytes
);
146 strm
.next_out
:= PByteF(PtrUInt(OutBuf
+ (strm
.next_out
- P
)));
147 strm
.avail_out
:= 256;
152 ReallocMem(OutBuf
, strm
.total_out
);
153 OutBytes
:= strm
.total_out
;
160 procedure g_ProcessResourceStr(ResourceStr
: String; var FileName
,
161 SectionName
, ResourceName
: String);
166 for i
:= Length(ResourceStr
) downto 1 do
167 if ResourceStr
[i
] = ':' then
170 FileName
:= Copy(ResourceStr
, 1, i
-1);
172 for a
:= i
+1 to Length(ResourceStr
) do
173 if (ResourceStr
[a
] = '\') or (ResourceStr
[a
] = '/') then Break
;
175 ResourceName
:= Copy(ResourceStr
, a
+1, Length(ResourceStr
)-Abs(a
));
176 SectionName
:= Copy(ResourceStr
, i
+1, Length(ResourceStr
)-Length(ResourceName
)-Length(FileName
)-2);
179 procedure g_ProcessResourceStr(ResourceStr
: AnsiString; FileName
,
180 SectionName
, ResourceName
: PAnsiString);
182 a
, i
, l1
, l2
: Integer;
185 for i
:= Length(ResourceStr
) downto 1 do
186 if ResourceStr
[i
] = ':' then
189 if FileName
<> nil then
191 FileName
^ := Copy(ResourceStr
, 1, i
-1);
192 l1
:= Length(FileName
^);
197 for a
:= i
+1 to Length(ResourceStr
) do
198 if (ResourceStr
[a
] = '\') or (ResourceStr
[a
] = '/') then Break
;
200 if ResourceName
<> nil then
202 ResourceName
^ := Copy(ResourceStr
, a
+1, Length(ResourceStr
)-Abs(a
));
203 l2
:= Length(ResourceName
^);
208 if SectionName
<> nil then
209 SectionName
^ := Copy(ResourceStr
, i
+1, Length(ResourceStr
)-l2
-l1
-2);
214 function TWADEditor_1
.AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
215 Section
: string): Boolean;
217 ResCompressed
: Pointer;
218 ResCompressedSize
: Integer;
223 SetLength(FResTable
, Length(FResTable
)+1);
227 if Length(FResTable
) > 1 then
228 for a
:= High(FResTable
) downto 1 do
229 FResTable
[a
] := FResTable
[a
-1];
235 Section
:= AnsiUpperCase(Section
);
238 for a
:= 0 to High(FResTable
) do
239 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
241 for b
:= High(FResTable
) downto a
+2 do
242 FResTable
[b
] := FResTable
[b
-1];
250 SetLength(FResTable
, Length(FResTable
)-1);
256 ResCompressed
:= nil;
257 ResCompressedSize
:= 0;
258 CompressBuf(Data
, Len
, ResCompressed
, ResCompressedSize
);
259 if ResCompressed
= nil then Exit
;
260 e_WriteLog('Fuck me (D)', MSG_NOTIFY
);
262 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
263 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
265 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
267 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
268 ResCompressed
, ResCompressedSize
);
269 FreeMemory(ResCompressed
);
271 Inc(FHeader
.RecordsCount
);
275 ResourceName
:= GetResName(Name
);
277 Length
:= ResCompressedSize
;
280 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
285 function TWADEditor_1
.AddAlias(Res
, Alias
: string): Boolean;
292 if FResTable
= nil then Exit
;
295 ares
:= GetResName(Alias
);
296 for a
:= 0 to High(FResTable
) do
297 if FResTable
[a
].ResourceName
= Res
then
305 Inc(FHeader
.RecordsCount
);
307 SetLength(FResTable
, Length(FResTable
)+1);
309 with FResTable
[High(FResTable
)] do
311 ResourceName
:= ares
;
312 Address
:= FResTable
[b
].Address
;
313 Length
:= FResTable
[b
].Length
;
319 function TWADEditor_1
.AddResource(FileName
, Name
, Section
: string): Boolean;
321 ResCompressed
: Pointer;
322 ResCompressedSize
: Integer;
324 TempResource
: Pointer;
325 OriginalSize
: Integer;
330 AssignFile(ResourceFile
, findFileCIStr(FileName
));
333 Reset(ResourceFile
, 1);
335 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
339 OriginalSize
:= FileSize(ResourceFile
);
340 GetMem(TempResource
, OriginalSize
);
343 BlockRead(ResourceFile
, TempResource
^, OriginalSize
);
345 FLastError
:= DFWAD_ERROR_READWAD
;
346 FreeMemory(TempResource
);
347 CloseFile(ResourceFile
);
351 CloseFile(ResourceFile
);
353 ResCompressed
:= nil;
354 ResCompressedSize
:= 0;
355 CompressBuf(TempResource
, OriginalSize
, ResCompressed
, ResCompressedSize
);
356 FreeMemory(TempResource
);
357 if ResCompressed
= nil then Exit
;
359 SetLength(FResTable
, Length(FResTable
)+1);
363 if Length(FResTable
) > 1 then
364 for a
:= High(FResTable
) downto 1 do
365 FResTable
[a
] := FResTable
[a
-1];
371 Section
:= AnsiUpperCase(Section
);
374 for a
:= 0 to High(FResTable
) do
375 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
377 for b
:= High(FResTable
) downto a
+2 do
378 FResTable
[b
] := FResTable
[b
-1];
386 FreeMemory(ResCompressed
);
387 SetLength(FResTable
, Length(FResTable
)-1);
394 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
395 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
397 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
398 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
399 ResCompressed
, ResCompressedSize
);
400 FreeMemory(ResCompressed
);
402 Inc(FHeader
.RecordsCount
);
406 ResourceName
:= GetResName(Name
);
408 Length
:= ResCompressedSize
;
411 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
416 procedure TWADEditor_1
.AddSection(Name
: string);
418 if Name
= '' then Exit
;
420 Inc(FHeader
.RecordsCount
);
422 SetLength(FResTable
, Length(FResTable
)+1);
423 with FResTable
[High(FResTable
)] do
425 ResourceName
:= GetResName(Name
);
426 Address
:= $00000000;
431 constructor TWADEditor_1
.Create();
437 FHeader
.RecordsCount
:= 0;
439 FWADOpened
:= DFWAD_OPENED_NONE
;
440 FLastError
:= DFWAD_NOERROR
;
441 FVersion
:= DFWAD_VERSION
;
444 procedure TWADEditor_1
.CreateImage();
449 if FWADOpened
= DFWAD_OPENED_NONE
then
451 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
455 if FWADOpened
= DFWAD_OPENED_MEMORY
then Exit
;
457 if FResData
<> nil then FreeMem(FResData
);
460 AssignFile(WADFile
, findFileCIStr(FFileName
));
463 b
:= 6+SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
);
465 FDataSize
:= LongWord(FileSize(WADFile
))-b
;
467 GetMem(FResData
, FDataSize
);
470 BlockRead(WADFile
, FResData
^, FDataSize
);
474 FOffset
:= FDataSize
;
476 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
481 FLastError
:= DFWAD_NOERROR
;
484 destructor TWADEditor_1
.Destroy();
491 procedure TWADEditor_1
.FreeWAD();
493 if FResData
<> nil then FreeMem(FResData
);
497 FHeader
.RecordsCount
:= 0;
499 FWADOpened
:= DFWAD_OPENED_NONE
;
500 FLastError
:= DFWAD_NOERROR
;
501 FVersion
:= DFWAD_VERSION
;
504 function TWADEditor_1
.GetResName(ResName
: string): Char16
;
506 ZeroMemory(@Result
[0], 16);
507 if ResName
= '' then Exit
;
509 ResName
:= Trim(UpperCase(ResName
));
510 if Length(ResName
) > 16 then SetLength(ResName
, 16);
512 CopyMemory(@Result
[0], @ResName
[1], Length(ResName
));
515 function TWADEditor_1
.HaveResource(Section
, Resource
: string): Boolean;
518 CurrentSection
: string;
522 if FResTable
= nil then Exit
;
524 CurrentSection
:= '';
525 Section
:= AnsiUpperCase(Section
);
526 Resource
:= AnsiUpperCase(Resource
);
528 for a
:= 0 to High(FResTable
) do
530 if FResTable
[a
].Length
= 0 then
532 CurrentSection
:= FResTable
[a
].ResourceName
;
536 if (FResTable
[a
].ResourceName
= Resource
) and
537 (CurrentSection
= Section
) then
545 function TWADEditor_1
.HaveSection(Section
: string): Boolean;
551 if FResTable
= nil then Exit
;
558 Section
:= AnsiUpperCase(Section
);
560 for a
:= 0 to High(FResTable
) do
561 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
568 function TWADEditor_1
.GetResource(Section
, Resource
: string;
569 var pData
: Pointer; var Len
: Integer): Boolean;
574 CurrentSection
: string;
580 CurrentSection
:= '';
582 if FWADOpened
= DFWAD_OPENED_NONE
then
584 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
588 Section
:= UpperCase(Section
);
589 Resource
:= UpperCase(Resource
);
592 for a
:= 0 to High(FResTable
) do
594 if FResTable
[a
].Length
= 0 then
596 CurrentSection
:= FResTable
[a
].ResourceName
;
600 if (FResTable
[a
].ResourceName
= Resource
) and
601 (CurrentSection
= Section
) then
610 FLastError
:= DFWAD_ERROR_RESOURCENOTFOUND
;
614 if FWADOpened
= DFWAD_OPENED_FILE
then
617 AssignFile(WADFile
, findFileCIStr(FFileName
));
620 Seek(WADFile
, FResTable
[i
].Address
+6+
621 LongWord(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
622 TempData
:= GetMemory(FResTable
[i
].Length
);
623 BlockRead(WADFile
, TempData
^, FResTable
[i
].Length
);
624 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
631 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
638 TempData
:= GetMemory(FResTable
[i
].Length
);
639 CopyMemory(TempData
, Pointer(PtrUInt(FResData
)+FResTable
[i
].Address
+6+
640 PtrUInt(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
))),
641 FResTable
[i
].Length
);
642 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
648 FLastError
:= DFWAD_NOERROR
;
652 function TWADEditor_1
.GetResourcesList(Section
: string): SArray
;
655 CurrentSection
: Char16
;
659 if FResTable
= nil then Exit
;
660 if Length(Section
) > 16 then Exit
;
662 CurrentSection
:= '';
664 for a
:= 0 to High(FResTable
) do
666 if FResTable
[a
].Length
= 0 then
668 CurrentSection
:= FResTable
[a
].ResourceName
;
672 if CurrentSection
= Section
then
674 SetLength(Result
, Length(Result
)+1);
675 Result
[High(Result
)] := FResTable
[a
].ResourceName
;
680 function TWADEditor_1
.GetSectionList(): SArray
;
686 if FResTable
= nil then Exit
;
688 if FResTable
[0].Length
<> 0 then
690 SetLength(Result
, 1);
694 for i
:= 0 to High(FResTable
) do
695 if FResTable
[i
].Length
= 0 then
697 SetLength(Result
, Length(Result
)+1);
698 Result
[High(Result
)] := FResTable
[i
].ResourceName
;
702 function TWADEditor_1
.LastErrorString(): string;
705 DFWAD_NOERROR
: Result
:= '';
706 DFWAD_ERROR_WADNOTFOUND
: Result
:= 'DFWAD file not found';
707 DFWAD_ERROR_CANTOPENWAD
: Result
:= 'Can''t open DFWAD file';
708 DFWAD_ERROR_RESOURCENOTFOUND
: Result
:= 'Resource not found';
709 DFWAD_ERROR_FILENOTWAD
: Result
:= 'File is not DFWAD';
710 DFWAD_ERROR_WADNOTLOADED
: Result
:= 'DFWAD file is not loaded';
711 DFWAD_ERROR_READRESOURCE
: Result
:= 'Read resource error';
712 DFWAD_ERROR_READWAD
: Result
:= 'Read DFWAD error';
716 function TWADEditor_1
.ReadFile(FileName
: string): Boolean;
719 Signature
: array[0..4] of Char;
726 if not FileExists(FileName
) then
728 FLastError
:= DFWAD_ERROR_WADNOTFOUND
;
732 FFileName
:= FileName
;
734 AssignFile(WADFile
, findFileCIStr(FFileName
));
739 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
744 BlockRead(WADFile
, Signature
, 5);
745 if Signature
<> DFWAD_SIGNATURE
then
747 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
752 BlockRead(WADFile
, FVersion
, 1);
753 if FVersion
<> DFWAD_VERSION
then
755 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
760 BlockRead(WADFile
, FHeader
, SizeOf(TWADHeaderRec_1
));
761 SetLength(FResTable
, FHeader
.RecordsCount
);
762 if FResTable
<> nil then
764 BlockRead(WADFile
, FResTable
[0], SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
766 for a
:= 0 to High(FResTable
) do
767 if FResTable
[a
].Length
<> 0 then
768 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
769 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
774 FLastError
:= DFWAD_ERROR_READWAD
;
779 FWADOpened
:= DFWAD_OPENED_FILE
;
780 FLastError
:= DFWAD_NOERROR
;
784 function TWADEditor_1
.ReadMemory(Data
: Pointer; Len
: LongWord): Boolean;
786 Signature
: array[0..4] of Char;
793 CopyMemory(@Signature
[0], Data
, 5);
794 if Signature
<> DFWAD_SIGNATURE
then
796 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
800 CopyMemory(@FVersion
, Pointer(PtrUInt(Data
)+5), 1);
801 if FVersion
<> DFWAD_VERSION
then
803 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
807 CopyMemory(@FHeader
, Pointer(PtrUInt(Data
)+6), SizeOf(TWADHeaderRec_1
));
809 SetLength(FResTable
, FHeader
.RecordsCount
);
810 if FResTable
<> nil then
812 CopyMemory(@FResTable
[0], Pointer(PtrUInt(Data
)+6+SizeOf(TWADHeaderRec_1
)),
813 SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
815 for a
:= 0 to High(FResTable
) do
816 if FResTable
[a
].Length
<> 0 then
817 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
818 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
821 GetMem(FResData
, Len
);
822 CopyMemory(FResData
, Data
, Len
);
824 FWADOpened
:= DFWAD_OPENED_MEMORY
;
825 FLastError
:= DFWAD_NOERROR
;
830 procedure TWADEditor_1
.RemoveResource(Section
, Resource
: string);
833 CurrentSection
: Char16
;
836 if FResTable
= nil then Exit
;
838 e_WriteLog('Fuck me (B) ' + Section
+ ' ' + Resource
, MSG_NOTIFY
);
843 CurrentSection
:= '';
845 for a
:= 0 to High(FResTable
) do
847 if FResTable
[a
].Length
= 0 then
849 CurrentSection
:= FResTable
[a
].ResourceName
;
853 if (FResTable
[a
].ResourceName
= Resource
) and
854 (CurrentSection
= Section
) then
857 b
:= FResTable
[a
].Length
;
858 c
:= FResTable
[a
].Address
;
865 e_WriteLog('Fuck me (C) ' + Section
+ ' ' + Resource
, MSG_NOTIFY
);
867 for a
:= i
to High(FResTable
)-1 do
868 FResTable
[a
] := FResTable
[a
+1];
870 SetLength(FResTable
, Length(FResTable
)-1);
873 for a
:= 0 to High(FResTable
) do
874 if (FResTable
[a
].Length
<> 0) and (FResTable
[a
].Address
> c
) then
876 FResTable
[a
].Address
:= FResTable
[a
].Address
-b
;
877 d
:= d
+FResTable
[a
].Length
;
880 CopyMemory(Pointer(PtrUInt(FResData
)+c
), Pointer(PtrUInt(FResData
)+c
+b
), d
);
882 FDataSize
:= FDataSize
-b
;
883 FOffset
:= FOffset
-b
;
884 ReallocMem(FResData
, FDataSize
);
886 FHeader
.RecordsCount
:= FHeader
.RecordsCount
-1;
889 procedure TWADEditor_1
.SaveTo(FileName
: string);
894 Header
: TWADHeaderRec_1
;
897 sign
:= DFWAD_SIGNATURE
;
898 ver
:= DFWAD_VERSION
;
900 Header
.RecordsCount
:= Length(FResTable
);
902 if FResTable
<> nil then
903 for i
:= 0 to High(FResTable
) do
904 if FResTable
[i
].Length
<> 0 then
905 FResTable
[i
].Address
:= FResTable
[i
].Address
+6+SizeOf(TWADHeaderRec_1
)+
906 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
;
908 AssignFile(WADFile
, FileName
);
910 BlockWrite(WADFile
, sign
[1], 5);
911 BlockWrite(WADFile
, ver
, 1);
912 BlockWrite(WADFile
, Header
, SizeOf(TWADHeaderRec_1
));
913 if FResTable
<> nil then BlockWrite(WADFile
, FResTable
[0],
914 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
);
915 if FResData
<> nil then BlockWrite(WADFile
, FResData
^, FDataSize
);