LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
// 
4
{
5
  Archive Manager
6
 
7
   History :  
8
    04/06/10 - Yar - Added to GLScene
9
                        (Created by Rustam Asmandiarov aka Predator)
10
   
11
}
12

13
unit GLSArchiveManager;
14

15
{$I GLScene.inc}
16

17
interface
18

19
uses
20
  Classes, SysUtils,
21
   
22
  GLPersistentClasses, GLApplicationFileIO;
23

24
Type
25

26
  TCompressionLevel = (
27
    clNone,
28
    clFastest,
29
    clDefault,
30
    clMax,
31
    clLevel1,
32
    clLevel2,
33
    clLevel3,
34
    clLevel4,
35
    clLevel5,
36
    clLevel6,
37
    clLevel7,
38
    clLevel8,
39
    clLevel9
40
  );
41

42
  //****************************************************************************
43

44
  //Базовый класс для архиваторов
45

46
  { TGLBaseArchive }
47

48
  TGLBaseArchive= class(TGLDataFile)
49
    protected
50
      FFileName: string;
51
      FContentList: TStrings;
52
      FCompressionLevel: TCompressionLevel;
53
      Procedure SetCompressionLevel(aValue: TCompressionLevel); Virtual;
54
    public
55
      constructor Create(AOwner: TPersistent); override;
56
      destructor Destroy; override;
57

58
      property ContentList: TStrings read FContentList;
59

60
      property CompressionLevel: TCompressionLevel
61
               read FCompressionLevel
62
               write SetCompressionLevel default clNone;
63

64
      procedure Clear; virtual;abstract;
65

66
      function ContentExists(ContentName: string): boolean;virtual;abstract;
67

68
      function GetContent(Stream: TStream; index: integer): TStream; overload;virtual;abstract;
69
      function GetContent(ContentName: string): TStream; overload;virtual;abstract;
70
      function GetContent(index: integer): TStream; overload;virtual;abstract;
71

72
      function GetContentSize(index: integer): integer; overload;virtual;abstract;
73
      function GetContentSize(ContentName: string): integer; overload;virtual;abstract;
74

75
      procedure AddFromStream(ContentName, Path: string; FS: TStream);virtual;abstract;
76
      procedure AddFromFile(FileName, Path: string);virtual;abstract;
77

78
      procedure RemoveContent(index: integer); overload;virtual;abstract;
79
      procedure RemoveContent(ContentName: string); overload;virtual;abstract;
80

81
      procedure Extract(index: integer; NewName: string); overload; virtual;abstract;
82
      procedure Extract(ContentName, NewName: string); overload; virtual;abstract;
83
  end;
84

85
  TGLBaseArchiveClass = class of TGLBaseArchive;
86

87
  //****************************************************************************
88

89
  //Классы регистрации архивов, для того что бы по расшырениям архива можно было
90
  //использовать соответсвующий архиватор. Например: GLFilePak,GLFileZLib
91

92
  {TArchiveFileFormat}
93
  {Запись для зарегестрированного класса}
94

95
  TArchiveFileFormat = class
96
  public
97
    BaseArchiveClass: TGLBaseArchiveClass;
98
    Extension: string;
99
    Description: string;
100
    DescResID: Integer;
101
  end;
102

103
  {TGLArchiveFileFormatsList}
104
  {Список зарегестрированных классов}
105

106
  TGLArchiveFileFormatsList = class(TPersistentObjectList)
107
  public
108
     
109
    destructor Destroy; override;
110

111
    procedure Add(const Ext, Desc: string; DescID: Integer; AClass:
112
      TGLBaseArchiveClass);
113
    function FindExt(ext: string): TGLBaseArchiveClass;
114
    function FindFromFileName(const fileName: string): TGLBaseArchiveClass;
115
    procedure Remove(AClass: TGLBaseArchiveClass);
116
  end;
117

118
  //*****************************************************************************
119

120
  //Для одновременной работы с несколькими архивами ввел коллекции
121

122
  { TLibArchive }
123
  {Итем для работы с одним архивом}
124

125
  TLibArchive = class(TCollectionItem)
126
  private
127
     
128
      vArchive: TGLBaseArchive;
129
      ArcClass: TGLBaseArchiveClass;
130
      FFileName:  string;
131
      FName: string;
132
      procedure SetCompressionLevel(aValue: TCompressionLevel);
133
      function GetCompressionLevel: TCompressionLevel;
134
      function GetContentList: TStrings;
135
      procedure SetName(const val: string);
