DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


b98b1596a5d89a594cfbf7d3d73cd38281e5142a
[d2df-sdl.git] / src / shared / WADEDITOR.pas
1 unit WADEDITOR;
2
3 {
4 -----------------------------------
5 WADEDITOR.PAS ÂÅÐÑÈß ÎÒ 26.08.08
6
7 Ïîääåðæêà âàäîâ âåðñèè 1
8 -----------------------------------
9 }
10
11 interface
12
13 uses WADSTRUCT;
14
15 type
16 SArray = array of ShortString;
17
18 TWADEditor_1 = class(TObject)
19 private
20 FResData: Pointer;
21 FResTable: packed array of TResourceTableRec_1;
22 FHeader: TWADHeaderRec_1;
23 FDataSize: LongWord;
24 FOffset: LongWord;
25 FFileName: string;
26 FWADOpened: Byte;
27 FLastError: Integer;
28 FVersion: Byte;
29 function LastErrorString(): string;
30 function GetResName(ResName: string): Char16;
31 public
32 constructor Create();
33 destructor Destroy(); override;
34 procedure FreeWAD();
35 function ReadFile(FileName: string): Boolean;
36 function ReadMemory(Data: Pointer; Len: LongWord): Boolean;
37 function HaveResource(Section, Resource: string): Boolean;
38 function HaveSection(Section: string): Boolean;
39 function GetResource(Section, Resource: string; var pData: Pointer;
40 var Len: Integer): Boolean;
41 function GetSectionList(): SArray;
42 function GetResourcesList(Section: string): SArray;
43
44 property GetLastError: Integer read FLastError;
45 property GetLastErrorStr: string read LastErrorString;
46 property GetResourcesCount: Word read FHeader.RecordsCount;
47 property GetVersion: Byte read FVersion;
48 end;
49
50 const
51 DFWAD_NOERROR = 0;
52 DFWAD_ERROR_WADNOTFOUND = -1;
53 DFWAD_ERROR_CANTOPENWAD = -2;
54 DFWAD_ERROR_RESOURCENOTFOUND = -3;
55 DFWAD_ERROR_FILENOTWAD = -4;
56 DFWAD_ERROR_WADNOTLOADED = -5;
57 DFWAD_ERROR_READRESOURCE = -6;
58 DFWAD_ERROR_READWAD = -7;
59 DFWAD_ERROR_WRONGVERSION = -8;
60
61
62 procedure g_ProcessResourceStr(ResourceStr: String; var FileName,
63 SectionName, ResourceName: String); overload;
64 procedure g_ProcessResourceStr(ResourceStr: String; FileName,
65 SectionName, ResourceName: PString); overload;
66
67 implementation
68
69 uses
70 SysUtils, BinEditor, ZLib;
71
72 const
73 DFWAD_OPENED_NONE = 0;
74 DFWAD_OPENED_FILE = 1;
75 DFWAD_OPENED_MEMORY = 2;
76
77 procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
78 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
79 var
80 strm: TZStreamRec;
81 P: Pointer;
82 BufInc: Integer;
83 begin
84 FillChar(strm, sizeof(strm), 0);
85 BufInc := (InBytes + 255) and not 255;
86 if OutEstimate = 0 then
87 OutBytes := BufInc
88 else
89 OutBytes := OutEstimate;
90 GetMem(OutBuf, OutBytes);
91 try
92 strm.next_in := InBuf;
93 strm.avail_in := InBytes;
94 strm.next_out := OutBuf;
95 strm.avail_out := OutBytes;
96 inflateInit_(strm, zlib_version, sizeof(strm));
97 try
98 while inflate(strm, Z_FINISH) <> Z_STREAM_END do
99 begin
100 P := OutBuf;
101 Inc(OutBytes, BufInc);
102 ReallocMem(OutBuf, OutBytes);
103 strm.next_out := PByteF(PChar(OutBuf) + (PChar(strm.next_out) - PChar(P)));
104 strm.avail_out := BufInc;
105 end;
106 finally
107 inflateEnd(strm);
108 end;
109 ReallocMem(OutBuf, strm.total_out);
110 OutBytes := strm.total_out;
111 except
112 FreeMem(OutBuf);
113 raise
114 end;
115 end;
116
117 procedure g_ProcessResourceStr(ResourceStr: String; var FileName,
118 SectionName, ResourceName: String);
119 var
120 a, i: Integer;
121
122 begin
123 for i := Length(ResourceStr) downto 1 do
124 if ResourceStr[i] = ':' then
125 Break;
126
127 FileName := Copy(ResourceStr, 1, i-1);
128
129 for a := i+1 to Length(ResourceStr) do
130 if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
131
132 ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
133 SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2);
134 end;
135
136 procedure g_ProcessResourceStr(ResourceStr: AnsiString; FileName,
137 SectionName, ResourceName: PAnsiString);
138 var
139 a, i, l1, l2: Integer;
140
141 begin
142 for i := Length(ResourceStr) downto 1 do
143 if ResourceStr[i] = ':' then
144 Break;
145
146 if FileName <> nil then
147 begin
148 FileName^ := Copy(ResourceStr, 1, i-1);
149 l1 := Length(FileName^);
150 end
151 else
152 l1 := 0;
153
154 for a := i+1 to Length(ResourceStr) do
155 if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
156
157 if ResourceName <> nil then
158 begin
159 ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
160 l2 := Length(ResourceName^);
161 end
162 else
163 l2 := 0;
164
165 if SectionName <> nil then
166 SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2);
167 end;
168
169
170 { TWADEditor_1 }
171
172 constructor TWADEditor_1.Create();
173 begin
174 FResData := nil;
175 FResTable := nil;
176 FDataSize := 0;
177 FOffset := 0;
178 FHeader.RecordsCount := 0;
179 FFileName := '';
180 FWADOpened := DFWAD_OPENED_NONE;
181 FLastError := DFWAD_NOERROR;
182 FVersion := DFWAD_VERSION;
183 end;
184
185 destructor TWADEditor_1.Destroy();
186 begin
187 FreeWAD();
188
189 inherited;
190 end;
191
192 procedure TWADEditor_1.FreeWAD();
193 begin
194 if FResData <> nil then FreeMem(FResData);
195 FResTable := nil;
196 FDataSize := 0;
197 FOffset := 0;
198 FHeader.RecordsCount := 0;
199 FFileName := '';
200 FWADOpened := DFWAD_OPENED_NONE;
201 FLastError := DFWAD_NOERROR;
202 FVersion := DFWAD_VERSION;
203 end;
204
205 function TWADEditor_1.GetResName(ResName: string): Char16;
206 begin
207 ZeroMemory(@Result[0], 16);
208 if ResName = '' then Exit;
209
210 ResName := Trim(UpperCase(ResName));
211 if Length(ResName) > 16 then SetLength(ResName, 16);
212
213 CopyMemory(@Result[0], @ResName[1], Length(ResName));
214 end;
215
216 function TWADEditor_1.HaveResource(Section, Resource: string): Boolean;
217 var
218 a: Integer;
219 CurrentSection: string;
220 begin
221 Result := False;
222
223 if FResTable = nil then Exit;
224
225 CurrentSection := '';
226 Section := AnsiUpperCase(Section);
227 Resource := AnsiUpperCase(Resource);
228
229 for a := 0 to High(FResTable) do
230 begin
231 if FResTable[a].Length = 0 then
232 begin
233 CurrentSection := FResTable[a].ResourceName;
234 Continue;
235 end;
236
237 if (FResTable[a].ResourceName = Resource) and
238 (CurrentSection = Section) then
239 begin
240 Result := True;
241 Break;
242 end;
243 end;
244 end;
245
246 function TWADEditor_1.HaveSection(Section: string): Boolean;
247 var
248 a: Integer;
249 begin
250 Result := False;
251
252 if FResTable = nil then Exit;
253 if Section = '' then
254 begin
255 Result := True;
256 Exit;
257 end;
258
259 Section := AnsiUpperCase(Section);
260
261 for a := 0 to High(FResTable) do
262 if (FResTable[a].Length = 0) and (FResTable[a].ResourceName = Section) then
263 begin
264 Result := True;
265 Exit;
266 end;
267 end;
268
269 function TWADEditor_1.GetResource(Section, Resource: string;
270 var pData: Pointer; var Len: Integer): Boolean;
271 var
272 a: LongWord;
273 i: Integer;
274 WADFile: File;
275 CurrentSection: string;
276 TempData: Pointer;
277 OutBytes: Integer;
278 begin
279 Result := False;
280
281 CurrentSection := '';
282
283 if FWADOpened = DFWAD_OPENED_NONE then
284 begin
285 FLastError := DFWAD_ERROR_WADNOTLOADED;
286 Exit;
287 end;
288
289 Section := UpperCase(Section);
290 Resource := UpperCase(Resource);
291
292 i := -1;
293 for a := 0 to High(FResTable) do
294 begin
295 if FResTable[a].Length = 0 then
296 begin
297 CurrentSection := FResTable[a].ResourceName;
298 Continue;
299 end;
300
301 if (FResTable[a].ResourceName = Resource) and
302 (CurrentSection = Section) then
303 begin
304 i := a;
305 Break;
306 end;
307 end;
308
309 if i = -1 then
310 begin
311 FLastError := DFWAD_ERROR_RESOURCENOTFOUND;
312 Exit;
313 end;
314
315 if FWADOpened = DFWAD_OPENED_FILE then
316 begin
317 try
318 AssignFile(WADFile, FFileName);
319 Reset(WADFile, 1);
320
321 Seek(WADFile, FResTable[i].Address+6+
322 LongWord(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable)));
323 TempData := GetMemory(FResTable[i].Length);
324 BlockRead(WADFile, TempData^, FResTable[i].Length);
325 DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes);
326 FreeMem(TempData);
327
328 Len := OutBytes;
329
330 CloseFile(WADFile);
331 except
332 FLastError := DFWAD_ERROR_CANTOPENWAD;
333 CloseFile(WADFile);
334 Exit;
335 end;
336 end
337 else
338 begin
339 TempData := GetMemory(FResTable[i].Length);
340 CopyMemory(TempData, Pointer(LongWord(FResData)+FResTable[i].Address+6+
341 LongWord(SizeOf(TWADHeaderRec_1)+SizeOf(TResourceTableRec_1)*Length(FResTable))),
342 FResTable[i].Length);
343 DecompressBuf(TempData, FResTable[i].Length, 0, pData, OutBytes);
344 FreeMem(TempData);
345
346 Len := OutBytes;
347 end;
348
349 FLastError := DFWAD_NOERROR;
350 Result := True;
351 end;
352
353 function TWADEditor_1.GetResourcesList(Section: string): SArray;
354 var
355 a: Integer;
356 CurrentSection: Char16;
357 begin
358 Result := nil;
359
360 if FResTable = nil then Exit;
361 if Length(Section) > 16 then Exit;
362
363 CurrentSection := '';
364
365 for a := 0 to High(FResTable) do
366 begin
367 if FResTable[a].Length = 0 then
368 begin
369 CurrentSection := FResTable[a].ResourceName;
370 Continue;
371 end;
372
373 if CurrentSection = Section then
374 begin
375 SetLength(Result, Length(Result)+1);
376 Result[High(Result)] := FResTable[a].ResourceName;
377 end;
378 end;
379 end;
380
381 function TWADEditor_1.GetSectionList(): SArray;
382 var
383 i: DWORD;
384 begin
385 Result := nil;
386
387 if FResTable = nil then Exit;
388
389 if FResTable[0].Length <> 0 then
390 begin
391 SetLength(Result, 1);
392 Result[0] := '';
393 end;
394
395 for i := 0 to High(FResTable) do
396 if FResTable[i].Length = 0 then
397 begin
398 SetLength(Result, Length(Result)+1);
399 Result[High(Result)] := FResTable[i].ResourceName;
400 end;
401 end;
402
403 function TWADEditor_1.LastErrorString(): string;
404 begin
405 case FLastError of
406 DFWAD_NOERROR: Result := '';
407 DFWAD_ERROR_WADNOTFOUND: Result := 'DFWAD file not found';
408 DFWAD_ERROR_CANTOPENWAD: Result := 'Can''t open DFWAD file';
409 DFWAD_ERROR_RESOURCENOTFOUND: Result := 'Resource not found';
410 DFWAD_ERROR_FILENOTWAD: Result := 'File is not DFWAD';
411 DFWAD_ERROR_WADNOTLOADED: Result := 'DFWAD file is not loaded';
412 DFWAD_ERROR_READRESOURCE: Result := 'Read resource error';
413 DFWAD_ERROR_READWAD: Result := 'Read DFWAD error';
414 else Result := 'Unknown DFWAD error';
415 end;
416 end;
417
418 function TWADEditor_1.ReadFile(FileName: string): Boolean;
419 var
420 WADFile: File;
421 Signature: array[0..4] of Char;
422 a: Integer;
423 begin
424 FreeWAD();
425
426 Result := False;
427
428 if not FileExists(FileName) then
429 begin
430 FLastError := DFWAD_ERROR_WADNOTFOUND;
431 Exit;
432 end;
433
434 FFileName := FileName;
435
436 AssignFile(WADFile, FFileName);
437
438 try
439 Reset(WADFile, 1);
440 except
441 FLastError := DFWAD_ERROR_CANTOPENWAD;
442 Exit;
443 end;
444
445 try
446 BlockRead(WADFile, Signature, 5);
447 if Signature <> DFWAD_SIGNATURE then
448 begin
449 FLastError := DFWAD_ERROR_FILENOTWAD;
450 CloseFile(WADFile);
451 Exit;
452 end;
453
454 BlockRead(WADFile, FVersion, 1);
455 if FVersion <> DFWAD_VERSION then
456 begin
457 FLastError := DFWAD_ERROR_WRONGVERSION;
458 CloseFile(WADFile);
459 Exit;
460 end;
461
462 BlockRead(WADFile, FHeader, SizeOf(TWADHeaderRec_1));
463 SetLength(FResTable, FHeader.RecordsCount);
464 if FResTable <> nil then
465 begin
466 BlockRead(WADFile, FResTable[0], SizeOf(TResourceTableRec_1)*FHeader.RecordsCount);
467
468 for a := 0 to High(FResTable) do
469 if FResTable[a].Length <> 0 then
470 FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+
471 SizeOf(TResourceTableRec_1)*Length(FResTable)));
472 end;
473
474 CloseFile(WADFile);
475 except
476 FLastError := DFWAD_ERROR_READWAD;
477 CloseFile(WADFile);
478 Exit;
479 end;
480
481 FWADOpened := DFWAD_OPENED_FILE;
482 FLastError := DFWAD_NOERROR;
483 Result := True;
484 end;
485
486 function TWADEditor_1.ReadMemory(Data: Pointer; Len: LongWord): Boolean;
487 var
488 Signature: array[0..4] of Char;
489 a: Integer;
490 begin
491 FreeWAD();
492
493 Result := False;
494
495 CopyMemory(@Signature[0], Data, 5);
496 if Signature <> DFWAD_SIGNATURE then
497 begin
498 FLastError := DFWAD_ERROR_FILENOTWAD;
499 Exit;
500 end;
501
502 CopyMemory(@FVersion, Pointer(LongWord(Data)+5), 1);
503 if FVersion <> DFWAD_VERSION then
504 begin
505 FLastError := DFWAD_ERROR_WRONGVERSION;
506 Exit;
507 end;
508
509 CopyMemory(@FHeader, Pointer(LongWord(Data)+6), SizeOf(TWADHeaderRec_1));
510
511 SetLength(FResTable, FHeader.RecordsCount);
512 if FResTable <> nil then
513 begin
514 CopyMemory(@FResTable[0], Pointer(LongWord(Data)+6+SizeOf(TWADHeaderRec_1)),
515 SizeOf(TResourceTableRec_1)*FHeader.RecordsCount);
516
517 for a := 0 to High(FResTable) do
518 if FResTable[a].Length <> 0 then
519 FResTable[a].Address := FResTable[a].Address-6-(LongWord(SizeOf(TWADHeaderRec_1)+
520 SizeOf(TResourceTableRec_1)*Length(FResTable)));
521 end;
522
523 GetMem(FResData, Len);
524 CopyMemory(FResData, Data, Len);
525
526 FWADOpened := DFWAD_OPENED_MEMORY;
527 FLastError := DFWAD_NOERROR;
528
529 Result := True;
530 end;
531
532 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024