4 -----------------------------------
5 WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08
7 Ïîääåðæêà âàäîâ âåðñèè 1
8 -----------------------------------
13 uses WADEDITOR
, WADSTRUCT
;
16 TWADEditor_1
= class sealed(WADEDITOR
.TWADEditor
)
19 FResTable
: packed array of TResourceTableRec_1
;
20 FHeader
: TWADHeaderRec_1
;
27 function LastErrorString(): string;
28 function GetResName(ResName
: string): Char16
;
31 destructor Destroy(); override;
32 procedure FreeWAD(); override;
33 function ReadFile2(FileName
: string): Boolean; override;
34 function ReadMemory(Data
: Pointer; Len
: LongWord): Boolean; override;
35 procedure CreateImage(); override;
36 function AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
37 Section
: string): Boolean; override; overload
;
38 function AddResource(FileName
, Name
, Section
: string): Boolean; override; overload
;
39 function AddAlias(Res
, Alias
: string): Boolean; override;
40 procedure AddSection(Name
: string); override;
41 procedure RemoveResource(Section
, Resource
: string); override;
42 procedure SaveTo(FileName
: string); override;
43 function HaveResource(Section
, Resource
: string): Boolean; override;
44 function HaveSection(Section
: string): Boolean; override;
45 function GetResource(Section
, Resource
: string; var pData
: Pointer;
46 var Len
: Integer): Boolean; override;
47 function GetSectionList(): SArray
; override;
48 function GetResourcesList(Section
: string): SArray
; override;
50 function GetLastError
: Integer; override;
51 function GetLastErrorStr
: String; override;
52 function GetResourcesCount
: Word; override;
53 function GetVersion
: Byte; override;
55 // property GetLastError: Integer read FLastError;
56 // property GetLastErrorStr: string read LastErrorString;
57 // property GetResourcesCount: Word read FHeader.RecordsCount;
58 // property GetVersion: Byte read FVersion;
63 DFWAD_ERROR_WADNOTFOUND
= -1;
64 DFWAD_ERROR_CANTOPENWAD
= -2;
65 DFWAD_ERROR_RESOURCENOTFOUND
= -3;
66 DFWAD_ERROR_FILENOTWAD
= -4;
67 DFWAD_ERROR_WADNOTLOADED
= -5;
68 DFWAD_ERROR_READRESOURCE
= -6;
69 DFWAD_ERROR_READWAD
= -7;
70 DFWAD_ERROR_WRONGVERSION
= -8;
75 SysUtils
, BinEditor
, ZLib
, utils
, e_log
;
78 DFWAD_OPENED_NONE
= 0;
79 DFWAD_OPENED_FILE
= 1;
80 DFWAD_OPENED_MEMORY
= 2;
82 procedure DecompressBuf(const InBuf
: Pointer; InBytes
: Integer;
83 OutEstimate
: Integer; out OutBuf
: Pointer; out OutBytes
: Integer);
89 FillChar(strm
, sizeof(strm
), 0);
90 BufInc
:= (InBytes
+ 255) and not 255;
91 if OutEstimate
= 0 then
94 OutBytes
:= OutEstimate
;
95 GetMem(OutBuf
, OutBytes
);
97 strm
.next_in
:= InBuf
;
98 strm
.avail_in
:= InBytes
;
99 strm
.next_out
:= OutBuf
;
100 strm
.avail_out
:= OutBytes
;
101 inflateInit_(strm
, zlib_version
, sizeof(strm
));
103 while inflate(strm
, Z_FINISH
) <> Z_STREAM_END
do
106 Inc(OutBytes
, BufInc
);
107 ReallocMem(OutBuf
, OutBytes
);
108 strm
.next_out
:= PByteF(PChar(OutBuf
) + (PChar(strm
.next_out
) - PChar(P
)));
109 strm
.avail_out
:= BufInc
;
114 ReallocMem(OutBuf
, strm
.total_out
);
115 OutBytes
:= strm
.total_out
;
122 procedure CompressBuf(const InBuf
: Pointer; InBytes
: Integer;
123 out OutBuf
: Pointer; out OutBytes
: Integer);
128 FillChar(strm
, sizeof(strm
), 0);
129 OutBytes
:= ((InBytes
+ (InBytes
div 10) + 12) + 255) and not 255;
130 GetMem(OutBuf
, OutBytes
);
132 strm
.next_in
:= InBuf
;
133 strm
.avail_in
:= InBytes
;
134 strm
.next_out
:= OutBuf
;
135 strm
.avail_out
:= OutBytes
;
136 deflateInit_(strm
, Z_BEST_COMPRESSION
, zlib_version
, sizeof(strm
));
138 while deflate(strm
, Z_FINISH
) <> Z_STREAM_END
do
142 ReallocMem(OutBuf
, OutBytes
);
143 strm
.next_out
:= PByteF(PtrUInt(OutBuf
+ (strm
.next_out
- P
)));
144 strm
.avail_out
:= 256;
149 ReallocMem(OutBuf
, strm
.total_out
);
150 OutBytes
:= strm
.total_out
;
159 function TWADEditor_1
.AddResource(Data
: Pointer; Len
: LongWord; Name
: string;
160 Section
: string): Boolean;
162 ResCompressed
: Pointer;
163 ResCompressedSize
: Integer;
168 SetLength(FResTable
, Length(FResTable
)+1);
172 if Length(FResTable
) > 1 then
173 for a
:= High(FResTable
) downto 1 do
174 FResTable
[a
] := FResTable
[a
-1];
180 Section
:= AnsiUpperCase(Section
);
183 for a
:= 0 to High(FResTable
) do
184 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
186 for b
:= High(FResTable
) downto a
+2 do
187 FResTable
[b
] := FResTable
[b
-1];
195 SetLength(FResTable
, Length(FResTable
)-1);
201 ResCompressed
:= nil;
202 ResCompressedSize
:= 0;
203 CompressBuf(Data
, Len
, ResCompressed
, ResCompressedSize
);
204 if ResCompressed
= nil then Exit
;
205 e_WriteLog('Fuck me (D)', MSG_NOTIFY
);
207 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
208 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
210 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
212 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
213 ResCompressed
, ResCompressedSize
);
214 FreeMemory(ResCompressed
);
216 Inc(FHeader
.RecordsCount
);
220 ResourceName
:= GetResName(Name
);
222 Length
:= ResCompressedSize
;
225 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
230 function TWADEditor_1
.AddAlias(Res
, Alias
: string): Boolean;
237 if FResTable
= nil then Exit
;
240 ares
:= GetResName(Alias
);
241 for a
:= 0 to High(FResTable
) do
242 if FResTable
[a
].ResourceName
= Res
then
250 Inc(FHeader
.RecordsCount
);
252 SetLength(FResTable
, Length(FResTable
)+1);
254 with FResTable
[High(FResTable
)] do
256 ResourceName
:= ares
;
257 Address
:= FResTable
[b
].Address
;
258 Length
:= FResTable
[b
].Length
;
264 function TWADEditor_1
.AddResource(FileName
, Name
, Section
: string): Boolean;
266 ResCompressed
: Pointer;
267 ResCompressedSize
: Integer;
269 TempResource
: Pointer;
270 OriginalSize
: Integer;
275 AssignFile(ResourceFile
, FileName
);
278 Reset(ResourceFile
, 1);
280 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
284 OriginalSize
:= FileSize(ResourceFile
);
285 GetMem(TempResource
, OriginalSize
);
288 BlockRead(ResourceFile
, TempResource
^, OriginalSize
);
290 FLastError
:= DFWAD_ERROR_READWAD
;
291 FreeMemory(TempResource
);
292 CloseFile(ResourceFile
);
296 CloseFile(ResourceFile
);
298 ResCompressed
:= nil;
299 ResCompressedSize
:= 0;
300 CompressBuf(TempResource
, OriginalSize
, ResCompressed
, ResCompressedSize
);
301 FreeMemory(TempResource
);
302 if ResCompressed
= nil then Exit
;
304 SetLength(FResTable
, Length(FResTable
)+1);
308 if Length(FResTable
) > 1 then
309 for a
:= High(FResTable
) downto 1 do
310 FResTable
[a
] := FResTable
[a
-1];
316 Section
:= AnsiUpperCase(Section
);
319 for a
:= 0 to High(FResTable
) do
320 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
322 for b
:= High(FResTable
) downto a
+2 do
323 FResTable
[b
] := FResTable
[b
-1];
331 FreeMemory(ResCompressed
);
332 SetLength(FResTable
, Length(FResTable
)-1);
339 if FResData
= nil then FResData
:= AllocMem(ResCompressedSize
)
340 else ReallocMem(FResData
, FDataSize
+Cardinal(ResCompressedSize
));
342 FDataSize
:= FDataSize
+LongWord(ResCompressedSize
);
343 CopyMemory(Pointer(PChar(FResData
)+FDataSize
-PChar(ResCompressedSize
)),
344 ResCompressed
, ResCompressedSize
);
345 FreeMemory(ResCompressed
);
347 Inc(FHeader
.RecordsCount
);
351 ResourceName
:= GetResName(Name
);
353 Length
:= ResCompressedSize
;
356 FOffset
:= FOffset
+Cardinal(ResCompressedSize
);
361 procedure TWADEditor_1
.AddSection(Name
: string);
363 if Name
= '' then Exit
;
365 Inc(FHeader
.RecordsCount
);
367 SetLength(FResTable
, Length(FResTable
)+1);
368 with FResTable
[High(FResTable
)] do
370 ResourceName
:= GetResName(Name
);
371 Address
:= $00000000;
376 constructor TWADEditor_1
.Create();
382 FHeader
.RecordsCount
:= 0;
384 FWADOpened
:= DFWAD_OPENED_NONE
;
385 FLastError
:= DFWAD_NOERROR
;
386 FVersion
:= DFWAD_VERSION
;
389 procedure TWADEditor_1
.CreateImage();
394 if FWADOpened
= DFWAD_OPENED_NONE
then
396 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
400 if FWADOpened
= DFWAD_OPENED_MEMORY
then Exit
;
402 if FResData
<> nil then FreeMem(FResData
);
405 AssignFile(WADFile
, FFileName
);
408 b
:= 6+SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
);
410 FDataSize
:= LongWord(FileSize(WADFile
))-b
;
412 GetMem(FResData
, FDataSize
);
415 BlockRead(WADFile
, FResData
^, FDataSize
);
419 FOffset
:= FDataSize
;
421 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
426 FLastError
:= DFWAD_NOERROR
;
429 destructor TWADEditor_1
.Destroy();
436 procedure TWADEditor_1
.FreeWAD();
438 if FResData
<> nil then FreeMem(FResData
);
442 FHeader
.RecordsCount
:= 0;
444 FWADOpened
:= DFWAD_OPENED_NONE
;
445 FLastError
:= DFWAD_NOERROR
;
446 FVersion
:= DFWAD_VERSION
;
449 function TWADEditor_1
.GetResName(ResName
: string): Char16
;
451 ZeroMemory(@Result
[0], 16);
452 if ResName
= '' then Exit
;
454 ResName
:= Trim(UpperCase(ResName
));
455 if Length(ResName
) > 16 then SetLength(ResName
, 16);
457 CopyMemory(@Result
[0], @ResName
[1], Length(ResName
));
460 function TWADEditor_1
.HaveResource(Section
, Resource
: string): Boolean;
463 CurrentSection
: string;
467 if FResTable
= nil then Exit
;
469 CurrentSection
:= '';
470 Section
:= AnsiUpperCase(Section
);
471 Resource
:= AnsiUpperCase(Resource
);
473 for a
:= 0 to High(FResTable
) do
475 if FResTable
[a
].Length
= 0 then
477 CurrentSection
:= FResTable
[a
].ResourceName
;
481 if (FResTable
[a
].ResourceName
= Resource
) and
482 (CurrentSection
= Section
) then
490 function TWADEditor_1
.HaveSection(Section
: string): Boolean;
496 if FResTable
= nil then Exit
;
503 Section
:= AnsiUpperCase(Section
);
505 for a
:= 0 to High(FResTable
) do
506 if (FResTable
[a
].Length
= 0) and (FResTable
[a
].ResourceName
= Section
) then
513 function TWADEditor_1
.GetResource(Section
, Resource
: string;
514 var pData
: Pointer; var Len
: Integer): Boolean;
519 CurrentSection
: string;
525 CurrentSection
:= '';
527 if FWADOpened
= DFWAD_OPENED_NONE
then
529 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
533 Section
:= toLowerCase1251(Section
);
534 Resource
:= toLowerCase1251(Resource
);
537 for a
:= 0 to High(FResTable
) do
539 if FResTable
[a
].Length
= 0 then
541 CurrentSection
:= toLowerCase1251(FResTable
[a
].ResourceName
);
545 if (toLowerCase1251(FResTable
[a
].ResourceName
) = Resource
) and
546 (CurrentSection
= Section
) then
555 FLastError
:= DFWAD_ERROR_RESOURCENOTFOUND
;
559 if FWADOpened
= DFWAD_OPENED_FILE
then
562 AssignFile(WADFile
, FFileName
);
565 Seek(WADFile
, FResTable
[i
].Address
+6+
566 LongWord(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
567 TempData
:= GetMemory(FResTable
[i
].Length
);
568 BlockRead(WADFile
, TempData
^, FResTable
[i
].Length
);
569 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
576 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
583 TempData
:= GetMemory(FResTable
[i
].Length
);
584 CopyMemory(TempData
, Pointer(PtrUInt(FResData
)+FResTable
[i
].Address
+6+
585 PtrUInt(SizeOf(TWADHeaderRec_1
)+SizeOf(TResourceTableRec_1
)*Length(FResTable
))),
586 FResTable
[i
].Length
);
587 DecompressBuf(TempData
, FResTable
[i
].Length
, 0, pData
, OutBytes
);
593 FLastError
:= DFWAD_NOERROR
;
597 function TWADEditor_1
.GetResourcesList(Section
: string): SArray
;
600 CurrentSection
: Char16
;
604 if FResTable
= nil then Exit
;
605 if Length(Section
) > 16 then Exit
;
607 CurrentSection
:= '';
609 for a
:= 0 to High(FResTable
) do
611 if FResTable
[a
].Length
= 0 then
613 CurrentSection
:= FResTable
[a
].ResourceName
;
617 if CurrentSection
= Section
then
619 SetLength(Result
, Length(Result
)+1);
620 Result
[High(Result
)] := FResTable
[a
].ResourceName
;
625 function TWADEditor_1
.GetSectionList(): SArray
;
631 if FResTable
= nil then Exit
;
633 if FResTable
[0].Length
<> 0 then
635 SetLength(Result
, 1);
639 for i
:= 0 to High(FResTable
) do
640 if FResTable
[i
].Length
= 0 then
642 SetLength(Result
, Length(Result
)+1);
643 Result
[High(Result
)] := FResTable
[i
].ResourceName
;
647 function TWADEditor_1
.LastErrorString(): string;
650 DFWAD_NOERROR
: Result
:= '';
651 DFWAD_ERROR_WADNOTFOUND
: Result
:= 'DFWAD file not found';
652 DFWAD_ERROR_CANTOPENWAD
: Result
:= 'Can''t open DFWAD file';
653 DFWAD_ERROR_RESOURCENOTFOUND
: Result
:= 'Resource not found';
654 DFWAD_ERROR_FILENOTWAD
: Result
:= 'File is not DFWAD';
655 DFWAD_ERROR_WADNOTLOADED
: Result
:= 'DFWAD file is not loaded';
656 DFWAD_ERROR_READRESOURCE
: Result
:= 'Read resource error';
657 DFWAD_ERROR_READWAD
: Result
:= 'Read DFWAD error';
661 function TWADEditor_1
.ReadFile2(FileName
: string): Boolean;
664 Signature
: array[0..4] of Char;
671 if not FileExists(FileName
) then
673 FLastError
:= DFWAD_ERROR_WADNOTFOUND
;
677 FFileName
:= FileName
;
679 AssignFile(WADFile
, FFileName
);
684 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
689 BlockRead(WADFile
, Signature
, 5);
690 if Signature
<> DFWAD_SIGNATURE
then
692 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
697 BlockRead(WADFile
, FVersion
, 1);
698 if FVersion
<> DFWAD_VERSION
then
700 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
705 BlockRead(WADFile
, FHeader
, SizeOf(TWADHeaderRec_1
));
706 SetLength(FResTable
, FHeader
.RecordsCount
);
707 if FResTable
<> nil then
709 BlockRead(WADFile
, FResTable
[0], SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
711 for a
:= 0 to High(FResTable
) do
712 if FResTable
[a
].Length
<> 0 then
713 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
714 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
719 FLastError
:= DFWAD_ERROR_READWAD
;
724 FWADOpened
:= DFWAD_OPENED_FILE
;
725 FLastError
:= DFWAD_NOERROR
;
729 function TWADEditor_1
.ReadMemory(Data
: Pointer; Len
: LongWord): Boolean;
731 Signature
: array[0..4] of Char;
738 CopyMemory(@Signature
[0], Data
, 5);
739 if Signature
<> DFWAD_SIGNATURE
then
741 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
745 CopyMemory(@FVersion
, Pointer(PtrUInt(Data
)+5), 1);
746 if FVersion
<> DFWAD_VERSION
then
748 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
752 CopyMemory(@FHeader
, Pointer(PtrUInt(Data
)+6), SizeOf(TWADHeaderRec_1
));
754 SetLength(FResTable
, FHeader
.RecordsCount
);
755 if FResTable
<> nil then
757 CopyMemory(@FResTable
[0], Pointer(PtrUInt(Data
)+6+SizeOf(TWADHeaderRec_1
)),
758 SizeOf(TResourceTableRec_1
)*FHeader
.RecordsCount
);
760 for a
:= 0 to High(FResTable
) do
761 if FResTable
[a
].Length
<> 0 then
762 FResTable
[a
].Address
:= FResTable
[a
].Address
-6-(LongWord(SizeOf(TWADHeaderRec_1
)+
763 SizeOf(TResourceTableRec_1
)*Length(FResTable
)));
766 GetMem(FResData
, Len
);
767 CopyMemory(FResData
, Data
, Len
);
769 FWADOpened
:= DFWAD_OPENED_MEMORY
;
770 FLastError
:= DFWAD_NOERROR
;
775 procedure TWADEditor_1
.RemoveResource(Section
, Resource
: string);
778 CurrentSection
: Char16
;
781 if FResTable
= nil then Exit
;
783 e_WriteLog('Fuck me (B) ' + Section
+ ' ' + Resource
, MSG_NOTIFY
);
788 CurrentSection
:= '';
790 for a
:= 0 to High(FResTable
) do
792 if FResTable
[a
].Length
= 0 then
794 CurrentSection
:= FResTable
[a
].ResourceName
;
798 if (FResTable
[a
].ResourceName
= Resource
) and
799 (CurrentSection
= Section
) then
802 b
:= FResTable
[a
].Length
;
803 c
:= FResTable
[a
].Address
;
810 e_WriteLog('Fuck me (C) ' + Section
+ ' ' + Resource
, MSG_NOTIFY
);
812 for a
:= i
to High(FResTable
)-1 do
813 FResTable
[a
] := FResTable
[a
+1];
815 SetLength(FResTable
, Length(FResTable
)-1);
818 for a
:= 0 to High(FResTable
) do
819 if (FResTable
[a
].Length
<> 0) and (FResTable
[a
].Address
> c
) then
821 FResTable
[a
].Address
:= FResTable
[a
].Address
-b
;
822 d
:= d
+FResTable
[a
].Length
;
825 CopyMemory(Pointer(PtrUInt(FResData
)+c
), Pointer(PtrUInt(FResData
)+c
+b
), d
);
827 FDataSize
:= FDataSize
-b
;
828 FOffset
:= FOffset
-b
;
829 ReallocMem(FResData
, FDataSize
);
831 FHeader
.RecordsCount
:= FHeader
.RecordsCount
-1;
834 procedure TWADEditor_1
.SaveTo(FileName
: string);
839 Header
: TWADHeaderRec_1
;
842 sign
:= DFWAD_SIGNATURE
;
843 ver
:= DFWAD_VERSION
;
845 Header
.RecordsCount
:= Length(FResTable
);
847 if FResTable
<> nil then
848 for i
:= 0 to High(FResTable
) do
849 if FResTable
[i
].Length
<> 0 then
850 FResTable
[i
].Address
:= FResTable
[i
].Address
+6+SizeOf(TWADHeaderRec_1
)+
851 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
;
853 AssignFile(WADFile
, FileName
);
855 BlockWrite(WADFile
, sign
[1], 5);
856 BlockWrite(WADFile
, ver
, 1);
857 BlockWrite(WADFile
, Header
, SizeOf(TWADHeaderRec_1
));
858 if FResTable
<> nil then BlockWrite(WADFile
, FResTable
[0],
859 SizeOf(TResourceTableRec_1
)*Header
.RecordsCount
);
860 if FResData
<> nil then BlockWrite(WADFile
, FResData
^, FDataSize
);
864 function TWADEditor_1
.GetLastError
: Integer;
866 Result
:= FLastError
;
869 function TWADEditor_1
.GetLastErrorStr
: String;
871 Result
:= LastErrorString();
874 function TWADEditor_1
.GetResourcesCount
: Word;
876 Result
:= FHeader
.RecordsCount
;
879 function TWADEditor_1
.GetVersion
: Byte;
885 gWADEditorFactory
.RegisterEditor('DFWAD', TWADEditor_1
);