136
  protected
137
     
138
      function GetDisplayName: string; override;
139
  public
140
     
141
    constructor Create(ACollection: TCollection); override;
142
    destructor Destroy; override;
143

144
    property CompressionLevel: TCompressionLevel
145
               read GetCompressionLevel
146
               write SetCompressionLevel default clNone;
147

148
    procedure CreateArchive(FileName: string;
149
              OverwriteExistingFile: boolean = False);
150

151
    property ContentList: TStrings read GetContentList;
152

153
    procedure LoadFromFile(aFileName: string); overload;
154
    procedure LoadFromFile(aFileName, aAchiverType: string); overload;
155

156
    procedure Clear;
157

158
    function ContentExists(aContentName: string): boolean;
159
    property FileName: string read FFileName;
160

161
    function GetContent(aindex: integer): TStream; overload;
162
    function GetContent(aContentName: string): TStream; overload;
163

164
    function GetContentSize(aindex: integer): integer; overload;
165
    function GetContentSize(aContentName: string): integer; overload;
166

167
    procedure AddFromStream(aContentName, aPath: string; aF: TStream); overload;
168
    procedure AddFromStream(aContentName: string; aF: TStream); overload;
169

170
    procedure AddFromFile(aFileName, aPath: string); overload;
171
    procedure AddFromFile(aFileName: string); overload;
172

173
    procedure RemoveContent(aindex: integer); overload;
174
    procedure RemoveContent(aContentName: string); overload;
175

176
    procedure Extract(aindex: integer; aNewName: string); overload;
177
    procedure Extract(aContentName, aNewName: string); overload;
178
  published
179
    property Name: string read FName write SetName;
180
  end;
181

182
  { TLibArchives }
183

184
  TLibArchives = class(TOwnedCollection)
185
  protected
186
     
187
    procedure SetItems(index: Integer; const val: TLibArchive);
188
    function GetItems(index: Integer): TLibArchive;
189
  public
190
     
191
    constructor Create(AOwner: TComponent);
192

193
    function Owner: TPersistent;
194

195
    function IndexOf(const Item: TLibArchive)                  : Integer;
196
    function Add: TLibArchive;
197
    function FindItemID(ID: Integer)                           : TLibArchive;
198
    property Items[index: Integer]: TLibArchive read GetItems
199
                                                write SetItems; default;
200
    //Ищем архиватор по именыи открытого архива
201
    function GetArchiveByFileName(const AName: string)         : TLibArchive;
202
    function GetFileNameOfArchive(aValue: TLibArchive)         : string;
203
    //ищем нужный итем
204
    function MakeUniqueName(const nameRoot: string)            : string;
205
    function GetLibArchiveByName(const AName: string)          : TLibArchive;
206
    function GetNameOfLibArchive(const Archive: TLibArchive)  : string;
207
  end;
208

209
  //*****************************************************************************
210
  //Компонента VCL для работы с архивами.
211

212
  { TGLSArchiveManager }
213

214
  TGLSArchiveManager = class(TComponent)
215
    Private
216
      FArchives: TLibArchives;
217
      Procedure SetArchives(aValue: TLibArchives);
218
    Public
219
      constructor Create(AOwner: TComponent); override;
220
      destructor Destroy; override;
221
      function GetArchiveByFileName(const aName: string): TLibArchive;
222
      function GetFileNameOfArchive(const aArchive: TLibArchive): string;
223
      function GetContent(aContentName: string): TStream;
224
      function ContentExists(aContentName: string): boolean;
225
      function OpenArchive(aFileName: string): TLibArchive; overload;
226
      function OpenArchive(aFileName, aAchiverType: string): TLibArchive; overload;
227
      procedure CloseArchive(aArchive: TLibArchive);
228
    Published
229
      property Archives: TLibArchives read FArchives write SetArchives;
230
  end;
231

232
  //****************************************************************************
233
  //Другое
234

235

236
  EInvalidArchiveFile = class(Exception);
237

238
  //Получение класса доступных архиваторов
239
  function GetArchiveFileFormats: TGLArchiveFileFormatsList;
240

241
  //Регистрация архиватора.
242
  procedure RegisterArchiveFormat(const AExtension, ADescription: string;
243
    AClass: TGLBaseArchiveClass);
244
  procedure UnregisterArchiveFormat(AClass: TGLBaseArchiveClass);
245

246
  //Получение активного менеджера архивов
247
  //Внимание!!! Работает только для одного Менеджера Архивов
