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
;
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 g_ProcessResourceStr(ResourceStr
: String; var FileName
,
126 SectionName
, ResourceName
: String);
131 for i
:= Length(ResourceStr
) downto 1 do
132 if ResourceStr
[i
] = ':' then
135 FileName
:= Copy(ResourceStr
, 1, i
-1);
137 for a
:= i
+1 to Length(ResourceStr
) do
138 if (ResourceStr
[a
] = '\') or (ResourceStr
[a
] = '/') then Break
;
140 ResourceName
:= Copy(ResourceStr
, a
+1, Length(ResourceStr
)-Abs(a
));
141 SectionName
:= Copy(ResourceStr
, i
+1, Length(ResourceStr
)-Length(ResourceName
)-Length(FileName
)-2);
144 procedure g_ProcessResourceStr(ResourceStr
: AnsiString; FileName
,
145 SectionName
, ResourceName
: PAnsiString);
147 a
, i
, l1
, l2
: Integer;
150 for i
:= Length(ResourceStr
) downto 1 do
151 if ResourceStr
[i
] = ':' then
154 if FileName
<> nil then
156 FileName
^ := Copy(ResourceStr
, 1, i
-1);
157 l1
:= Length(FileName
^);
162 for a
:= i
+1 to Length(ResourceStr
) do
163 if (ResourceStr
[a
] = '\') or (ResourceStr
[a
] = '/') then Break
;
165 if ResourceName
<> nil then
167 ResourceName
^ := Copy(ResourceStr
, a
+1, Length(ResourceStr
)-Abs(a
));
168 l2
:= Length(ResourceName
^);
173 if SectionName
<> nil then
174 SectionName
^ := Copy(ResourceStr
, i
+1, Length(ResourceStr
)-l2
-l1
-2);
179 function TWADEditor_1
.AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
180 Section
: string): Boolean;
182 ResCompressed
: Pointer;
183 ResCompressedSize
: Integer;
188 SetLength(FResTable
, Length(FResTable
)+1);
192 if Length(FResTable
) > 1 then
193 for a
:= High(FResTable
) downto 1 do
194 FResTable
[a
] := FResTable
[a
-1];
200 Section
:= AnsiUpperCase(Section
);
203 for a
:= 0 to High(FResTable
) do
204 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
206 for b
:= High(FResTable
) downto a
+2 do
207 FResTable
[b
] := FResTable
[b
-1];
215 SetLength(FResTable
, Length(FResTable
)-1);
221 ResCompressed
:= nil;
222 ResCompressedSize
:= 0;
223 Compress(Data
, @Len
, ResCompressed
, ResCompressedSize
);
224 if ResCompressed
= nil then Exit
;
226 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
227 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
229 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
231 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
232 ResCompressed
, ResCompressedSize
);
233 FreeMemory(ResCompressed
);
235 Inc(FHeader
.RecordsCount
);
239 ResourceName
:= GetResName(Name
);
241 Length
:= ResCompressedSize
;
244 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
249 function TWADEditor_1
.AddAlias(Res
, Alias
: string): Boolean;
256 if FResTable
= nil then Exit
;
259 ares
:= GetResName(Alias
);
260 for a
:= 0 to High(FResTable
) do
261 if FResTable
[a
].ResourceName
= Res
then
269 Inc(FHeader
.RecordsCount
);
271 SetLength(FResTable
, Length(FResTable
)+1);
273 with FResTable
[High(FResTable
)] do
275 ResourceName
:= ares
;
276 Address
:= FResTable
[b
].Address
;
277 Length
:= FResTable
[b
].Length
;
283 function TWADEditor_1
.AddResource(FileName
, Name
, Section
: string): Boolean;
285 ResCompressed
: Pointer;
286 ResCompressedSize
: Integer;
288 TempResource
: Pointer;
289 OriginalSize
: Integer;
294 AssignFile(ResourceFile
, FileName
);
297 Reset(ResourceFile
, 1);
299 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
303 OriginalSize
:= FileSize(ResourceFile
);
304 GetMem(TempResource
, OriginalSize
);
307 BlockRead(ResourceFile
, TempResource
^, OriginalSize
);
309 FLastError
:= DFWAD_ERROR_READWAD
;
310 FreeMemory(TempResource
);
311 CloseFile(ResourceFile
);
315 CloseFile(ResourceFile
);
317 ResCompressed
:= nil;
318 ResCompressedSize
:= 0;
319 Compress(TempResource
, @OriginalSize
, ResCompressed
, ResCompressedSize
);
320 FreeMemory(TempResource
);
321 if ResCompressed
= nil then Exit
;
323 SetLength(FResTable
, Length(FResTable
)+1);
327 if Length(FResTable
) > 1 then
328 for a
:= High(FResTable
) downto 1 do
329 FResTable
[a
] := FResTable
[a
-1];
335 Section
:= AnsiUpperCase(Section
);
338 for a
:= 0 to High(FResTable
) do
339 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
341 for b
:= High(FResTable
) downto a
+2 do
342 FResTable
[b
] := FResTable
[b
-1];
350 FreeMemory(ResCompressed
);
351 SetLength(FResTable
, Length(FResTable
)-1);
358 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
359 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
361 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
362 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
363 ResCompressed
, ResCompressedSize
);
364 FreeMemory(ResCompressed
);
366 Inc(FHeader
.RecordsCount
);
370 ResourceName
:= GetResName(Name
);
372 Length
:= ResCompressedSize
;
375 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
380 procedure TWADEditor_1
.AddSection(Name
: string);
382 if Name
= '' then Exit
;
384 Inc(FHeader
.RecordsCount
);
386 SetLength(FResTable
, Length(FResTable
)+1);
387 with FResTable
[High(FResTable
)] do
389 ResourceName
:= GetResName(Name
);
390 Address
:= $00000000;
395 constructor TWADEditor_1
.Create();
401 FHeader
.RecordsCount
:= 0;
403 FWADOpened
:= DFWAD_OPENED_NONE
;
404 FLastError
:= DFWAD_NOERROR
;
405 FVersion
:= DFWAD_VERSION
;
408 procedure TWADEditor_1
.CreateImage();
413 if FWADOpened
= DFWAD_OPENED_NONE
then
415 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
419 if FWADOpened
= DFWAD_OPENED_MEMORY
then Exit
;
421 if FResData
<> nil then FreeMem(FResData
);
424 AssignFile(WADFile
, FFileName
);
427 b
:= 6+SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
);
429 FDataSize
:= LongWord(FileSize(WADFile
))-b
;
431 GetMem(FResData
, FDataSize
);
434 BlockRead(WADFile
, FResData
^, FDataSize
);
438 FOffset
:= FDataSize
;
440 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
445 FLastError
:= DFWAD_NOERROR
;
448 destructor TWADEditor_1
.Destroy();
455 procedure TWADEditor_1
.FreeWAD();
457 if FResData
<> nil then FreeMem(FResData
);
461 FHeader
.RecordsCount
:= 0;
463 FWADOpened
:= DFWAD_OPENED_NONE
;
464 FLastError
:= DFWAD_NOERROR
;
465 FVersion
:= DFWAD_VERSION
;
468 function TWADEditor_1
.GetResName(ResName
: string): Char16
;
470 ZeroMemory(@Result
[0], 16);
471 if ResName
= '' then Exit
;
473 ResName
:= Trim(UpperCase(ResName
));
474 if Length(ResName
) > 16 then SetLength(ResName
, 16);
476 CopyMemory(@Result
[0], @ResName
[1], Length(ResName
));
479 function TWADEditor_1
.HaveResource(Section
, Resource
: string): Boolean;
482 CurrentSection
: string;
486 if FResTable
= nil then Exit
;
488 CurrentSection
:= '';
489 Section
:= AnsiUpperCase(Section
);
490 Resource
:= AnsiUpperCase(Resource
);
492 for a
:= 0 to High(FResTable
) do
494 if FResTable
[a
].Length
= 0 then
496 CurrentSection
:= FResTable
[a
].ResourceName
;
500 if (FResTable
[a
].ResourceName
= Resource
) and
501 (CurrentSection
= Section
) then
509 function TWADEditor_1
.HaveSection(Section
: string): Boolean;
515 if FResTable
= nil then Exit
;
522 Section
:= AnsiUpperCase(Section
);
524 for a
:= 0 to High(FResTable
) do
525 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
532 function TWADEditor_1
.GetResource(Section
, Resource
: string;
533 var pData
: Pointer; var Len
: Integer): Boolean;
538 CurrentSection
: string;
544 CurrentSection
:= '';
546 if FWADOpened
= DFWAD_OPENED_NONE
then
548 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
552 Section
:= UpperCase(Section
);
553 Resource
:= UpperCase(Resource
);
556 for a
:= 0 to High(FResTable
) do
558 if FResTable
[a
].Length
= 0 then
560 CurrentSection
:= FResTable
[a
].ResourceName
;
564 if (FResTable
[a
].ResourceName
= Resource
) and
565 (CurrentSection
= Section
) then
574 FLastError
:= DFWAD_ERROR_RESOURCENOTFOUND
;
578 if FWADOpened
= DFWAD_OPENED_FILE
then
581 AssignFile(WADFile
, FFileName
);
584 Seek(WADFile
, FResTable
[i
].Address
+6+
585 LongWord(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
586 TempData
:= GetMemory(FResTable
[i
].Length
);
587 BlockRead(WADFile
, TempData
^, FResTable
[i
].Length
);
588 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
595 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
602 TempData
:= GetMemory(FResTable
[i
].Length
);
603 CopyMemory(TempData
, Pointer(LongWord(FResData
)+FResTable
[i
].Address
+6+
604 LongWord(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
))),
605 FResTable
[i
].Length
);
606 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
612 FLastError
:= DFWAD_NOERROR
;
616 function TWADEditor_1
.GetResourcesList(Section
: string): SArray
;
619 CurrentSection
: Char16
;
623 if FResTable
= nil then Exit
;
624 if Length(Section
) > 16 then Exit
;
626 CurrentSection
:= '';
628 for a
:= 0 to High(FResTable
) do
630 if FResTable
[a
].Length
= 0 then
632 CurrentSection
:= FResTable
[a
].ResourceName
;
636 if CurrentSection
= Section
then
638 SetLength(Result
, Length(Result
)+1);
639 Result
[High(Result
)] := FResTable
[a
].ResourceName
;
644 function TWADEditor_1
.GetSectionList(): SArray
;
650 if FResTable
= nil then Exit
;
652 if FResTable
[0].Length
<> 0 then
654 SetLength(Result
, 1);
658 for i
:= 0 to High(FResTable
) do
659 if FResTable
[i
].Length
= 0 then
661 SetLength(Result
, Length(Result
)+1);
662 Result
[High(Result
)] := FResTable
[i
].ResourceName
;
666 function TWADEditor_1
.LastErrorString(): string;
669 DFWAD_NOERROR
: Result
:= '';
670 DFWAD_ERROR_WADNOTFOUND
: Result
:= 'DFWAD file not found';
671 DFWAD_ERROR_CANTOPENWAD
: Result
:= 'Can''t open DFWAD file';
672 DFWAD_ERROR_RESOURCENOTFOUND
: Result
:= 'Resource not found';
673 DFWAD_ERROR_FILENOTWAD
: Result
:= 'File is not DFWAD';
674 DFWAD_ERROR_WADNOTLOADED
: Result
:= 'DFWAD file is not loaded';
675 DFWAD_ERROR_READRESOURCE
: Result
:= 'Read resource error';
676 DFWAD_ERROR_READWAD
: Result
:= 'Read DFWAD error';
680 function TWADEditor_1
.ReadFile(FileName
: string): Boolean;
683 Signature
: array[0..4] of Char;
690 if not FileExists(FileName
) then
692 FLastError
:= DFWAD_ERROR_WADNOTFOUND
;
696 FFileName
:= FileName
;
698 AssignFile(WADFile
, FFileName
);
703 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
708 BlockRead(WADFile
, Signature
, 5);
709 if Signature
<> DFWAD_SIGNATURE
then
711 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
716 BlockRead(WADFile
, FVersion
, 1);
717 if FVersion
<> DFWAD_VERSION
then
719 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
724 BlockRead(WADFile
, FHeader
, SizeOf(TWADHeaderRec_1
));
725 SetLength(FResTable
, FHeader
.RecordsCount
);
726 if FResTable
<> nil then
728 BlockRead(WADFile
, FResTable
[0], SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
730 for a
:= 0 to High(FResTable
) do
731 if FResTable
[a
].Length
<> 0 then
732 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
733 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
738 FLastError
:= DFWAD_ERROR_READWAD
;
743 FWADOpened
:= DFWAD_OPENED_FILE
;
744 FLastError
:= DFWAD_NOERROR
;
748 function TWADEditor_1
.ReadMemory(Data
: Pointer; Len
: LongWord): Boolean;
750 Signature
: array[0..4] of Char;
757 CopyMemory(@Signature
[0], Data
, 5);
758 if Signature
<> DFWAD_SIGNATURE
then
760 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
764 CopyMemory(@FVersion
, Pointer(LongWord(Data
)+5), 1);
765 if FVersion
<> DFWAD_VERSION
then
767 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
771 CopyMemory(@FHeader
, Pointer(LongWord(Data
)+6), SizeOf(TWADHeaderRec_1
));
773 SetLength(FResTable
, FHeader
.RecordsCount
);
774 if FResTable
<> nil then
776 CopyMemory(@FResTable
[0], Pointer(LongWord(Data
)+6+SizeOf(TWADHeaderRec_1
)),
777 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
)));
785 GetMem(FResData
, Len
);
786 CopyMemory(FResData
, Data
, Len
);
788 FWADOpened
:= DFWAD_OPENED_MEMORY
;
789 FLastError
:= DFWAD_NOERROR
;
794 procedure TWADEditor_1
.RemoveResource(Section
, Resource
: string);
797 CurrentSection
: Char16
;
800 if FResTable
= nil then Exit
;
805 CurrentSection
:= '';
807 for a
:= 0 to High(FResTable
) do
809 if FResTable
[a
].Length
= 0 then
811 CurrentSection
:= FResTable
[a
].ResourceName
;
815 if (FResTable
[a
].ResourceName
= Resource
) and
816 (CurrentSection
= Section
) then
819 b
:= FResTable
[a
].Length
;
820 c
:= FResTable
[a
].Address
;
827 for a
:= i
to High(FResTable
)-1 do
828 FResTable
[a
] := FResTable
[a
+1];
830 SetLength(FResTable
, Length(FResTable
)-1);
833 for a
:= 0 to High(FResTable
) do
834 if (FResTable
[a
].Length
<> 0) and (FResTable
[a
].Address
> c
) then
836 FResTable
[a
].Address
:= FResTable
[a
].Address
-b
;
837 d
:= d
+FResTable
[a
].Length
;
840 CopyMemory(Pointer(LongWord(FResData
)+c
), Pointer(LongWord(FResData
)+c
+b
), d
);
842 FDataSize
:= FDataSize
-b
;
843 FOffset
:= FOffset
-b
;
844 ReallocMem(FResData
, FDataSize
);
846 FHeader
.RecordsCount
:= FHeader
.RecordsCount
-1;
849 procedure TWADEditor_1
.SaveTo(FileName
: string);
854 Header
: TWADHeaderRec_1
;
857 sign
:= DFWAD_SIGNATURE
;
858 ver
:= DFWAD_VERSION
;
860 Header
.RecordsCount
:= Length(FResTable
);
862 if FResTable
<> nil then
863 for i
:= 0 to High(FResTable
) do
864 if FResTable
[i
].Length
<> 0 then
865 FResTable
[i
].Address
:= FResTable
[i
].Address
+6+SizeOf(TWADHeaderRec_1
)+
866 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
;
868 AssignFile(WADFile
, FileName
);
870 BlockWrite(WADFile
, sign
[1], 5);
871 BlockWrite(WADFile
, ver
, 1);
872 BlockWrite(WADFile
, Header
, SizeOf(TWADHeaderRec_1
));
873 if FResTable
<> nil then BlockWrite(WADFile
, FResTable
[0],
874 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
);
875 if FResData
<> nil then BlockWrite(WADFile
, FResData
^, FDataSize
);