source: oup/current/FileClasses/_DataTypes.pas@ 226

Last change on this file since 226 was 213, checked in by alloc, 17 years ago
File size: 13.6 KB
Line 
1unit _DataTypes;
2
3interface
4
5uses
6 Classes;
7
8type
9 TDataField = class
10 protected
11 FOffset: Integer;
12 FName: String;
13 FDescription: String;
14 FDataLength: Integer;
15 FParentFile: TObject;
16 FParentField: TDataField;
17 FChanged: Boolean;
18 function GetValueAsString: String; virtual; abstract;
19 public
20 constructor Create(ParentFile: TObject; ParentField: TDataField;
21 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); virtual;
22
23 procedure Update(Offset, Length: Integer); virtual; abstract;
24
25 property Offset: Integer read FOffset;
26 property Name: String read FName;
27 property Description: String read FDescription;
28 property DataLength: Integer read FDataLength;
29 property ValueAsString: String read GetValueAsString;
30 end;
31
32 TFieldType = class of TDataField;
33
34
35 TBlock = class(TDataField)
36 private
37 FDataFields: array of TDataField;
38 function GetFieldByOffset(Offset: Integer): TDataField;
39 function GetFieldByIndex(ID: Integer): TDataField;
40 function GetFieldCount: Integer;
41 public
42 // ExtraArgs: keine
43 constructor Create(ParentFile: TObject; ParentField: TDataField;
44 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
45 procedure Update(Offset, Length: Integer); override;
46 property FieldByOffset[Offset: Integer]: TDataField read GetFieldByOffset;
47 property FieldByIndex[ID: Integer]: TDataField read GetFieldByIndex;
48 property FieldCount: Integer read GetFieldCount;
49
50 function AddField(fieldtype: TFieldType; Offset: Integer;
51 Name, Description: String; ExtraArgs: Pointer): TDataField;
52 end;
53
54
55 TInt = class(TDataField)
56 private
57 FInt: Integer;
58 function GetValueAsString: String; override;
59 public
60 // ExtraArgs: Pointer auf Integer: Bytes of TInt
61 constructor Create(ParentFile: TObject; ParentField: TDataField;
62 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
63 procedure Update(Offset, Length: Integer); override;
64 end;
65
66
67 TBitSet = class(TDataField)
68 private
69 FBits: Byte;
70 FNames: TStringList;
71 function GetValueAsString: String; override;
72 public
73 // ExtraArgs: Pointer auf TStringList
74 constructor Create(ParentFile: TObject; ParentField: TDataField;
75 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
76 procedure Update(Offset, Length: Integer); override;
77 end;
78
79
80 TLevelID = class(TDataField)
81 private
82 FLevelID: Integer;
83 function GetValueAsString: String; override;
84 public
85 // ExtraArgs: keine
86 constructor Create(ParentFile: TObject; ParentField: TDataField;
87 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
88 procedure Update(Offset, Length: Integer); override;
89 end;
90
91
92 TFileID = class(TDataField)
93 private
94 FFileID: Integer;
95 function GetValueAsString: String; override;
96 public
97 // ExtraArgs: keine
98 constructor Create(ParentFile: TObject; ParentField: TDataField;
99 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
100 procedure Update(Offset, Length: Integer); override;
101 end;
102
103
104 TLinkByID = class(TDataField)
105 private
106 FFileID: Integer;
107 FPosExts: String;
108 function GetValueAsString: String; override;
109 public
110 // ExtraArgs: Pointer auf String: Possible Exts
111 constructor Create(ParentFile: TObject; ParentField: TDataField;
112 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
113 procedure Update(Offset, Length: Integer); override;
114 end;
115
116
117 TString = class(TDataField)
118 private
119 FString: String;
120 function GetValueAsString: String; override;
121 public
122 // ExtraArgs: Pointer auf Integer: Length
123 constructor Create(ParentFile: TObject; ParentField: TDataField;
124 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
125 procedure Update(Offset, Length: Integer); override;
126 end;
127
128
129 TArray = class(TDataField)
130 private
131 FDataFields: array of TDataField;
132 function GetFieldByOffset(Offset: Integer): TDataField;
133 function GetFieldByIndex(ID: Integer): TDataField;
134 function GetFieldCount: Integer;
135 public
136 // ExtraArgs: Pointer auf 2 Integer: Length+Count (packed record...)
137 constructor Create(ParentFile: TObject; ParentField: TDataField;
138 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
139 procedure Update(Offset, Length: Integer); override;
140 property FieldByOffset[Offset: Integer]: TDataField read GetFieldByOffset;
141 property FieldByIndex[ID: Integer]: TDataField read GetFieldByIndex;
142 property FieldCount: Integer read GetFieldCount;
143
144 function AddField(fieldtype: TFieldType; Offset: Integer;
145 Name, Description: String; ExtraArgs: Pointer): TDataField;
146 end;
147
148
149 TRawLink = class(TDataField)
150 private
151 FRawAddress: Integer;
152 function GetValueAsString: String; override;
153 public
154 // ExtraArgs: keine
155 constructor Create(ParentFile: TObject; ParentField: TDataField;
156 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
157 procedure Update(Offset, Length: Integer); override;
158 end;
159
160
161 TUnused = class(TDataField)
162 private
163 function GetValueAsString: String; override;
164 public
165 // ExtraArgs: Pointer auf Integer: Length
166 constructor Create(ParentFile: TObject; ParentField: TDataField;
167 Offset: Integer; Name, Description: String; ExtraArgs: Pointer); override;
168 procedure Update(Offset, Length: Integer); override;
169 end;
170
171
172
173
174implementation
175
176uses
177 SysUtils, Dialogs, _FileTypes, ConnectionManager;
178
179
180
181
182{ TDataType }
183
184constructor TDataField.Create(ParentFile: TObject; ParentField: TDataField;
185 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
186begin
187 FOffset := Offset;
188 FName := Name;
189 FDescription := Description;
190 FParentFile := ParentFile;
191 FParentField := ParentField;
192end;
193
194
195
196{ TString }
197
198constructor TString.Create(ParentFile: TObject; ParentField: TDataField;
199 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
200var
201 fstream: TMemoryStream;
202 i: Integer;
203begin
204 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
205 FDataLength := Integer(ExtraArgs^);
206 fstream := TFile(ParentFile).FileStream;
207 fstream.Seek(Offset, soFromBeginning);
208 SetLength(FString, FDataLength);
209 fstream.Read(FString[1], FDataLength);
210 for i := 1 to FDataLength do
211 if FString[i] = Chr(0) then
212 begin
213 SetLength(FString, i - 1);
214 Break;
215 end;
216end;
217
218function TString.GetValueAsString: String;
219begin
220 Result := FString;
221end;
222
223procedure TString.Update(Offset, Length: Integer);
224begin
225 Exit;
226end;
227
228
229
230{ TInt }
231
232constructor TInt.Create(ParentFile: TObject; ParentField: TDataField;
233 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
234var
235 fstream: TMemoryStream;
236begin
237 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
238 FDataLength := Integer(ExtraArgs^);
239 FInt := 0;
240 fstream := TFile(ParentFile).FileStream;
241 fstream.Seek(Offset, soFromBeginning);
242 fstream.Read(FInt, FDataLength);
243end;
244
245function TInt.GetValueAsString: String;
246begin
247 Result := IntToStr(FInt);
248end;
249
250procedure TInt.Update(Offset, Length: Integer);
251begin
252 Exit;
253end;
254
255
256
257{ TArray }
258
259function TArray.AddField(fieldtype: TFieldType; Offset: Integer;
260 Name, Description: String; ExtraArgs: Pointer): TDataField;
261begin
262 Exit;
263end;
264
265constructor TArray.Create(ParentFile: TObject; ParentField: TDataField;
266 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
267begin
268 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
269end;
270
271function TArray.GetFieldByIndex(ID: Integer): TDataField;
272begin
273 if ID < Length(FDataFields) then
274 Result := FDataFields[ID]
275 else
276 Result := nil;
277end;
278
279function TArray.GetFieldByOffset(Offset: Integer): TDataField;
280var
281 i: Integer;
282begin
283 Result := nil;
284
285 if Length(FDataFields) > 0 then
286 begin
287 for i := 0 to High(FDataFields) do
288 if FDataFields[i].Offset = Offset then
289 break;
290 if i < Length(FDataFields) then
291 Result := FDataFields[i];
292 end;
293end;
294
295function TArray.GetFieldCount: Integer;
296begin
297 Result := Length(FDataFields);
298end;
299
300procedure TArray.Update(Offset, Length: Integer);
301begin
302 Exit;
303end;
304
305
306
307{ TBlock }
308
309function TBlock.AddField(fieldtype: TFieldType; Offset: Integer; Name,
310 Description: String; ExtraArgs: Pointer): TDataField;
311var
312 i: Integer;
313begin
314 if Length(FDataFields) > 0 then
315 begin
316 for i := 0 to High(FDataFields) do
317 if FDataFields[i].FOffset = Offset then
318 Break;
319 if i < Length(FDataFields) then
320 begin
321 ShowMessage('Field already exists');
322 Exit;
323 end;
324 end;
325 SetLength(FDataFields, Length(FDataFields) + 1);
326 FDataFields[High(FDataFields)] := TFieldType(fieldtype).Create(
327 FParentFile, Self, Offset, Name, Description, ExtraArgs);
328 Result := FDataFields[High(FDataFields)];
329end;
330
331constructor TBlock.Create(ParentFile: TObject; ParentField: TDataField;
332 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
333begin
334 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
335end;
336
337function TBlock.GetFieldByIndex(ID: Integer): TDataField;
338begin
339 Result := FDataFields[ID];
340end;
341
342function TBlock.GetFieldByOffset(Offset: Integer): TDataField;
343begin
344 Exit;
345end;
346
347function TBlock.GetFieldCount: Integer;
348begin
349 Result := Length(FDataFields);
350end;
351
352procedure TBlock.Update(Offset, Length: Integer);
353begin
354 Exit;
355end;
356
357
358
359{ TLevelID }
360
361constructor TLevelID.Create(ParentFile: TObject; ParentField: TDataField;
362 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
363var
364 fstream: TMemoryStream;
365begin
366 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
367 FDataLength := 4;
368 fstream := TFile(ParentFile).FileStream;
369 fstream.Seek(Offset, soFromBeginning);
370 fstream.Read(FLevelID, 4);
371 FLevelID := FLevelID div 256 div 256 div 256 div 2;
372end;
373
374function TLevelID.GetValueAsString: String;
375begin
376 Result := IntToStr(FLevelID);
377end;
378
379procedure TLevelID.Update(Offset, Length: Integer);
380begin
381 Exit;
382end;
383
384
385
386{ TFileID }
387
388constructor TFileID.Create(ParentFile: TObject; ParentField: TDataField;
389 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
390var
391 fstream: TMemoryStream;
392begin
393 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
394 FDataLength := 4;
395 fstream := TFile(ParentFile).FileStream;
396 fstream.Seek(Offset, soFromBeginning);
397 fstream.Read(FFileID, 4);
398 if FFileID > 0 then
399 FFileID := FFileID div 256
400 else
401 FFileID := -1;
402end;
403
404function TFileID.GetValueAsString: String;
405begin
406 Result := IntToStr(FFileID);
407end;
408
409procedure TFileID.Update(Offset, Length: Integer);
410begin
411 Exit;
412end;
413
414
415
416{ TLinkByID }
417
418constructor TLinkByID.Create(ParentFile: TObject; ParentField: TDataField;
419 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
420var
421 fstream: TMemoryStream;
422begin
423 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
424 FDataLength := 4;
425 FPosExts := String(ExtraArgs^);
426 fstream := TFile(ParentFile).FileStream;
427 fstream.Seek(Offset, soFromBeginning);
428 fstream.Read(FFileID, 4);
429 if FFileID > 0 then
430 FFileID := FFileID div 256
431 else
432 FFileID := -1;
433end;
434
435function TLinkByID.GetValueAsString: String;
436begin
437 Result := IntToStr(FFileID);
438end;
439
440procedure TLinkByID.Update(Offset, Length: Integer);
441begin
442 Exit;
443end;
444
445
446
447{ TRawLink }
448
449constructor TRawLink.Create(ParentFile: TObject; ParentField: TDataField;
450 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
451var
452 fstream: TMemoryStream;
453begin
454 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
455 FDataLength := 4;
456 fstream := TFile(ParentFile).FileStream;
457 fstream.Seek(Offset, soFromBeginning);
458 fstream.Read(FRawAddress, 4);
459end;
460
461function TRawLink.GetValueAsString: String;
462begin
463 Result := IntToStr(FRawAddress);
464end;
465
466procedure TRawLink.Update(Offset, Length: Integer);
467begin
468 Exit;
469end;
470
471
472
473{ TUnused }
474
475constructor TUnused.Create(ParentFile: TObject; ParentField: TDataField;
476 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
477begin
478 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
479 FDataLength := Integer(ExtraArgs^);
480end;
481
482function TUnused.GetValueAsString: String;
483begin
484 Result := '';
485end;
486
487procedure TUnused.Update(Offset, Length: Integer);
488begin
489 Exit;
490end;
491
492
493
494{ TBitSet }
495
496constructor TBitSet.Create(ParentFile: TObject; ParentField: TDataField;
497 Offset: Integer; Name, Description: String; ExtraArgs: Pointer);
498var
499 fstream: TMemoryStream;
500begin
501 inherited Create(ParentFile, ParentField, Offset, Name, Description, ExtraArgs);
502 FNames := TStringList.Create;
503 FNames.AddStrings(TStringList(ExtraArgs^));
504 FDataLength := 1;
505 FBits := 0;
506 fstream := TFile(ParentFile).FileStream;
507 fstream.Seek(Offset, soFromBeginning);
508 fstream.Read(FBits, FDataLength);
509end;
510
511function TBitSet.GetValueAsString: String;
512begin
513 Result := IntToStr(FBits);
514end;
515
516procedure TBitSet.Update(Offset, Length: Integer);
517begin
518 Exit;
519end;
520
521end.
Note: See TracBrowser for help on using the repository browser.