Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 798 lines (728 sloc) 21.708 kB
d9b4750 initial import
fpc authored
1 {
2 This file is part of the Free Pascal Integrated Development Environment
3 Copyright (c) 1998 by Berczi Gabor
4
5 Resource File support objects and routines
6
7 See the file COPYING.FPC, included in this distribution,
8 for details about the copyright.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15 unit WResourc;
16
17 interface
18
19 uses Objects;
20
21 const
22 TPDataBlockSignature = ord('F')+ord('B')*256;
23 ResourceBlockSignature = ord('R')+ord('D')*256;
24
25 langDefault = 0;
26
27 rcBinary = 1;
28
29 type
30 TResourceEntryHeader = packed record
31 ID : longint;
32 LangID : longint;
33 Flags : longint;
34 DataOfs: longint;
35 DataLen: sw_word;
36 end;
37
38 TResourceHeader = packed record
39 _Class : longint;
40 Flags : longint;
41 NameLen : word;
42 EntryCount : word;
43 end;
44
45 TResourceFileHeader = packed record
46 Signature : word;
47 InfoType : word;
48 InfoSize : longint;
49 { ---- }
50 TableOfs : longint;
51 end;
52
53 PResourceEntry = ^TResourceEntry;
54 TResourceEntry = object(TObject)
55 constructor Init(AID, ALangID, AFlags, ADataLen: longint);
56 private
57 ID : longint;
58 LangID : longint;
59 Flags : longint;
60 DataOfs : longint;
61 DataLen : sw_word;
62 procedure BuildHeader(var Header : TResourceEntryHeader);
63 end;
64
65 PResourceEntryCollection = ^TResourceEntryCollection;
66 TResourceEntryCollection = object(TSortedCollection)
67 function At(Index: Sw_Integer): PResourceEntry;
68 function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
69 function SearchEntryForLang(ALangID: longint): PResourceEntry;
70 end;
71
72 PGlobalResourceEntryCollection = ^TGlobalResourceEntryCollection;
73 TGlobalResourceEntryCollection = object(TSortedCollection)
74 function At(Index: Sw_Integer): PResourceEntry;
75 function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
76 end;
77
78 PResource = ^TResource;
79 TResource = object(TObject)
80 constructor Init(const AName: string; AClass, AFlags: longint);
81 function GetName: string; virtual;
82 function FirstThatEntry(Func: pointer): PResourceEntry; virtual;
83 procedure ForEachEntry(Func: pointer); virtual;
84 destructor Done; virtual;
85 private
86 Name : PString;
87 _Class : longint;
88 Flags : longint;
89 Items : PResourceEntryCollection;
90 procedure BuildHeader(var Header : TResourceHeader);
91 end;
92
93 TResourceCollection = object(TSortedCollection)
94 function At(Index: Sw_Integer): PResource;
95 function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
96 function SearchResourceByName(const AName: string): PResource;
97 end;
98 PResourceCollection = ^TResourceCollection;
99
100 TResourceFile = object(TObject)
101 constructor Init(var RS: TStream; ALoad: boolean);
102 constructor Create(var RS: TStream);
103 constructor Load(var RS: TStream);
104 constructor CreateFile(AFileName: string);
105 constructor LoadFile(AFileName: string);
106 function FirstThatResource(Func: pointer): PResource; virtual;
107 procedure ForEachResource(Func: pointer); virtual;
108 procedure ForEachResourceEntry(Func: pointer); virtual;
109 function CreateResource(const Name: string; AClass, AFlags: longint): boolean; virtual;
110 function AddResourceEntry(const ResName: string; ALangID, AFlags: longint; var Data;
111 ADataSize: sw_integer): boolean; virtual;
112 function AddResourceEntryFromStream(const ResName: string; ALangID, AFlags: longint;
113 var Source: TStream; ADataSize: longint): boolean; virtual;
114 function DeleteResourceEntry(const ResName: string; ALangID: longint): boolean; virtual;
115 function DeleteResource(const ResName: string): boolean; virtual;
116 function ReadResourceEntry(const ResName: string; ALangID: longint; var Buf; BufSize: sw_word): boolean;
117 function ReadResourceEntryToStream(const ResName: string; ALangID: longint; var DestS: TStream): boolean;
118 procedure Flush; virtual;
119 destructor Done; virtual;
120 public
121 BaseOfs: longint;
122 function FindResource(const ResName: string): PResource;
123 function FindResourceEntry(const ResName: string; ALangID: longint): PResourceEntry;
124 private
125 S : PStream;
126 MyStream : boolean;
127 Resources : PResourceCollection;
128 Entries : PGlobalResourceEntryCollection;
129 Header : TResourceFileHeader;
130 Modified : boolean;
131 procedure UpdateBlockDatas;
132 function GetNextEntryID: longint;
133 function GetTotalSize(IncludeHeaders: boolean): longint;
134 function CalcSizes(IncludeHeaders, UpdatePosData: boolean): longint;
135 procedure AddResEntryPtr(P: PResource; E: PResourceEntry);
136 procedure RemoveResEntryPtr(P: PResource; E: PResourceEntry);
137 function DeleteArea(AreaStart, AreaSize, TotalSize: longint): boolean;
138 procedure BuildFileHeader;
139 procedure WriteHeader;
140 procedure WriteResourceTable;
141 end;
142 PResourceFile = ^TResourceFile;
143
144 implementation
145
146 uses
147 WUtils;
148
149 function TResourceEntryCollection.At(Index: Sw_Integer): PResourceEntry;
150 begin
151 At:=inherited At(Index);
152 end;
153
154 function TResourceEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
155 var K1: PResourceEntry absolute Key1;
156 K2: PResourceEntry absolute Key2;
157 Re: Sw_integer;
158 begin
159 if K1^.LangID<K2^.LangID then Re:=-1 else
160 if K1^.LangID>K2^.LangID then Re:= 1 else
161 Re:=0;
162 Compare:=Re;
163 end;
164
165 function TResourceEntryCollection.SearchEntryForLang(ALangID: longint): PResourceEntry;
166 var P: PResourceEntry;
167 E: TResourceEntry;
168 Index: sw_integer;
169 begin
170 E.LangID:=ALangID;
171 if Search(@E,Index)=false then P:=nil else
172 P:=At(Index);
173 SearchEntryForLang:=P;
174 end;
175
176 function TGlobalResourceEntryCollection.At(Index: Sw_Integer): PResourceEntry;
177 begin
178 At:=inherited At(Index);
179 end;
180
181 function TGlobalResourceEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
182 var K1: PResourceEntry absolute Key1;
183 K2: PResourceEntry absolute Key2;
184 Re: Sw_integer;
185 begin
186 if K1^.ID<K2^.ID then Re:=-1 else
187 if K1^.ID>K2^.ID then Re:= 1 else
188 Re:=0;
189 Compare:=Re;
190 end;
191
192 constructor TResourceEntry.Init(AID, ALangID, AFlags, ADataLen: longint);
193 begin
194 inherited Init;
195 ID:=AID;
196 LangID:=ALangID; Flags:=AFlags; DataLen:=ADataLen;
197 end;
198
199 procedure TResourceEntry.BuildHeader(var Header : TResourceEntryHeader);
200 begin
201 FillChar(Header,SizeOf(Header),0);
202 Header.ID:=ID;
203 Header.LangID:=LangID;
204 Header.Flags:=Flags;
205 Header.DataLen:=DataLen;
206 Header.DataOfs:=DataOfs;
207 end;
208
209 constructor TResource.Init(const AName: string; AClass, AFlags: longint);
210 begin
211 inherited Init;
212 Name:=NewStr(AName);
213 _Class:=AClass;
214 Flags:=AFlags;
215 New(Items, Init(10,50));
216 end;
217
218 function TResource.GetName: string;
219 begin
220 GetName:=GetStr(Name);
221 end;
222
223 function TResource.FirstThatEntry(Func: pointer): PResourceEntry;
224 var EP,P: PResourceEntry;
225 I: sw_integer;
226 begin
227 P:=nil;
228 for I:=0 to Items^.Count-1 do
229 begin
230 EP:=Items^.At(I);
231 if Byte(Longint(CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,EP)))<>0 then
232 begin
233 P := EP;
234 Break;
235 end;
236 end;
237 FirstThatEntry:=P;
238 end;
239
240 procedure TResource.ForEachEntry(Func: pointer);
241 var RP: PResourceEntry;
242 I: sw_integer;
243 begin
244 for I:=0 to Items^.Count-1 do
245 begin
246 RP:=Items^.At(I);
247 CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,RP);
248 end;
249 end;
250
251 procedure TResource.BuildHeader(var Header : TResourceHeader);
252 begin
253 FillChar(Header,SizeOf(Header),0);
254 Header._Class:=_Class;
255 Header.Flags:=Flags;
256 Header.NameLen:=length(GetName);
257 Header.EntryCount:=Items^.Count;
258 end;
259
260 destructor TResource.Done;
261 begin
262 inherited Done;
263 if Name<>nil then DisposeStr(Name); Name:=nil;
264 if Items<>nil then Dispose(Items, Done); Items:=nil;
265 end;
266
267 function TResourceCollection.At(Index: Sw_Integer): PResource;
268 begin
269 At:=inherited At(Index);
270 end;
271
272 function TResourceCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
273 var K1: PResource absolute Key1;
274 K2: PResource absolute Key2;
275 N1,N2: string;
276 Re: Sw_integer;
277 begin
278 N1:=UpcaseStr(K1^.GetName); N2:=UpcaseStr(K2^.GetName);
279 if N1<N2 then Re:=-1 else
280 if N1>N2 then Re:= 1 else
281 Re:=0;
282 Compare:=Re;
283 end;
284
285 function TResourceCollection.SearchResourceByName(const AName: string): PResource;
286 var P,R: PResource;
287 Index: sw_integer;
288 begin
289 New(R, Init(AName,0,0));
290 if Search(R,Index)=false then P:=nil else
291 P:=At(Index);
292 Dispose(R, Done);
293 SearchResourceByName:=P;
294 end;
295
296 constructor TResourceFile.Create(var RS: TStream);
297 begin
298 if Init(RS,false)=false then
299 Fail;
300 end;
301
302 constructor TResourceFile.Load(var RS: TStream);
303 begin
304 if Init(RS,true)=false then
305 Fail;
306 end;
307
308 constructor TResourceFile.Init(var RS: TStream; ALoad: boolean);
309 var OK: boolean;
310 RH: TResourceHeader;
311 REH: TResourceEntryHeader;
312 EndPos,I: longint;
313 P: PResource;
314 E: PResourceEntry;
315 St: string;
316 begin
317 inherited Init;
318 S:=@RS;
319 New(Resources, Init(100, 1000));
320 New(Entries, Init(500,2000));
321 OK:=true;
322 if ALoad=false then
323 Modified:=true
324 else
325 begin
326 S^.Reset;
327 BaseOfs:=S^.GetPos;
328 S^.Read(Header,SizeOf(Header));
329 OK:=(S^.Status=stOK) and
330 (Header.Signature=TPDataBlockSignature) and
331 (Header.InfoType=ResourceBlockSignature);
332 if OK then begin S^.Seek(BaseOfs+Header.TableOfs); OK:=S^.Status=stOK; end;
333 EndPos:=BaseOfs+Header.InfoSize;
334 if OK then
335 while OK and (S^.GetPos<EndPos) do
336 begin
337 S^.Read(RH,SizeOf(RH)); OK:=(S^.Status=stOK);
338 if OK then begin St[0]:=chr(RH.NameLen); S^.Read(St[1],RH.NameLen); OK:=(S^.Status=stOK); end;
339 if OK then
340 begin
341 New(P, Init(St,RH._Class,RH.Flags));
342 Resources^.Insert(P);
343 end;
344 I:=0;
345 while OK and (I<RH.EntryCount) do
346 begin
347 S^.Read(REH,SizeOf(REH)); OK:=(S^.Status=stOK);
348 if OK then
349 begin
350 New(E, Init(REH.ID,REH.LangID,REH.Flags,REH.DataLen));
351 AddResEntryPtr(P,E);
352 end;
353 if OK then Inc(I);
354 end;
355 if OK then UpdateBlockDatas;
356 end;
357 end;
358 if OK=false then
359 begin
360 Done;
361 Fail;
362 end;
363 end;
364
365 function TResourceFile.FirstThatResource(Func: pointer): PResource;
366 var RP,P: PResource;
367 I: sw_integer;
368 begin
369 P:=nil;
370 for I:=0 to Resources^.Count-1 do
371 begin
372 RP:=Resources^.At(I);
373 if Byte(Longint(CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,RP)))<>0 then
374 begin
375 P := RP;
376 Break;
377 end;
378 end;
379 FirstThatResource:=P;
380 end;
381
382 procedure TResourceFile.ForEachResource(Func: pointer);
383 var RP: PResource;
384 I: sw_integer;
385 begin
386 for I:=0 to Resources^.Count-1 do
387 begin
388 RP:=Resources^.At(I);
389 CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,RP);
390 end;
391 end;
392
393 procedure TResourceFile.ForEachResourceEntry(Func: pointer);
394 var E: PResourceEntry;
395 I: sw_integer;
396 begin
397 for I:=0 to Entries^.Count-1 do
398 begin
399 E:=Entries^.At(I);
400 CallPointerMethodLocal(Func,get_caller_frame(get_frame),@Self,E);
401 end;
402 end;
403
404 function TResourceFile.CreateResource(const Name: string; AClass, AFlags: longint): boolean;
405 var OK: boolean;
406 P: PResource;
407 begin
408 OK:=FindResource(Name)=nil;
409 if OK then
410 begin
411 New(P, Init(Name,AClass,AFlags));
412 Resources^.Insert(P);
413 Modified:=true;
414 end;
415 CreateResource:=OK;
416 end;
417
418 function TResourceFile.AddResourceEntry(const ResName: string; ALangID, AFlags: longint; var Data;
419 ADataSize: sw_integer): boolean;
420 const BlockSize = 4096;
421 var OK: boolean;
422 P: PResource;
423 E: PResourceEntry;
424 RemSize,CurOfs,FragSize: longint;
425 begin
426 P:=FindResource(ResName);
427 OK:=P<>nil;
428 if OK then
429 OK:=(P^.Items^.SearchEntryForLang(ALangID)=nil);
430 if OK then
431 begin
432 New(E, Init(GetNextEntryID,ALangID, AFlags, ADataSize));
433 AddResEntryPtr(P,E);
434 UpdateBlockDatas;
435 RemSize:=ADataSize; CurOfs:=0;
436 S^.Reset;
437 S^.Seek(BaseOfs+E^.DataOfs);
438 while (RemSize>0) do
439 begin
440 FragSize:=Min(RemSize,BlockSize);
441 S^.Write(PByteArray(@Data)^[CurOfs],FragSize);
442 Dec(RemSize,FragSize); Inc(CurOfs,FragSize);
443 end;
444 Modified:=true;
445 end;
446 AddResourceEntry:=OK;
447 end;
448
449 function TResourceFile.AddResourceEntryFromStream(const ResName: string; ALangID, AFlags: longint;
450 var Source: TStream; ADataSize: longint): boolean;
451 const BufSize = 4096;
452 var OK: boolean;
453 P: PResource;
454 E: PResourceEntry;
455 RemSize,FragSize: longint;
456 Buf: pointer;
457 begin
458 P:=FindResource(ResName);
459 OK:=P<>nil;
460 if OK then
461 OK:=(P^.Items^.SearchEntryForLang(ALangID)=nil);
462 if OK then
463 begin
464 New(E, Init(GetNextEntryID, ALangID, AFlags, ADataSize));
465 AddResEntryPtr(P,E);
466 UpdateBlockDatas;
467 GetMem(Buf,BufSize);
468 RemSize:=ADataSize;
469 S^.Reset;
470 S^.Seek(BaseOfs+E^.DataOfs);
471 while (RemSize>0) do
472 begin
473 FragSize:=Min(RemSize,BufSize);
474 Source.Read(Buf^,FragSize);
475 S^.Write(Buf^,FragSize);
476 Dec(RemSize,FragSize);
477 end;
478 FreeMem(Buf,BufSize);
479 Modified:=true;
480 end;
481 AddResourceEntryFromStream:=OK;
482 end;
483
484 function TResourceFile.DeleteResourceEntry(const ResName: string; ALangID: longint): boolean;
485 var E: PResourceEntry;
486 P: PResource;
487 OK: boolean;
488 begin
489 P:=FindResource(ResName);
490 OK:=P<>nil;
491 if OK then E:=P^.Items^.SearchEntryForLang(ALangID);
492 OK:=OK and (E<>nil);
493 if OK then
494 begin
495 OK:=DeleteArea(E^.DataOfs,E^.DataLen,GetTotalSize(false));
496 if OK then begin RemoveResEntryPtr(P,E); Dispose(E, Done); end;
497 Modified:=true;
498 end;
499 DeleteResourceEntry:=OK;
500 end;
501
502 function TResourceFile.DeleteResource(const ResName: string): boolean;
503 var P: PResource;
504 E: PResourceEntry;
505 OK: boolean;
506 begin
507 P:=FindResource(ResName);
508 OK:=P<>nil;
509 if P<>nil then
510 begin
511 while OK and (P^.Items^.Count>0) do
512 begin
513 E:=P^.Items^.At(P^.Items^.Count-1);
514 OK:=OK and DeleteResourceEntry(ResName,E^.LangID);
515 end;
516 Modified:=true;
517 end;
518 if OK then Resources^.Free(P);
519 DeleteResource:=OK;
520 end;
521
522 function TResourceFile.ReadResourceEntry(const ResName: string; ALangID: longint; var Buf; BufSize: sw_word): boolean;
523 var E: PResourceEntry;
524 P: PResource;
525 OK: boolean;
526 CurOfs,CurFrag: sw_word;
527 TempBuf: pointer;
528 const TempBufSize = 4096;
529 begin
530 E:=nil;
531 P:=FindResource(ResName);
532 OK:=P<>nil;
533 if OK then E:=P^.Items^.SearchEntryForLang(ALangID);
534 OK:=OK and (E<>nil);
535 OK:=OK and (E^.DataLen<=BufSize);
536 if OK then
537 begin
538 GetMem(TempBuf,TempBufSize);
539 S^.Reset;
540 S^.Seek(BaseOfs+E^.DataOfs);
541 OK:=(S^.Status=stOK);
542 CurOfs:=0;
543
544 while OK and (CurOfs<E^.DataLen) do
545 begin
546 CurFrag:=Min(E^.DataLen-CurOfs,TempBufSize);
547 S^.Read(TempBuf^,CurFrag);
548 OK:=OK and (S^.Status=stOK);
549 if OK then
550 Move(TempBuf^,PByteArray(@Buf)^[CurOfs],CurFrag);
551 Inc(CurOfs,CurFrag);
552 end;
553
554 FreeMem(TempBuf,TempBufSize);
555 end;
556 ReadResourceEntry:=OK;
557 end;
558
559 function TResourceFile.ReadResourceEntryToStream(const ResName: string; ALangID: longint; var DestS: TStream): boolean;
560 var E: PResourceEntry;
561 P: PResource;
562 OK: boolean;
563 CurOfs,CurFrag: sw_word;
564 TempBuf: pointer;
565 const TempBufSize = 4096;
566 begin
567 P:=FindResource(ResName);
568 OK:=P<>nil;
569 if OK then E:=P^.Items^.SearchEntryForLang(ALangID);
570 OK:=OK and (E<>nil);
571 if OK then
572 begin
573 GetMem(TempBuf,TempBufSize);
574 S^.Reset;
575 S^.Seek(BaseOfs+E^.DataOfs);
576 OK:=(S^.Status=stOK);
577 CurOfs:=0;
578 { this results sometimes in endless loops
579 when the resource are changed PM }
580 if E^.DataLen<0 then
581 OK:=false;
582 while OK and (CurOfs<E^.DataLen) do
583 begin
584 CurFrag:=Min(E^.DataLen-CurOfs,TempBufSize);
585 S^.Read(TempBuf^,CurFrag);
586 OK:=OK and (S^.Status=stOK);
587 if OK then
588 DestS.Write(TempBuf^,CurFrag);
589 OK:=OK and (DestS.Status=stOK);
590 Inc(CurOfs,CurFrag);
591 end;
592
593 FreeMem(TempBuf,TempBufSize);
594 end;
595 ReadResourceEntryToStream:=OK;
596 end;
597
598 function TResourceFile.FindResource(const ResName: string): PResource;
599 begin
600 FindResource:=Resources^.SearchResourceByName(ResName);
601 end;
602
603 function TResourceFile.FindResourceEntry(const ResName: string; ALangID: longint): PResourceEntry;
604 var P: PResource;
605 E: PResourceEntry;
606 begin
607 E:=nil;
608 P:=FindResource(ResName);
609 if P<>nil then
610 E:=P^.Items^.SearchEntryForLang(ALangID);
611 FindResourceEntry:=E;
612 end;
613
614 procedure TResourceFile.Flush;
615 begin
616 if Modified=false then Exit;
617 BuildFileHeader;
618 S^.Seek(BaseOfs);
619 WriteHeader;
620 S^.Seek(BaseOfs+Header.TableOfs);
621 WriteResourceTable;
622 S^.Truncate;
623 Modified:=false;
624 end;
625
626 procedure TResourceFile.BuildFileHeader;
627 begin
628 FillChar(Header,SizeOf(Header),0);
629 with Header do
630 begin
631 Signature:=TPDataBlockSignature;
632 InfoType:=ResourceBlockSignature;
633 InfoSize:=GetTotalSize(true);
634 TableOfs:=GetTotalSize(false);
635 end;
636 end;
637
638 procedure TResourceFile.WriteHeader;
639 begin
640 S^.Write(Header,SizeOf(Header));
641 end;
642
643 procedure TResourceFile.WriteResourceTable;
644 var RH: TResourceHeader;
645 REH: TResourceEntryHeader;
646 procedure WriteResource(P: PResource);
647 procedure WriteResourceEntry(P: PResourceEntry);
648 begin
649 P^.BuildHeader(REH);
650 S^.Write(REH,SizeOf(REH));
651 end;
652 var N: string;
653 begin
654 if P^.Items^.Count=0 then Exit; { do not store resources with no entries }
655 P^.BuildHeader(RH);
656 S^.Write(RH,SizeOf(RH));
657 N:=P^.GetName;
658 S^.Write(N[1],length(N));
659 P^.ForEachEntry(@WriteResourceEntry);
660 end;
661 begin
662 ForEachResource(@WriteResource);
663 end;
664
665 procedure TResourceFile.UpdateBlockDatas;
666 begin
667 CalcSizes(false,true);
668 end;
669
670 function TResourceFile.GetTotalSize(IncludeHeaders: boolean): longint;
671 begin
672 GetTotalSize:=CalcSizes(IncludeHeaders,false);
673 end;
674
675 function TResourceFile.CalcSizes(IncludeHeaders, UpdatePosData: boolean): longint;
676 var RH : TResourceHeader;
677 REH : TResourceEntryHeader;
678 Size: longint;
679 NamesSize: longint;
680 procedure AddResourceEntrySize(P: PResourceEntry);
681 begin
682 if UpdatePosData then P^.DataOfs:=Size;
683 P^.BuildHeader(REH);
684 Inc(Size,REH.DataLen);
685 end;
686 procedure AddResourceSize(P: PResource);
687 var RH: TResourceHeader;
688 begin
689 P^.BuildHeader(RH);
690 Inc(NamesSize,RH.NameLen);
691 end;
692 begin
693 Size:=0; NamesSize:=0;
694 Inc(Size,SizeOf(Header)); { this is on start so we always include it }
695 ForEachResourceEntry(@AddResourceEntrySize);
696 if IncludeHeaders then
697 begin
698 ForEachResource(@AddResourceSize);
699 Inc(Size,SizeOf(RH)*Resources^.Count);
700 Inc(Size,SizeOf(REH)*Entries^.Count);
701 Inc(Size,NamesSize);
702 end;
703 CalcSizes:=Size;
704 end;
705
706 function TResourceFile.DeleteArea(AreaStart, AreaSize, TotalSize: longint): boolean;
707 const BufSize = 4096;
708 var RemSize,FragSize,CurOfs: longint;
709 Buf: pointer;
710 OK: boolean;
711 begin
712 GetMem(Buf,BufSize);
713 RemSize:=TotalSize-(AreaStart+AreaSize); CurOfs:=0;
714 OK:=RemSize>=0;
715 while (RemSize>0) do
716 begin
717 FragSize:=Min(RemSize,BufSize);
718 S^.Seek(BaseOfs+AreaStart+AreaSize+CurOfs);
719 S^.Read(Buf^,BufSize);
720 OK:=OK and (S^.Status=stOK);
721 if OK then
722 begin
723 S^.Seek(BaseOfs+AreaStart+CurOfs);
724 S^.Write(Buf^,BufSize);
725 OK:=OK and (S^.Status=stOK);
726 end;
727 Inc(CurOfs,FragSize); Dec(RemSize,FragSize);
728 end;
729 FreeMem(Buf,BufSize);
730 DeleteArea:=OK;
731 end;
732
733 procedure TResourceFile.AddResEntryPtr(P: PResource; E: PResourceEntry);
734 begin
735 if (P=nil) or (E=nil) then Exit;
736 P^.Items^.Insert(E);
737 Entries^.Insert(E);
738 end;
739
740 procedure TResourceFile.RemoveResEntryPtr(P: PResource; E: PResourceEntry);
741 begin
742 if (P=nil) or (E=nil) then Exit;
743 Entries^.Delete(E);
744 P^.Items^.Delete(E);
745 end;
746
747 function TResourceFile.GetNextEntryID: longint;
748 var ID: longint;
749 begin
750 if Entries^.Count=0 then ID:=1 else
751 ID:=Entries^.At(Entries^.Count-1)^.ID+1;
752 GetNextEntryID:=ID;
753 end;
754
755 destructor TResourceFile.Done;
756 begin
757 Flush;
758 inherited Done;
759 { if assigned(S) then dispose(S,Done); S:=nil;}
760 if Resources<>nil then Dispose(Resources, Done); Resources:=nil;
761 if Entries<>nil then
762 begin Entries^.DeleteAll; Dispose(Entries, Done); Entries:=nil; end;
763 if MyStream and Assigned(S) then
764 Dispose(S, Done);
765 end;
766
767 constructor TResourceFile.CreateFile(AFileName: string);
768 var B: PFastBufStream;
769 begin
770 New(B, Init(AFileName, stCreate, 4096));
771 if (B<>nil) and (B^.Status<>stOK) then
772 begin Dispose(B, Done); B:=nil; end;
773 if B=nil then Fail;
774 if Create(B^)=false then
775 Begin
776 Dispose(B,Done);
777 Fail;
778 End;
779 MyStream:=true;
780 end;
781
782 constructor TResourceFile.LoadFile(AFileName: string);
783 var B: PFastBufStream;
784 begin
785 New(B, Init(AFileName, stOpen, 4096));
786 if (B<>nil) and (B^.Status<>stOK) then
787 begin Dispose(B, Done); B:=nil; end;
788 if B=nil then Fail;
789 if Load(B^)=false then
790 Begin
791 Dispose(B,Done);
792 Fail;
793 End;
794 MyStream:=true;
795 end;
796
797 END.
Something went wrong with that request. Please try again.