248
  function GetArchiveManager: TGLSArchiveManager;
249

250
  // GLApplicationFileIO
251
  //Эти функции служат для автоматизации загрузки
252
  //Пользователь вводит LoadFromFile а через эти функции получает результат.
253

254
  function ArcCreateFileStream(const fileName: string; mode: word): TStream;
255
  function ArcFileStreamExists(const fileName: string): boolean;
256

257
  // ------------------------------------------------------------------
258
  // ------------------------------------------------------------------
259
  // ------------------------------------------------------------------
260
implementation
261
// ------------------------------------------------------------------
262
// ------------------------------------------------------------------
263
// ------------------------------------------------------------------
264
Uses
265
  GLStrings;
266

267
var
268
  vArchiveFileFormats: TGLArchiveFileFormatsList;
269
  vArchiveManager: TGLSArchiveManager;
270

271
function GetArchiveFileFormats: TGLArchiveFileFormatsList;
272
begin
273
  if not Assigned(vArchiveFileFormats) then
274
    vArchiveFileFormats := TGLArchiveFileFormatsList.Create;
275
  Result := vArchiveFileFormats;
276
end;
277

278
procedure RegisterArchiveFormat(const AExtension, ADescription: string;
279
  AClass: TGLBaseArchiveClass);
280
begin
281
  RegisterClass(AClass);
282
  GetArchiveFileFormats.Add(AExtension, ADescription, 0, AClass);
283
end;
284

285
procedure UnregisterArchiveFormat(AClass: TGLBaseArchiveClass);
286
begin
287
  if Assigned(vArchiveFileFormats) then
288
    vArchiveFileFormats.Remove(AClass);
289
end;
290

291
function GetArchiveManager: TGLSArchiveManager;
292
begin
293
   Result := vArchiveManager;
294
end;
295

296
function ArcCreateFileStream(const fileName: string; mode: word): TStream;
297
begin
298
  If GetArchiveManager <> nil then
299
     with GetArchiveManager do
300
       if ContentExists(fileName) then
301
       begin
302
          Result := GetContent(fileName);
303
          Exit;
304
       end;
305
   if SysUtils.FileExists(fileName) then begin
306
      Result := TFileStream.Create(FileName, mode);
307
      Exit;
308
      //????
309
      //Не пойму зачем создавать файловый поток когда файл не найден
310
  { end
311
   else begin
312
      Result := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
313
      Exit;  }
314
   end;
315

316
   Result:=nil;
317
end;
318

319
function ArcFileStreamExists(const fileName: string): boolean;
320
begin
321
  If GetArchiveManager <> nil then
322
    with GetArchiveManager do
323
      if ContentExists(fileName) then
324
      begin
325
         Result:=True;
326
         Exit;
327
      end;
328
   Result := SysUtils.FileExists(fileName);
329
end;
330

331
//******************************************************************************
332
{ TLibArchive }
333

334
constructor TLibArchive.Create(ACollection: TCollection);
335
begin
336
  inherited Create(ACollection);
337
   FName := TLibArchives(ACollection).MakeUniqueName('LibArchive');
338
end;
339

340
destructor TLibArchive.Destroy;
341
begin
342
  Clear;
343
  inherited Destroy;
344
end;
345

346
procedure TLibArchive.SetCompressionLevel(aValue: TCompressionLevel);
347
begin
348
  if vArchive = nil then Exit;
349
  vArchive.CompressionLevel := aValue;
350
end;
351

352
function TLibArchive.GetCompressionLevel: TCompressionLevel;
353
begin
354
  Result := clNone;
355
  if vArchive = nil then Exit;
356
  Result := vArchive.CompressionLevel;
357
end;
358

359
procedure TLibArchive.CreateArchive(FileName: string;
360
              OverwriteExistingFile: boolean = False);
361
var
362
  fFile: TFileStream;
363
begin
364
  if OverwriteExistingFile or not SysUtils.FileExists(FileName) then
365
  begin
366
   fFile := TFileStream.Create(FileName, fmCreate);
367
   fFile.Free;
368
  end;
369
end;
370

371
procedure TLibArchive.LoadFromFile(aFileName: string);
372
var
373
  ext: string;
374
begin
375
  ext := LowerCase(ExtractFileExt(aFileName));
376
  Delete(ext,1,1);
377
  LoadFromFile(aFileName, ext);
378
end;
379

380
procedure TLibArchive.LoadFromFile(aFileName, aAchiverType: string);
381
begin
382
  if not SysUtils.FileExists(aFileName) then
