1 {$INCLUDE ../shared/a_modes.inc}
7 uses Classes
, WADEDITOR
;
11 ref
: Integer; // number of links
12 pos
: Int64; // position in source (if pos < 0 -> not in source file)
13 csize
: Int64; // compressed size
14 usize
: Int64; // decompressed size (usize < 0 -> unknown)
15 stream
: TMemoryStream
; // copy of compressed data
25 list
: array of TResource
;
28 PResource
= ^TResource
;
31 TDFWEditor
= class sealed(WADEDITOR
.TWADEditor
)
33 FSection
: array of TSection
;
34 FData
: array of TData
;
39 function FindSectionIDRAW(name
: AnsiString
; caseSensitive
: Boolean): Integer;
40 function FindSectionRAW(name
: AnsiString
; caseSensitive
: Boolean): PSection
;
41 function InsertSectionRAW(name
: AnsiString
): PSection
;
43 function FindSectionID(name
: AnsiString
): Integer;
44 function FindSection(name
: AnsiString
): PSection
;
45 function InsertSection(name
: AnsiString
): PSection
;
47 function FindDataID(pos
: Int64): Integer;
48 function FindData(pos
: Int64): TData
;
49 function InsertData(ref
, pos
, csize
, usize
: Int64; stream
: TMemoryStream
): TData
;
51 function InsertFileInfoS(p
: PSection
; const name
: AnsiString
; pos
, csize
, usize
: Int64; stream
: TMemoryStream
): PResource
;
52 function InsertFileInfo(const section
, name
: AnsiString
; pos
, csize
, usize
: Int64; stream
: TMemoryStream
): PResource
;
53 function Preload(data
: TData
): Boolean;
54 function GetSourceStream(p
: PResource
): TStream
;
58 procedure ReadFromStream(s
: TStream
);
59 procedure SaveToStream(s
: TStream
);
63 destructor Destroy(); override;
64 procedure FreeWAD(); override;
65 function ReadFile2(FileName
: string): Boolean; override;
66 function ReadMemory(Data
: Pointer; Len
: LongWord
): Boolean; override;
67 procedure CreateImage(); override;
68 function AddResource(Data
: Pointer; Len
: LongWord
; Name
, Section
: String): Boolean; override; overload
;
69 function AddResource(FileName
, Name
, Section
: String): Boolean; override; overload
;
70 function AddAlias(Res
, Alias
: String): Boolean; override;
71 procedure AddSection(Name
: String); override;
72 procedure RemoveResource(Section
, Resource
: String); override;
73 procedure SaveTo(FileName
: String); override;
74 function HaveResource(Section
, Resource
: String): Boolean; override;
75 function HaveSection(Section
: string): Boolean; override;
76 function GetResource(Section
, Resource
: String; var pData
: Pointer; var Len
: Integer): Boolean; override;
77 function GetSectionList(): SArray
; override;
78 function GetResourcesList(Section
: String): SArray
; override;
80 function GetLastError
: Integer; override;
81 function GetLastErrorStr
: String; override;
82 function GetResourcesCount
: Word; override;
83 function GetVersion
: Byte; override;
88 uses SysUtils
, StrUtils
, DateUtils
, Math
, utils
, zstream
, crc
, e_log
;
90 function PrepString(const s
: AnsiString
; caseSensitive
, extSensitive
: Boolean): AnsiString
; inline;
94 if caseSensitive
= False then
96 Result
:= UpperCase(Result
);
98 if extSensitive
= False then
100 i
:= Pos('.', Result
); // fix dotfiles
102 SetLength(Result
, i
- 1);
106 function FindResourceIDRAW(p
: PSection
; name
: AnsiString
; caseSensitive
, extSensitive
: Boolean): Integer;
107 var i
: Integer; pname
: AnsiString
;
111 pname
:= PrepString(name
, caseSensitive
, extSensitive
);
112 for i
:= 0 to High(p
.list
) do
114 if PrepString(p
.list
[i
].name
, caseSensitive
, extSensitive
) = pname
then
124 function FindResourceID(p
: PSection
; name
: AnsiString
): Integer;
127 i
:= FindResourceIDRAW(p
, name
, True, True); // CaSeNaMe.Ext
130 i
:= FindResourceIDRAW(p
, name
, False, True); // CASENAME.EXT
133 i
:= FindResourceIDRAW(p
, name
, True, False); // CaSeNaMe
136 i
:= FindResourceIDRAW(p
, name
, False, False); // CASENAME
143 function FindResource(p
: PSection
; name
: AnsiString
): PResource
;
146 i
:= FindResourceID(p
, name
);
147 if i
>= 0 then Result
:= @p
.list
[i
] else Result
:= nil;
152 function TDFWEditor
.FindSectionIDRAW(name
: AnsiString
; caseSensitive
: Boolean): Integer;
153 var i
: Integer; pname
: AnsiString
;
155 if FSection
<> nil then
157 pname
:= PrepString(name
, caseSensitive
, True);
158 for i
:= 0 to High(FSection
) do
160 if PrepString(FSection
[i
].name
, caseSensitive
, True) = pname
then
170 function TDFWEditor
.FindSectionRAW(name
: AnsiString
; caseSensitive
: Boolean): PSection
;
173 i
:= FindSectionIDRAW(name
, caseSensitive
);
174 if i
>= 0 then Result
:= @FSection
[i
] else Result
:= nil;
177 function TDFWEditor
.InsertSectionRAW(name
: AnsiString
): PSection
;
180 if FSection
= nil then i
:= 0 else i
:= Length(FSection
);
181 SetLength(FSection
, i
+ 1);
182 FSection
[i
] := Default(TSection
);
183 FSection
[i
].name
:= name
;
184 Result
:= @FSection
[i
];
189 function TDFWEditor
.FindSectionID(name
: AnsiString
): Integer;
190 var fixName
: AnsiString
;
192 fixName
:= StringReplace(name
, '\', '/', [rfReplaceAll
], TStringReplaceAlgorithm
.sraManySmall
);
193 Result
:= FindSectionIDRAW(fixName
, True); // CaSeNaMe
195 Result
:= FindSectionIDRAW(fixName
, False); // CASENAME
198 function TDFWEditor
.FindSection(name
: AnsiString
): PSection
;
199 var fixName
: AnsiString
;
201 fixName
:= StringReplace(name
, '\', '/', [rfReplaceAll
], TStringReplaceAlgorithm
.sraManySmall
);
202 Result
:= FindSectionRAW(fixName
, True); // CaSeNaMe
204 Result
:= FindSectionRAW(fixName
, False); // CASENAME
207 function TDFWEditor
.InsertSection(name
: AnsiString
): PSection
;
209 Result
:= FindSection(name
);
211 Result
:= InsertSectionRAW(name
);
216 function TDFWEditor
.FindDataID(pos
: Int64): Integer;
219 if (pos
>= 0) and (FData
<> nil) then
221 for i
:= 0 to High(FData
) do
223 if FData
[i
].pos
= pos
then
233 function TDFWEditor
.FindData(pos
: Int64): TData
;
236 i
:= FindDataID(pos
);
237 if i
>= 0 then Result
:= FData
[i
] else Result
:= nil;
240 function TDFWEditor
.InsertData(ref
, pos
, csize
, usize
: Int64; stream
: TMemoryStream
): TData
;
241 var i
: Integer; data
: TData
;
243 data
:= TData
.Create();
248 data
.stream
:= stream
;
250 if FData
= nil then i
:= 0 else i
:= Length(FData
);
251 SetLength(FData
, i
+ 1);
258 function TDFWEditor
.InsertFileInfoS(p
: PSection
; const name
: AnsiString
; pos
, csize
, usize
: Int64; stream
: TMemoryStream
): PResource
;
259 var i
: Integer; data
: TData
;
265 data
:= FindData(pos
);
267 data
:= InsertData(0, pos
, csize
, usize
, stream
);
269 if p
.list
= nil then i
:= 0 else i
:= Length(p
.list
);
270 SetLength(p
.list
, i
+ 1);
272 p
.list
[i
] := Default(TResource
);
273 p
.list
[i
].name
:= name
;
274 p
.list
[i
].data
:= data
;
275 Result
:= @p
.list
[i
];
278 function TDFWEditor
.InsertFileInfo(const section
, name
: AnsiString
; pos
, csize
, usize
: Int64; stream
: TMemoryStream
): PResource
;
281 p
:= FindSectionRAW(section
, True);
283 p
:= InsertSectionRAW(section
);
285 Result
:= InsertFileInfoS(p
, name
, pos
, csize
, usize
, stream
);
290 function TDFWEditor
.AddAlias(Res
, Alias
: String): Boolean;
292 // New hard-links are not supported
293 // However, they never created by editor
297 function TDFWEditor
.AddResource(Data
: Pointer; Len
: LongWord
; Name
, Section
: String): Boolean;
298 const level
: TCompressionLevel
= TCompressionLevel
.clMax
;
299 var s
: TMemoryStream
; cs
: TCompressionStream
; p
: PResource
;
301 Name
:= win2utf(Name
);
302 Section
:= win2utf(Section
);
306 s
:= TMemoryStream
.Create();
308 cs
:= TCompressionStream
.Create(level
, s
, False);
310 cs
.WriteBuffer(PByte(Data
)[0], Len
);
315 p
:= InsertFileInfo(Section
, Name
, -1, s
.Size
, Len
, s
);
324 function TDFWEditor
.AddResource(FileName
, Name
, Section
: String): Boolean;
325 var s
: TFileStream
; ptr
: PByte
;
328 FLastError
:= DFWAD_ERROR_READWAD
;
330 s
:= TFileStream
.Create(FileName
, fmOpenRead
or fmShareDenyWrite
);
334 s
.ReadBuffer(ptr
[0], s
.Size
);
335 Result
:= AddResource(ptr
, s
.Size
, Name
, Section
);
336 if Result
= True then FLastError
:= DFWAD_NOERROR
;
346 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
347 e_WriteLog('DFWAD: AddResource: failed to open file ' + FileName
, MSG_NOTIFY
);
348 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
353 constructor TDFWEditor
.Create();
358 FLastError
:= DFWAD_NOERROR
;
363 destructor TDFWEditor
.Destroy();
369 procedure TDFWEditor
.Clear();
372 if FSection
<> nil then
374 for i
:= 0 to High(FSection
) do
375 if FSection
[i
].list
<> nil then
376 SetLength(FSection
[i
].list
, 0);
377 SetLength(FSection
, 0);
381 for i
:= 0 to High(FData
) do
383 if FData
[i
] <> nil then
385 if FData
[i
].stream
<> nil then
386 FreeAndNil(FData
[i
].stream
);
387 FreeAndNil(FData
[i
]);
392 if FStream
<> nil then
396 procedure TDFWEditor
.FreeWAD();
399 FLastError
:= DFWAD_NOERROR
;
403 function TDFWEditor
.Preload(data
: TData
): Boolean;
404 var s
: TMemoryStream
;
409 Result
:= data
.stream
<> nil;
410 if (data
.stream
= nil) and (FStream
<> nil) then
412 s
:= TMemoryStream
.Create();
414 if data
.csize
> 0 then
416 FStream
.Seek(data
.pos
, TSeekOrigin
.soBeginning
);
417 s
.CopyFrom(FStream
, data
.csize
);
419 Assert(s
.Size
= data
.csize
); // wtf, random size if copied zero bytes!
429 procedure TDFWEditor
.CreateImage();
432 if FStream
= nil then
434 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
435 e_WriteLog('DFWAD: CreateImage: File not assigned', MSG_NOTIFY
);
436 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
438 else if FStream
is TMemoryStream
then
440 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
441 e_WriteLog('DFWAD: CreateImage: Memory stream', MSG_NOTIFY
);
442 FLastError
:= DFWAD_NOERROR
;
446 if FSection
<> nil then
448 for i
:= 0 to High(FData
) do
450 if Preload(FData
[i
]) = False then
452 if gWADEditorLogLevel
>= DFWAD_LOG_WARN
then
453 e_WriteLog('DFWAD: CreateImage: failed to preload resource data #' + IntToStr(i
), MSG_WARNING
);
454 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
461 FLastError
:= DFWAD_NOERROR
;
465 procedure TDFWEditor
.AddSection(Name
: String);
467 Name
:= win2utf(Name
);
468 if InsertSection(Name
) = nil then
469 raise Exception
.Create('DFWAD: AddSection[' + Name
+ ']: failed to insert');
472 function TDFWEditor
.HaveResource(Section
, Resource
: String): Boolean;
474 Section
:= win2utf(Section
);
475 Resource
:= win2utf(Resource
);
476 Result
:= FindResource(FindSection(Section
), Resource
) <> nil;
479 function TDFWEditor
.HaveSection(Section
: String): Boolean;
481 Section
:= win2utf(Section
);
482 Result
:= FindSection(Section
) <> nil;
485 function TDFWEditor
.GetSourceStream(p
: PResource
): TStream
;
489 if p
.data
.stream
<> nil then
491 src
:= p
.data
.stream
;
492 src
.Seek(0, TSeekOrigin
.soBeginning
);
494 else if (p
.data
.pos
>= 0) and (FStream
<> nil) then
497 src
.Seek(p
.data
.pos
, TSeekOrigin
.soBeginning
);
502 function TDFWEditor
.GetResource(Section
, Resource
: String; var pData
: Pointer; var Len
: Integer): Boolean;
503 const BLOCK_STEP
= 4096;
504 var p
: PResource
; src
: TStream
; tmp
: TDecompressionStream
; ptr
: PByte
; size
, r
: Int64;
506 Section
:= win2utf(Section
);
507 Resource
:= win2utf(Resource
);
508 FLastError
:= DFWAD_ERROR_CANTOPENWAD
;
512 p
:= FindResource(FindSection(Section
), Resource
);
515 src
:= GetSourceStream(p
);
519 tmp
:= TDecompressionStream
.Create(src
, False);
521 if p
.data
.usize
< 0 then
524 GetMem(ptr
, BLOCK_STEP
);
527 r
:= tmp
.Read(ptr
[size
], BLOCK_STEP
);
530 ReallocMem(ptr
, size
+ BLOCK_STEP
);
532 ReallocMem(ptr
, size
);
533 p
.data
.usize
:= size
; // cache size
537 FLastError
:= DFWAD_NOERROR
;
545 GetMem(ptr
, p
.data
.usize
);
547 tmp
.ReadBuffer(ptr
[0], p
.data
.usize
);
551 FLastError
:= DFWAD_NOERROR
;
561 on e
: EStreamError
do
563 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
564 e_WriteLog('DFWAD: Failed to decompress DEFLATEd data, reason: ' + e
.Message, MSG_WARNING
);
571 if gWADEditorLogLevel
>= DFWAD_LOG_WARN
then
572 e_WriteLog('DFWAD: No available source for file data', MSG_WARNING
);
573 FLastError
:= DFWAD_ERROR_WADNOTLOADED
;
578 if gWADEditorLogLevel
>= DFWAD_LOG_DEBUG
then
579 e_WriteLog('DFWAD: Resource not found', MSG_NOTIFY
);
580 FLastError
:= DFWAD_ERROR_RESOURCENOTFOUND
;
584 function TDFWEditor
.GetResourcesList(Section
: String): SArray
;
585 var p
: PSection
; i
: Integer;
587 Section
:= win2utf(Section
);
589 p
:= FindSection(Section
);
590 if (p
<> nil) and (p
.list
<> nil) then
592 SetLength(Result
, Length(p
.list
));
593 for i
:= 0 to High(p
.list
) do
595 Result
[i
] := utf2win(p
.list
[i
].name
);
600 function TDFWEditor
.GetSectionList(): SArray
;
604 if FSection
<> nil then
606 SetLength(Result
, Length(FSection
));
607 for i
:= 0 to High(FSection
) do
609 Result
[i
] := utf2win(FSection
[i
].name
);
614 procedure TDFWEditor
.ReadFromStream(s
: TStream
);
615 var sig
: packed array [0..4] of Char;
616 var ver
: UInt8
; nrec
: UInt16
; offset
, csize
: UInt32
;
617 var name1251
: packed array [0..16] of Char;
618 var section
, name
: AnsiString
;
623 s
.ReadBuffer(sig
[0], 5);
624 if sig
= 'DFWAD' then
629 nrec
:= LEtoN(s
.ReadWord());
632 for i
:= 0 to nrec
- 1 do
634 s
.ReadBuffer(name1251
[0], 16);
636 name
:= win2utf(PChar(@name1251
[0]));
637 offset
:= LEtoN(s
.ReadDWord());
638 csize
:= LEtoN(s
.ReadDWord());
642 sec
:= InsertSectionRAW(section
);
644 raise Exception
.Create('Failed to register section [' + section
+ ']');
649 sec
:= InsertSectionRAW('');
651 raise Exception
.Create('Failed to create root section');
652 res
:= InsertFileInfoS(sec
, name
, offset
, csize
, -1, nil);
654 raise Exception
.Create('Failed to register resource [' + section
+ '][' + name
+ ']');
655 if res
.data
.csize
<> csize
then
656 raise Exception
.Create('Invalid compressed size for [' + section
+ '][' + name
+ '] (corrupted archive?)');
662 FLastError
:= DFWAD_ERROR_WRONGVERSION
;
663 raise Exception
.Create('Unsupported DFWAD version ' + IntToStr(ver
) + ' (expected 1)');
668 FLastError
:= DFWAD_ERROR_FILENOTWAD
;
669 raise Exception
.Create('Not DFWAD file');
673 function TDFWEditor
.ReadFile2(FileName
: String): Boolean;
679 s
:= TFileStream
.Create(FileName
, fmOpenRead
or fmShareDenyWrite
);
683 FLastError
:= DFWAD_NOERROR
;
692 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
693 e_WriteLog('DFWAD: Failed to open file ' + FileName
+ ', reason: ' + e
.Message, MSG_WARNING
);
694 if FileExists(FileName
) then
695 FLastError
:= DFWAD_ERROR_CANTOPENWAD
697 FLastError
:= DFWAD_ERROR_WADNOTFOUND
;
701 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
702 e_WriteLog('DFWAD: Failed to read DFWAD from file ' + FileName
+ ', reason: ' + e
.Message, MSG_WARNING
);
708 function TDFWEditor
.ReadMemory(Data
: Pointer; Len
: LongWord
): Boolean;
709 var s
: TMemoryStream
;
714 s
:= TMemoryStream
.Create
;
717 s
.WriteBuffer(PByte(Data
)[0], Len
);
718 s
.Seek(0, soBeginning
);
721 FLastError
:= DFWAD_NOERROR
;
730 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
731 e_WriteLog('DFWAD: Failed to read DFWAD from memory, reason: ' + e
.Message, MSG_WARNING
);
737 procedure TDFWEditor
.Collect();
743 for i
:= 0 to High(FData
) do
745 if FData
[i
] <> nil then
747 if FData
[i
].ref
> 0 then
749 FData
[n
] := FData
[i
];
754 if FData
[i
].stream
<> nil then
755 FreeAndNil(FData
[i
].stream
);
756 FreeAndNil(FData
[i
]);
764 procedure TDFWEditor
.RemoveResource(Section
, Resource
: String);
765 var p
: PSection
; i
: Integer; data
: TData
;
767 Section
:= win2utf(Section
);
768 Resource
:= win2utf(Resource
);
769 p
:= FindSection(Section
);
770 i
:= FindResourceID(p
, Resource
);
773 data
:= p
.list
[i
].data
;
774 for i
:= i
+ 1 to High(p
.list
) do
776 p
.list
[i
- 1] := p
.list
[i
];
778 SetLength(p
.list
, High(p
.list
));
780 if data
.ref
<= 0 then
785 procedure TDFWEditor
.SaveToStream(s
: TStream
);
786 type TName16
= packed array [0..16] of Char;
788 var name1251
: TName16
;
793 function GetOffset(data
: TData
): UInt32
;
797 Result
:= 6 + 2 + count
* 24;
798 for i
:= 0 to High(FData
) do
800 if FData
[i
] = data
then
802 if FData
[i
] <> nil then
803 Result
:= Result
+ FData
[i
].csize
;
805 raise Exception
.Create('Failed to calculate offset (BUG!)');
809 count
:= GetResourcesCount();
810 s
.WriteBuffer('DFWAD', 5);
812 WriteInt(s
, UInt16(count
));
813 if FSection
<> nil then
815 for i
:= 0 to High(FSection
) do
817 if (i
<> 0) or (FSection
[i
].name
<> '') then
819 name1251
:= Default(TName16
);
820 name1251
:= utf2win(FSection
[i
].name
);
821 s
.WriteBuffer(name1251
[0], 16);
822 WriteInt(s
, UInt32(0));
823 WriteInt(s
, UInt32(0));
825 if FSection
[i
].list
<> nil then
827 for j
:= 0 to High(FSection
[i
].list
) do
829 p
:= @FSection
[i
].list
[j
];
830 name1251
:= Default(TName16
);
831 name1251
:= utf2win(p
.name
);
832 s
.WriteBuffer(name1251
[0], 16);
833 WriteInt(s
, UInt32(GetOffset(p
.data
)));
834 WriteInt(s
, UInt32(p
.data
.csize
));
840 for i
:= 0 to High(FData
) do
845 Assert(s
.Position
= GetOffset(data
));
846 if data
.stream
<> nil then
848 Assert(data
.stream
.Size
= data
.csize
);
849 data
.stream
.SaveToStream(s
);
851 else if (data
.pos
>= 0) and (FStream
<> nil) then
853 FStream
.Seek(data
.pos
, TSeekOrigin
.soBeginning
);
854 s
.CopyFrom(FStream
, data
.csize
);
858 raise Exception
.Create('No data source available (somethig very wrong)');
866 procedure TDFWEditor
.SaveTo(FileName
: String);
870 s
:= TFileStream
.Create(FileName
, fmCreate
);
879 if gWADEditorLogLevel
>= DFWAD_LOG_INFO
then
880 e_WriteLog('DFWAD: Failed to create file ' + FileName
+ ', reason: ' + e
.Message, MSG_WARNING
);
886 function TDFWEditor
.GetLastError
: Integer;
888 Result
:= FLastError
;
891 function TDFWEditor
.GetLastErrorStr
: String;
894 DFWAD_NOERROR
: Result
:= '';
895 DFWAD_ERROR_WADNOTFOUND
: Result
:= 'DFWAD file not found';
896 DFWAD_ERROR_CANTOPENWAD
: Result
:= 'Can''t open DFWAD file';
897 DFWAD_ERROR_RESOURCENOTFOUND
: Result
:= 'Resource not found';
898 DFWAD_ERROR_FILENOTWAD
: Result
:= 'File is not DFWAD';
899 DFWAD_ERROR_WADNOTLOADED
: Result
:= 'DFWAD file is not loaded';
900 DFWAD_ERROR_READRESOURCE
: Result
:= 'Read resource error';
901 DFWAD_ERROR_READWAD
: Result
:= 'Read DFWAD error';
902 otherwise Result
:= IntToStr(FLastError
);
906 function TDFWEditor
.GetResourcesCount
: Word;
910 if FSection
<> nil then
912 Result
:= Result
+ Length(FSection
);
913 for i
:= 0 to High(FSection
) do
914 if FSection
[i
].list
<> nil then
915 Result
:= Result
+ Length(FSection
[i
].list
);
916 if FSection
[0].name
= '' then
917 Dec(Result
); // First root section not counted
921 function TDFWEditor
.GetVersion
: Byte;
927 gWADEditorFactory
.RegisterEditor('DFWAD', TDFWEditor
);