383
    Exit;
384
  ArcClass := GetArchiveFileFormats.FindExt(aAchiverType);
385
  If ArcClass=nil then
386
  begin
387
       raise Exception.Create(ClassName+': Unable to find module archiver to expand '+ aAchiverType);
388
       exit;
389
  end;
390
  vArchive := ArcClass.Create(nil);
391
  vArchive .LoadFromFile(aFileName);
392
  FFileName := aFileName;
393
end;
394

395
procedure TLibArchive.Clear;
396
begin
397
  if vArchive=nil then Exit;
398
  vArchive.Clear;
399
  vArchive.Free;
400
  ArcClass :=nil;
401
  FFileName := '';
402
end;
403

404
function TLibArchive.ContentExists(aContentName: string): boolean;
405
begin
406
  Result := false;
407
  if vArchive=nil then Exit;
408
  Result := vArchive.ContentExists(aContentName)
409
end;
410

411
function TLibArchive.GetContent(aindex: integer): TStream;
412
begin
413
  Result := nil;
414
  if vArchive=nil then Exit;
415
  Result := vArchive.GetContent(aindex)
416
end;
417

418
function TLibArchive.GetContent(aContentName: string): TStream;
419
begin
420
  Result := nil;
421
  if vArchive=nil then Exit;
422
  Result := vArchive.GetContent(aContentName)
423
end;
424

425
function TLibArchive.GetContentSize(aindex: integer): integer;
426
begin
427
  Result := -1;
428
  if vArchive=nil then Exit;
429
  Result := vArchive.GetContentSize(aindex)
430
end;
431

432
function TLibArchive.GetContentSize(aContentName: string): integer;
433
begin
434
  Result := -1;
435
  if vArchive=nil then Exit;
436
  Result := vArchive.GetContentSize(aContentName)
437
end;
438

439
procedure TLibArchive.AddFromStream(aContentName, aPath: string; aF: TStream);
440
begin
441
  if vArchive=nil then Exit;
442
  vArchive.AddFromStream(aContentName, aPath, aF)
443
end;
444

445
procedure TLibArchive.AddFromStream(aContentName: string; aF: TStream);
446
begin
447
  if vArchive=nil then Exit;
448
  vArchive.AddFromStream(aContentName, '', aF)
449
end;
450

451
procedure TLibArchive.AddFromFile(aFileName, aPath: string);
452
begin
453
  if vArchive=nil then Exit;
454
  vArchive.AddFromFile(aFileName, aPath)
455
end;
456

457
procedure TLibArchive.AddFromFile(aFileName: string);
458
begin
459
  if vArchive=nil then Exit;
460
  vArchive.AddFromFile(aFileName, '')
461
end;
462

463
procedure TLibArchive.RemoveContent(aindex: integer);
464
begin
465
  if vArchive=nil then Exit;
466
  vArchive.RemoveContent(aindex)
467
end;
468

469
procedure TLibArchive.RemoveContent(aContentName: string);
470
begin
471
  if vArchive=nil then Exit;
472
  vArchive.RemoveContent(aContentName)
473
end;
474

475
procedure TLibArchive.Extract(aindex: integer; aNewName: string);
476
begin
477
  if vArchive=nil then Exit;
478
  vArchive.Extract(aindex, aNewName)
479
end;
480

481
procedure TLibArchive.Extract(aContentName, aNewName: string);
482
begin
483
  if vArchive=nil then Exit;
484
  vArchive.Extract(aContentName, aNewName)
485
end;
486

487
function TLibArchive.GetContentList: TStrings;
488
begin
489
  Result := nil;
490
  if vArchive=nil then Exit;
491
  Result := vArchive.ContentList;
492
end;
493

494
procedure TLibArchive.SetName(const val: string);
495
begin
496
  if val <> FName then
497
  begin
498
    if not (csLoading in
499
      TComponent(TLibArchives(Collection).GetOwner).ComponentState) then
500
    begin
501
      if TLibArchives(Collection).GetLibArchiveByName(val) <> Self then
502
        FName := TLibArchives(Collection).MakeUniqueName(val)
503
      else
504
        FName := val;
505
    end
506
    else
507
      FName := val;
508
  end;
509
end;
510

511
function TLibArchive.GetDisplayName: string;
512
begin
513
  Result := Name;
514
end;
515

516
{ TLibArchives }
517

518
procedure TLibArchives.SetItems(index: Integer; const val: TLibArchive);
519
begin
520
  GetItems(Index).Assign(Val);
521
end;
522

523
function TLibArchives.GetItems(index: Integer): TLibArchive;
524
begin
525
  Result := TLibArchive(inherited GetItem(Index));
526
end;
527

528
constructor TLibArchives.Create(AOwner: TComponent);
529
begin
530
  inherited Create(AOwner, TLibArchive);
531
end;
532

533
function TLibArchives.Owner: TPersistent;
534
begin
535
  Result := GetOwner;
536
end;
537

538
function TLibArchives.IndexOf(const Item: TLibArchive): Integer;
539
var
540
  I: Integer;
541
begin
542
  Result := -1;
543
  if Count <> 0 then
544
    for I := 0 to Count - 1 do
545
      if GetItems(I) = Item then
546
      begin
547
        Result := I;
548
        Exit;
549
      end;
550
end;
551

552
function TLibArchives.Add: TLibArchive;
553
begin
554
  Result := (inherited Add) as TLibArchive;
555
end;
556

557
function TLibArchives.FindItemID(ID: Integer): TLibArchive;
558
begin
559
  Result := (inherited FindItemID(ID)) as TLibArchive;
560
end;
561

562
function TLibArchives.GetArchiveByFileName(const AName: string): TLibArchive;
563
var
564
  i: Integer;
565
  Arc: TLibArchive;
566
begin
567
  for i := 0 to Count - 1 do
568
  begin
569
    Arc := TLibArchive(inherited Items[i]);
570
    if Arc.FileName = AName then
571
    begin
572
      Result := Arc;
573
      Exit;
574
    end;
575
  end;
576
  Result := nil;
577
end;
578

579
function TLibArchives.GetFileNameOfArchive(aValue: TLibArchive): string;
580
var
581
  ArcIndex: Integer;
582
begin
583
  ArcIndex := IndexOf(aValue);
584
  if ArcIndex <> -1 then
585
    Result := GetItems(ArcIndex).FileName
586
  else
587
    Result := '';
588
end;
589

590
function TLibArchives.MakeUniqueName(const nameRoot: string): string;
591
var
592
  i: Integer;
593
begin
594
  Result := nameRoot;
595
  i := 1;
596
  while GetLibArchiveByName(Result) <> nil do
597
  begin
598
    Result := nameRoot + IntToStr(i);
599
    Inc(i);
600
  end;
601
end;
602

603
function TLibArchives.GetLibArchiveByName(const AName: string): TLibArchive;
604
var
605
  i: Integer;
606
  Arc: TLibArchive;
607
begin
608
  for i := 0 to Count - 1 do
609
  begin
610
    Arc := TLibArchive(inherited Items[i]);
611
    if (Arc.Name = AName) then
612
    begin
613
      Result := Arc;
614
      Exit;
615
    end;
616
  end;
617
  Result := nil;
618
end;
619

620
function TLibArchives.GetNameOfLibArchive(const Archive: TLibArchive): string;
621
var
622
  MatIndex: Integer;
623
begin
624
  MatIndex := IndexOf(Archive);
625
  if MatIndex <> -1 then
626
    Result := GetItems(MatIndex).Name
627
  else
628
    Result := '';
629
end;
630

631
{ TGLArchiveFileFormatsList }
632
//******************************************************************************
633

634
destructor TGLArchiveFileFormatsList.Destroy;
635
begin
636
  Clean;
637
  inherited Destroy;
638
end;
639

640
procedure TGLArchiveFileFormatsList.Add(const Ext, Desc: string; DescID: Integer;
641
  AClass: TGLBaseArchiveClass);
642
var
643
  newRec: TArchiveFileFormat;
644
begin
645
  newRec := TArchiveFileFormat.Create;
646
  with newRec do
647
  begin
648
    Extension := AnsiLowerCase(Ext);
649
    BaseArchiveClass := AClass;
650
    Description := Desc;
651
    DescResID := DescID;
652
  end;
653
  inherited Add(newRec);
654
end;
655

656
function TGLArchiveFileFormatsList.FindExt(ext: string): TGLBaseArchiveClass;
657
var
658
  i: Integer;
659
begin
660
  ext := AnsiLowerCase(ext);
661
  for i := Count - 1 downto 0 do
662
    with TArchiveFileFormat(Items[I]) do
663
    begin
664
      if Extension = ext then
665
      begin
666
        Result := BaseArchiveClass;
667
        Exit;
668
      end;
669
    end;
670
  Result := nil;
671
end;
672

673
function TGLArchiveFileFormatsList.FindFromFileName(const fileName: string
674
  ): TGLBaseArchiveClass;
675
var
676
  ext: string;
677
begin
678
  ext := ExtractFileExt(Filename);
679
  System.Delete(ext, 1, 1);
680
  Result := FindExt(ext);
681
  if not Assigned(Result) then
682
    raise EInvalidArchiveFile.CreateFmt(glsUnknownExtension,
683
      [ext, 'GLFile' + UpperCase(ext)]);
684
end;
685

686
procedure TGLArchiveFileFormatsList.Remove(AClass: TGLBaseArchiveClass);
687
var
688
  i: Integer;
689
begin
690
  for i := Count - 1 downto 0 do
691
  begin
692
    if TArchiveFileFormat(Items[i]).BaseArchiveClass.InheritsFrom(AClass) then
693
      DeleteAndFree(i);
694
  end;
695
end;
696

697

698
//******************************************************************************
699

700
{ TGLBaseArchive }
701

702
procedure TGLBaseArchive.SetCompressionLevel(aValue: TCompressionLevel);
703
begin
704
  if FCompressionLevel <> aValue then
705
     FCompressionLevel := aValue;
706
end;
707

708
constructor TGLBaseArchive.Create(AOwner: TPersistent);
709
begin
710
  inherited Create(AOwner);
711
  FContentList := TStringList.Create;
712
  FCompressionLevel := clNone;
713
end;
714

715
destructor TGLBaseArchive.Destroy;
716
begin
717
  FContentList.Free;
718
  inherited Destroy;
719
end;
720

721
//******************************************************************************
722

723
{ TGLSArchiveManager }
724

725
constructor TGLSArchiveManager.Create(AOwner: TComponent);
726
begin
727
  inherited Create(AOwner);
728
  FArchives := TLibArchives.Create(self);
729
  vArchiveManager := Self;
730
  vAFIOCreateFileStream := ArcCreateFileStream;
731
  vAFIOFileStreamExists := ArcFileStreamExists;
732
end;
733

734
destructor TGLSArchiveManager.Destroy;
735
begin
736
  vArchiveManager := nil;
737
  FArchives.Free;
738
  inherited Destroy;
739
end;
740

741
procedure TGLSArchiveManager.SetArchives(aValue: TLibArchives);
742
begin
743
  FArchives.Assign(aValue);
744
end;
745

746
function TGLSArchiveManager.GetArchiveByFileName(const aName: string): TLibArchive;
747
begin
748
  Result := FArchives.GetArchiveByFileName(AName);
749
end;
750

751
function TGLSArchiveManager.GetFileNameOfArchive(const aArchive: TLibArchive): string;
752
begin
753
  Result := FArchives.GetFileNameOfArchive(aArchive)
754
end;
755

756
function TGLSArchiveManager.GetContent(aContentName: string): TStream;
757
var
758
  i: integer;
759
begin
760
  Result := nil;
761
  With FArchives do
762
    for i:=0 to Count-1 do
763
      if Items[i].ContentExists(aContentName) then
764
      begin
765
        Result := Items[i].GetContent(aContentName);
766
        Exit;
767
      end;
768
end;
769

770
function TGLSArchiveManager.ContentExists(aContentName: string): boolean;
771
var
772
  i: integer;
773
begin
774
    Result := false;
775
    With FArchives do
776
      for i:=0 to Count-1 do
777
        if Items[i].ContentExists(aContentName) then
778
        begin
779
          Result := Items[i].ContentExists(aContentName);
780
          Exit;
781
        end;
782
end;
783

784
function TGLSArchiveManager.OpenArchive(aFileName: string): TLibArchive;
785
begin
786
  Result := FArchives.Add;
787
  Result.LoadFromFile(aFileName);
788
end;
789

790
function TGLSArchiveManager.OpenArchive(aFileName, aAchiverType: string
791
  ): TLibArchive;
792
begin
793
  Result := FArchives.Add;
794
  Result.LoadFromFile(aFileName, aAchiverType);
795
end;
796

797
procedure TGLSArchiveManager.CloseArchive(aArchive: TLibArchive);
798
begin
799
  FArchives.Delete(FArchives.IndexOf(aArchive));
800
end;
801

802
initialization
803

804
  RegisterClasses([TGLSArchiveManager, TLibArchives]);
805

806
finalization
807

808
  FreeAndNil(vArchiveFileFormats);
809

810
end.
811