-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathFileManager.pas
2507 lines (2228 loc) · 84.3 KB
/
FileManager.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
unit FileManager;
{
Сохранение измененных файлов можно сделать только с помощью функции SaveAsDir
TODO:
Для кеша не подходит использование TDictionary - требуется переделать на другой класс
}
interface
uses Windows, SysUtils, Classes, System.Generics.Collections, System.Generics.Defaults,
Types, StrUtils, DirectoryManager, System.Threading, RecordUtils, System.IOUtils;
type
TCacheOperation = (
coDropNotChanged, //из кеша удаляются только объекты которые не менялись
coDropChanges, //из кеша удаляются все объекты
coSaveChanges //при удалении из кеша изменненые объекты будут записаны на свои реальные места
//данный вариант использовать осторожно, желательно только в редакторе, т.к. может перезаписать реальные файлы или данные в аддоне
);
TFileTypes = (
ftAllInFolder, //папки и файлы в указанной папке
ftFiles, //файлы в указанной папке
ftFolders, //папки в указанной папке
ftFilesInSubfolders //файлы в указанной папке и её подпапках
);
{
При сохранении к работе с потоком предъявляются следующие требования:
- по окончании вызова поток должен находится в позиции для записи новых байт
- в поток может производится только запись
- движения/поиск по потоку назад/вперед запрещены
Гарантии:
- размер потока возвращает размер реально записанных данных этой функцией (без учета сжатия)
}
TStreamOptions = set of (
soNoCompression, //запись в поток будет производиться без сжатия
soNeedReset, // доступна команда Position:= 0
soNeedSize, // доступно получение размера потока
soNeedSeekForward, // доступно перемещение вперёд по потоку
soNeedSeekBackward, // доступно перемещение назад по потоку
/// soNeedReset, soNeedSeekForward, soNeedSeekBackward вместе должны гарантировать перемещение в абсолютную позицию
soNeedDeffered, //уничтожением потока управляет сам объект
/// возвращает THandleStream
/// если soNeedDeffered, то должен быть не связан с потоком всего архива
/// soNeedReset, soNeedSize вынуждают создавать копию файла (чтобы размер и позиция совпадали с физическими)
/// если сочетание флагов (soNeedHandle, soNeedDeffered, soNeedReset, soNeedSize) не поддерживается аддоном,
/// то должен вернуть любой поток с поддержкой soNeedSize, менеджером будет автоматически созданвременный файл
soNeedHandle,
soNeedWrite
);
{
При изменении объект должен менять свою метку на текущую, получая ее у менеджера ресурсов
}
TChangeStamp = type LongWord;//NativeInt
const
csAllChanges = 0;
csIgnoreChanges = TChangeStamp(-1);
AddOnSign = 'GAO';
MinBlockSize = 128;
type
IFileObject = interface
function GetObject: TObject;
function GetChangeStamp: TChangeStamp;
procedure SaveToStream(AStream: TStream);
procedure ReloadObject(AStream: TStream);
procedure ResetChangeStamp;
end;
TObjectContainerEvent = procedure (AUserValue: Pointer);
TObjectContainer = record
UserValue: Pointer;
FileUpdated: TObjectContainerEvent;
FileDeleted: TObjectContainerEvent;
end;
TDelegatedInterface = class (TInterfacedObject)
private
FOwner: TObject;
protected
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
public
constructor Create(AOwner: TObject);
destructor Destroy; override;
procedure Disconnect;
end;
//использеутся для делегирования интерфейса IFileObject в безинтерфейсный тип
TFileObjectDelegate = class (TInterfacedObject)
private
FOwner: TObject;
FChanged: TChangeStamp;
protected
public
constructor Create(AOwner: TObject);
destructor Destroy; override;
function GetObject: TObject;
function GetChangeStamp: TChangeStamp;
procedure SetChangeStamp;
procedure ResetChangeStamp;
end;
//используется для делегирования интерфейса IFileObject в тип с интерфейсом
TFileObjectAggregated = class (TAggregatedObject)
private
FOwner: TObject;
FChanged: TChangeStamp;
protected
public
constructor Create(AOwner: TObject; const Controller: IInterface);
function GetObject: TObject;
function GetChangeStamp: TChangeStamp;
procedure SetChangeStamp;
procedure ResetChangeStamp;
end;
TSimpleFileObject = class (TInterfacedObject, IFileObject)
private
FChanged: TChangeStamp;
public
function GetObject: TObject;
function GetChangeStamp: TChangeStamp;
procedure SaveToStream(Stream: TStream); virtual;
procedure ReloadObject(AStream: TStream); virtual; abstract;
procedure ResetChangeStamp;
end;
TAddOnFileInfo = packed record //размер 32 байта
RealSize: UInt64; //размер несжатого файла
BlockCount: LongWord; //кол-во блоков под файл (-1 так как меньше одного не может быть)
BlockNumber: LongWord; //указатель на первый блок
NameNumber: UInt64;
CompressionAlg: Word;
Flags: Word;
FileCRC32: LongWord; //контрольная сумма всех блоков файла, лишние байты считаются нулевыми
end;
//с этого может начинаться блок
TAddOnFileTable = packed record //заголовок размером 32 байта
NextTableBlockNum: LongWord; //0 - следующего блока нет
FileCountInCurrentTable: LongWord;
NameBlocks: array [0..3] of LongWord;
HashBlocks: array [0..1] of LongWord; //дополнительные хеши
end;
PAddOnFileTable = ^TAddOnFileTable;
//с этого может начинаться блок
TAddOnHeader = packed record //основная часть размером 32 байта
Sign: array [0..3] of AnsiChar;
FileVersion: Word;
TableCount: Word; //кол-во таблиц размещения, помимо первой, которая в заголовке
BlockSize: LongWord; //размер блока деленный на 128, т.к. это минимальный размер
BlockCount: LongWord; // = (реальное кол-во - 1), т.к. первый блок включает в себя заголовок
//указатель на блоки с хешами, если хеш попадает на текущий блок с хешами,
//он считается после заполнения всех остальных хешей в этом блоке, считается, что текущий хеш нулевой
HashBlocks: array [0..3] of LongWord;
end;
PAddOnHeader = ^TAddOnHeader;
TAddOnFullHeader = packed record
Header: TAddOnHeader;
FirstFileTable: TAddOnFileTable;
Files: array [0..0] of TAddOnFileInfo;
end;
PAddOnFullHeader = ^TAddOnFullHeader;
//минимальный размер файла - 3 блока (1 - заголовок, 2 - имена, 3 - содержимое одного файла) - 128*3
IAddOn = interface
function FileExist(const FileName: string): Boolean;
function GetFile(const FileName: string; Options: TStreamOptions): TStream;
procedure GetFileList(List: TStrings);
end;
IWritableAddOn = interface
function CreateNewFile(const FileName: string; FileSize: Integer = 0): TStream;
procedure SaveToStream(Stream: TStream);
end;
TAddOn = class (TInterfacedObject, IAddOn, IWritableAddOn)
private
FStream: TStream;
FFileNames: TStringList;
FHeader: PAddOnFullHeader;
FFileTables: array of TAddOnFileTable;
protected
public
constructor Create;
destructor Destroy; override;
procedure OpenFromFile(const FileName: string; Mode: Word);
procedure LoadFromStream(Stream: TStream);
//поток содержит только этот аддон, временем жизни потока управляет этот аддон
procedure OpenFromOwnedStream(Stream: TStream);
function CreateNewFile(const FileName: string; FileSize: Integer = 0): TStream;
function OpenFile(const FileName: string): TStream;
procedure SaveToStream(Stream: TStream);
procedure AddNewFile(const Name: string; Obj: IFileObject);
function FileExist(const FileName: string): Boolean;
function GetFile(const FileName: string; Options: TStreamOptions): TStream;
procedure GetFileList(List: TStrings);
end;
TDirectoryCache = class;
TFileManager = class;
TCacheInstance = class
public
Next: TCacheInstance;
DirectoryCache: TDirectoryCache;
constructor Create(ANext: TCacheInstance; ADirectoryCache: TDirectoryCache);
end;
TCreateStream = function : TStream of object;
IFutureWithSoftCancel = interface (IFuture<IFileObject>)
['{3389434A-32C6-4C19-AAA4-7CF4A8C93F25}']
procedure SoftCancel;
function IsSoftCanceled: Boolean;
end;
TCacheData = class;
TThreadPoolHelper = class helper for TThreadPool
class function GetObjectCachesPublic: TObjectCaches;
end;
TFileObjectLoader = class sealed(TTask, IFutureWithSoftCancel)
private
FResult: IFileObject;
FSoftCanceled: Boolean;
class constructor Create;
procedure RunEvent(Sender: TObject);
protected
function Start: IFuture<IFileObject>;
function GetValue: IFileObject;
procedure SoftCancel;
function IsSoftCanceled: Boolean;
constructor Create(Sender: TCacheData; APool: TThreadPool);
public
class function CurrentTask: IFutureWithSoftCancel; static; inline;
class function Future(AFileData: TCacheData; APool: TThreadPool = nil): IFutureWithSoftCancel; overload; static; inline;
class function TrySync(AFileData: TCacheData; APool: TThreadPool = nil): IFutureWithSoftCancel; static; inline;
end;
TFileObjectCreator = function (Self: Pointer; Manager: TFileManager; const RealPath: string): IFileObject; register;
TFileObjectCreatorObj = function (Manager: TFileManager; const RealPath: string): IFileObject of object; register;
TFileChanged = procedure (ACache: TCacheData) of object;
TCacheData = class (TInterfacedObject)
strict private
FTask: IFutureWithSoftCancel;
FManager: TFileManager;
Instance: TCacheInstance; //содержит все ссылки на данную запись
private
FFileObject: IFileObject;
public
AddOn: IAddOn;
RealPath: string; //для аддонов содержит название в рамках аддона
IsSaved: Boolean;
Options: TStreamOptions;
function IsCreated: Boolean; inline;
constructor Create(AManager: TFileManager);
function CreateStream: TStream;
function LoadAsync(ACreator: TFileObjectCreatorObj): IFutureWithSoftCancel;
function TryLoadSync(ACreator: TFileObjectCreatorObj): IFutureWithSoftCancel;
function Load: IFileObject;
procedure ClearCache(Initiator: TDirectoryCache; const Name: string);
procedure AddDirectory(Dir: TDirectoryCache);
end;
TFileInfo = class;
TNamedObject = class
private
FName: string;
FFileManager: TFileManager;
protected
public
property Name: string read FName;
constructor Create(AFileManager: TFileManager);
end;
TNamedObjectRec = record
ObjectClass: TClass;
Name: string;
end;
TFileLink = class (TNamedObject)
private
FFileInfo: TFileInfo;
FSubscriptions: TListRecord<TObjectContainer>;
FFullName: string;
function GetIsAddOn: Boolean; inline;
protected
public
constructor Create(AFileInfo: TFileInfo; AFileManager: TFileManager; const AFullName: string);
property FullName: string read FFullName;
function GetFileStream(Options: TStreamOptions): TStream;
function HasSubscribers: Boolean;
property IsAddOn: Boolean read GetIsAddOn;
procedure DoUpdateFile;
procedure DoDeleteFile;
procedure Subscribe(const AContainer: TObjectContainer);
procedure Unsubscribe(const AContainer: TObjectContainer);
destructor Destroy; override;
end;
TFileInfo = class
private
FAddOn: IAddOn;
FRealPath: string; //для аддонов содержит название в рамках аддона
public
property AddOn: IAddOn read FAddOn;
property RealPath: string read FRealPath;
constructor Create(const AAddOn: IAddOn; const ARealPath: string);
function Equals(Obj: TObject): Boolean; override;
function GetHashCode: Integer; override;
end;
TMaskLoader = record
FileExt: string;
LoaderFunction: TFileObjectCreatorObj;
StreamOptions: TStreamOptions;
end;
TLoadedAddOn = record
Root: string;
AddOn: IAddOn;
end;
TFolderConnect = record
Root: string; //виртуальный
Folder: string; //реальный путь
end;
TSaveOptions = class
private
protected
public
end;
TAddOnFile = record
FileName: string;
AddOn: IAddOn;
end;
PAddOnFile = ^TAddOnFile;
TNamedObjectComparer = class (TInterfacedObject, IComparer<TNamedObject>)
public
function Compare(const Left, Right: TNamedObject): Integer;
end;
TDirectoryCache = class (TNamedObject)
private class var
FDirectoryComparer: IComparer<TNamedObject>;
public
class property DirectoryComparer: IComparer<TNamedObject> read FDirectoryComparer;
class constructor Create;
private
FFolders: TListRecord<TDirectoryCache>;
FFiles: TListRecord<TFileLink>;
function GetDirectory(const Name: string): TDirectoryCache; overload;
function GetDirectory(const List: array of string): TDirectoryCache; overload;
function GetFileCache(const Name: string): TFileLink;
function GetDirectoryCache(AIndex: Integer): TDirectoryCache; inline;
function GetFileLink(AIndex: Integer): TFileLink; inline;
function GetFilesCount: Integer; inline;
function GetFoldersCount: Integer; inline;
strict protected
function FindFolder(const S: string; var Index: Integer): Boolean;
function FindFile(const S: string; var Index: Integer): Boolean;
protected
public
procedure RecursiveDropNotChanged;
function TryGetFileData(const AName: string; out ADir: TDirectoryCache; out AFileIndex: Integer): Boolean;
constructor Create(const AName: string; AFileManager: TFileManager);
property Directory[const Name: string]: TDirectoryCache read GetDirectory;
property FileCache[const Name: string]: TFileLink read GetFileCache;
property FilesCount: Integer read GetFilesCount;
property FoldersCount: Integer read GetFoldersCount;
property Files[Index: Integer]: TFileLink read GetFileLink;
property Folders[Index: Integer]: TDirectoryCache read GetDirectoryCache;
function TryFileLink(const Name: string; var Cache: TFileLink): Boolean;
procedure AddFileLink(const Name: string; Cache: TFileLink);
procedure Clear(DoSave: Boolean);
destructor Destroy; override;
function IsEmpty: Boolean;
end;
{$MESSAGE WARN 'Добавить поддержку вложенных пакетов'}
TFileManagerBatchConnection = record
private
FManager: TFileManager;
FConnectedFolders: TListRecord<TFolderConnect>;
FDisconnectedAddOns: TListRecord<IAddOn>;
FDisconnectedFolders: TListRecord<string>;
procedure ConnectDirectory(const ANewFolder: TFolderConnect);
procedure DisconnectAddOn(const AAddOn: IAddOn);
procedure DisconnectDirectory(const ARelativePath: string);
public
procedure BeginUpdate(AManager: TFileManager);
procedure EndUpdate;
end;
PFileManagerBatchConnection = ^TFileManagerBatchConnection;
{Принцип работы:
при запросе файла происходит поиск в кеше (поиск среди проинициализированных), если в кеше есть запись, то выдается она,
далее ищется файл в файловой системе, если находится, то создается запись в кеше (помечается как ФС),
иначе ищется в текущих загруженных аддонах
текущие загруженные аддоны так же являются кешем, по этой причине если дело дошло до поиска файла в
файловой системе, то если запись есть в кеше, но не была найдена в ФС, она помечается как отсутствующая
в ФС и больше не ищется там при следующих обращениях, пока кеш не очистят.
}
TFileManager = class
private
FRootDirectory: string;
FResourceLoaders: TList<TMaskLoader>;
FLoadedAddOns: TList<TLoadedAddOn>;
FFolderConnects: TList<TFolderConnect>;
FFileLinks: TDictionary<TFileInfo, TList<TFileLink>>;
FFileObjects: TDictionary<TFileInfo, TList<IFileObject>>;
FAddOnFiles: TDictionary<{$IFDEF DEBUG}IAddOn{$ELSE}Pointer{$ENDIF}, TList<TFileInfo>>;
FOnLoaderNotFound: TFileObjectCreatorObj;
FCache: TDirectoryCache;
FCurrentStamp: TChangeStamp;
FNextRound: Boolean;
FBatchProcessor: PFileManagerBatchConnection;
protected
property LoadedAddOns: TList<TLoadedAddOn> read FLoadedAddOns;
property FolderConnects: TList<TFolderConnect> read FFolderConnects;
procedure SetRootDirectory(const ARootDirectory: string);
function GetLoaderByName(const FileName: string; var Options: TStreamOptions): TFileObjectCreatorObj;
procedure DisconnectDirectory(Index: Integer); overload;
procedure OnCacheNotify(Sender: TObject; const Item: TCacheData; Action: TCollectionNotification);
//данные функции принимают уже обработанные строки (в нижнем регистре, с развернутыми путями)
{
Добавляет запись в кеш, гарантируя целостность относительных ссылок
RealFile - наименование реального файла
RelativePath - наименование виртуального файла
если файл реальный, то эти переменные совпадают
}
procedure DetachFileLink(AFileLink: TFileLink);
function AddFileLink(const RealFile, RelativePath: string; AddOn: PAddonFile; IsVirtual: Boolean = False): TFileLink;
function EnsureFileInfo(const AFileName: string; const AAddOn: IAddon): TFileInfo;
function TryCacheNote(const RelativePath: string; CreateNew: Boolean = False): TCacheData;
function TryFileLink(const RelativePath: string; CreateNew: Boolean = False): TFileLink;
function TryFileInfo(const FullDir: string; CreateNew: Boolean = False): TFileInfo;
function GetFileStream(Cache: TFileInfo; Options: TStreamOptions): TStream; overload;
function DoGetObject(const FileName: string; Func: TFileObjectCreatorObj; Options: TStreamOptions; TrySync: Boolean): IFutureWithSoftCancel;
procedure DoResetFileAfterConnect(const ANewFolder: TFolderConnect);
procedure DoResetFileAfterDisconnect(const ARelativePath: string); overload;
procedure DoResetFileAfterDisconnect(const AAddOn: IAddOn); overload;
procedure ActualizeFileCache(ADir: TDirectoryCache; AFileIndex: Integer; const ARelativeName: string; AForce: Boolean = False);
procedure ChangeLink(AFileLink: TFileLink; ANewInfo: TFileInfo);
procedure DropNotChanged(Dir: TDirectoryCache);
procedure DropAll(Dir: TDirectoryCache);
procedure DropWithSave(Dir: TDirectoryCache);
public
procedure LogAll;
///<summary>Исправляет название и приводит его к относительному виду</summary>
function TranslateFileName(const FileName: string): string;
function FullFileName(const FileName: string): string;
constructor Create(const ARootDirectory: string = '');
destructor Destroy; override;
property RootDirectory: string read FRootDirectory write SetRootDirectory;
property OnLoaderNotFound: TFileObjectCreatorObj read FOnLoaderNotFound write FOnLoaderNotFound;
{
Поиск загруженного объекта, если объект не загружен, то вернет nil
}
function FindObject(const FileName: string): IFileObject;
procedure SetObject(const FileName: string; AObject: IFileObject);
function GetObject(const FileName: string; Func: TFileObjectCreator; UserValue: Pointer; Options: TStreamOptions = []): IFileObject; overload;
function GetObject(const FileName: string; Func: TFileObjectCreatorObj = nil; Options: TStreamOptions = []): IFileObject; overload;
function GetObjectAsync(const FileName: string; Func: TFileObjectCreator; UserValue: Pointer; Options: TStreamOptions = []): IFutureWithSoftCancel; overload;
function GetObjectAsync(const FileName: string; Func: TFileObjectCreatorObj = nil; Options: TStreamOptions = []): IFutureWithSoftCancel; overload;
function GetFileStream(const FileName: string; Options: TStreamOptions): TStream; overload;
function GetFileLink(const FileName: string; ACreateNew: Boolean = False): TFileLink;
function FileExists(const FileName: string): Boolean; inline;
{
Совершенно временное решение, жуткий костыль, так в реальности работать не может
}
function GetRealFileName(const FileName: string): string;
procedure CopyFile(const AFileNameFrom, AFileNameTo: string);
procedure DeleteFile(const AFileName: string);
procedure LoadAddOn(const AddOn: string);
{
Подключение новых папок или аддонов имеет следующие особенности:
-если OldName (для папок) имеется в загруженных аддонах, то данные из этой папки аддонов так же будут доступны при обращении в Directory
-изначально файл ищется в новой папке доступной по пути, потом ищется в
аддонах по пути и только потом, если нигде не был найден ищется в реальном пути и аддонах подключенных к реальному пути
-так же добавленые файлы таким образом сбросит кеш для файлов которые попадают в Directory(пока не реализовано)
-в случае пересечения папок перенаправления приоритет имею последние добавленные перенаправления
-перегрузка папки которой перегружают другую папку не влияет на изначальную перегрузку.
Пример:
у нас есть файлы:
test/main.txt
test/First/main.txt
test/Second/main.txt
перегружаем test через test/First, теперь test/main.txt = test/First/main.txt
если перегрузить test/First через test/Second, то для test/main.txt ничего не поменяется,
но test/First/main.txt = test/Second/main.txt
порядок перегрузки ничего не изменит
-перегрузки работают слоями, приоритет имеют последние перенаправления (при выборе каждый слой считается пмонолитным,
т.е. на него работают правила реальных папок)
-в реальных папках приоритет за реальными файлами, после идут подключенные в эту папку аддоны
}
procedure ConnectAddOnAs(const AddOn: IAddOn; Directory: string); overload;
procedure ConnectAddOnAs(const AddOn, Directory: string); overload;
function ConnectDirectoryAs(const OldName, Directory: string): Integer;
procedure DisconnectAddOn(const AddOn: IAddOn; Directory: string);
procedure DisconnectDirectory(OldName, Directory: string); overload;
procedure DisconnectAll;
procedure UpdateAddOn(const AddOn: IAddOn);
procedure ExternalFileChange(const AFileName: string);
{
функция так же создает кеши под все найденные файлы, но пустые, без загрузки самих данных
}
function GetFilesInDir(Directory, FileMask: string; List: TStrings; FileType: TFileTypes = ftFiles): Integer;
{
TODO: Необходимо исправить сохранение один раз для файлов загруженных через виртуальный каталог
сейчас оно происходит дважды, т.к. на файл ссылаются в двух местах
}
procedure ResetCache(const Directory: string = ''; CacheOperation: TCacheOperation = coDropChanges);
{
Root - папка в которой ищутся файлы для сохранения
Filter - список папок и/или файлов для сохранения, если название заканчивается на слэш, то считается папкой
путь считается от Root
Пустые папки не сохраняются
}
procedure SaveAsDir(Directory: string; Root: string = ''; Filter: TStrings = nil; OnlyChanged: TChangeStamp = csIgnoreChanges; ResetChanged: Boolean = True);
procedure SaveAsFile(const FileName: string; Root: string = ''; Filter: TStrings = nil; OnlyChanged: TChangeStamp = csIgnoreChanges; ResetChanged: Boolean = True);
procedure SaveAsStream(Stream: TStream; Root: string = ''; Filter: TStrings = nil; OnlyChanged: TChangeStamp = csIgnoreChanges; ResetChanged: Boolean = True);
procedure AddResourceLoader(Func: TFileObjectCreator; FileExt: string; UserValue: Pointer = nil; StreamOptions: TStreamOptions = []); overload;
procedure AddResourceLoader(Func: TFileObjectCreatorObj; FileExt: string; StreamOptions: TStreamOptions = []); overload;
property CurrentStamp: TChangeStamp read FCurrentStamp;
function IsChangedObject(const FO: IFileObject): Boolean; overload; inline;
function IsChangedObject(const FO: IFileObject; Current: TChangeStamp): Boolean; overload; inline;
function NextStamp: TChangeStamp;
procedure LockManager;
procedure UnlockManager;
end;
TLowerCaseStringList = class (TStringList)
protected
procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
end;
const
WrongPathDelim = {$IFDEF MSWINDOWS} '/'; {$ELSE} '\'; {$ENDIF}
var FM: TFileManager;
implementation
uses
SysTypes;
{ TFileManager }
function TFileManager.IsChangedObject(const FO: IFileObject): Boolean;
begin
Result:= FO.GetChangeStamp <> 0;
end;
function TFileManager.IsChangedObject(const FO: IFileObject;
Current: TChangeStamp): Boolean;
begin
Result:= FO.GetChangeStamp >= Current;
end;
function TFileManager.FileExists(const FileName: string): Boolean;
begin
Result:= GetFileLink(FileName) <> nil;
end;
procedure TFileManager.ActualizeFileCache(ADir: TDirectoryCache; AFileIndex: Integer; const ARelativeName: string; AForce: Boolean);
var
f: TFileLink;
FullDir: string;
fInfo: TFileInfo;
begin
f:= ADir.Files[AFileIndex];
if f.HasSubscribers then begin
FullDir:= ExpandFileNameEx(FRootDirectory, ARelativeName);
fInfo:= TryFileInfo(FullDir, False);
if fInfo <> nil then begin
if f.FFileInfo <> fInfo then
ChangeLink(f, fInfo)
else if AForce then
f.DoUpdateFile;
Exit;
end;
end;
DetachFileLink(f);
f.Destroy;
ADir.FFiles.Delete(AFileIndex);
end;
function TFileManager.AddFileLink(const RealFile, RelativePath: string; AddOn: PAddonFile; IsVirtual: Boolean): TFileLink;
var fInfo: TFileInfo;
l: TList<TFileLink>;
begin
if AddOn <> nil then
fInfo:= EnsureFileInfo(AddOn.FileName, AddOn.AddOn)
else
fInfo:= EnsureFileInfo(RealFile, nil);
if not FFileLinks.TryGetValue(fInfo, l) then
raise Exception.Create('List must exists');
Result:= TFileLink.Create(fInfo, Self, RelativePath);
l.Add(Result);
FCache.AddFileLink(RelativePath, Result);
end;
procedure TFileManager.AddResourceLoader(Func: TFileObjectCreatorObj;
FileExt: string; StreamOptions: TStreamOptions);
var ml: TMaskLoader;
i: Integer;
begin
FileExt:= AnsiLowerCase(FileExt);
if FileExt[1] <> '.' then
FileExt:= '.' + FileExt;
for i := 0 to FResourceLoaders.Count - 1 do
if FResourceLoaders[i].FileExt = FileExt then
raise Exception.Create('Загрузчик для расширения ''' + FileExt + ''' уже задан');
ml.LoaderFunction:= Func;
ml.FileExt:= FileExt;
ml.StreamOptions:= StreamOptions;
FResourceLoaders.Add(ml);
end;
procedure TFileManager.AddResourceLoader(Func: TFileObjectCreator;
FileExt: string; UserValue: Pointer; StreamOptions: TStreamOptions);
var tmp: TFileObjectCreatorObj;
begin
TMethod(tmp).Code:= Pointer(@Func);
TMethod(tmp).Data:= UserValue;
AddResourceLoader(tmp, FileExt, StreamOptions);
end;
procedure TFileManager.ChangeLink(AFileLink: TFileLink; ANewInfo: TFileInfo);
var l: TList<TFileLink>;
begin
if not FFileLinks.TryGetValue(ANewInfo, l) then
raise Exception.Create('FileLink must exists');
DetachFileLink(AFileLink);
AFileLink.FFileInfo:= ANewInfo;
l.Add(AFileLink);
AFileLink.DoUpdateFile;
end;
procedure TFileManager.ConnectAddOnAs(const AddOn, Directory: string);
var lAddOn: TAddOn;
begin
lAddOn:= TAddOn.Create;
ConnectAddOnAs(lAddOn, Directory);
end;
procedure TFileManager.ConnectAddOnAs(const AddOn: IAddOn; Directory: string);
var la: TLoadedAddOn;
begin
LockManager;
try
la.AddOn:= AddOn;
la.Root:= IncludeTrailingPathDelimiter(ExpandFileNameEx(FRootDirectory, TranslateFileName(Directory)));
FLoadedAddOns.Add(la);
finally
UnlockManager;
end;
end;
function TFileManager.ConnectDirectoryAs(const OldName, Directory: string): Integer;
var fc: TFolderConnect;
path: string;
begin
LockManager;
try
path:= TranslateFileName(Directory);
{$MESSAGE WARN 'why?'}
{if not IsRelativePath(path) then
raise Exception.Create('Directory must be relative path');}
fc.Root:= IncludeTrailingPathDelimiter(ExpandFileNameEx(FRootDirectory, path));
fc.Folder:= IncludeTrailingPathDelimiter(ExpandFileNameEx(FRootDirectory, TranslateFileName(OldName)));
Result:= FFolderConnects.Add(fc);
DoResetFileAfterConnect(fc);
finally
UnlockManager;
end;
end;
procedure TFileManager.CopyFile(const AFileNameFrom, AFileNameTo: string);
var ffrom, fto: TFileLink;
RelativePath: string;
lDest, lSource: TStream;
begin
RelativePath:= TranslateFileName(AFileNameFrom);
ffrom:= TryFileLink(RelativePath, False);
if ffrom = nil then
raise EFileNotFoundException.Create(RelativePath);
RelativePath:= TranslateFileName(AFileNameTo);
fto:= TryFileLink(RelativePath, True);
if ffrom.IsAddOn or fto.IsAddOn then begin
lSource:= ffrom.GetFileStream([soNeedSize]);
try
lDest:= fto.GetFileStream([soNeedWrite]);
try
lDest.CopyFrom(lSource, lSource.Size);
finally
lDest.Free;
end;
finally
lSource.Free;
end;
end else begin
RelativePath:= ExtractFileDir(fto.FFileInfo.RealPath);
TDirectory.CreateDirectory(RelativePath);
TFile.Copy(ffrom.FFileInfo.RealPath, fto.FFileInfo.RealPath, True);
end;
ExternalFileChange(AFileNameTo);
end;
constructor TFileManager.Create(const ARootDirectory: string);
begin
FRootDirectory:= IncludeTrailingPathDelimiter(AnsiLowerCase(ReplaceStr(ARootDirectory, WrongPathDelim, PathDelim)));
FFileLinks:= TObjectDictionary<TFileInfo, TList<TFileLink>>.Create([doOwnsKeys, doOwnsValues]);
FAddOnFiles:= TObjectDictionary<{$IFDEF DEBUG}IAddOn{$ELSE}Pointer{$ENDIF}, TList<TFileInfo>>.Create([doOwnsValues]);
FResourceLoaders:= TList<TMaskLoader>.Create;
FLoadedAddOns:= TList<TLoadedAddOn>.Create;
FFolderConnects:= TList<TFolderConnect>.Create;
FCache:= TDirectoryCache.Create('', Self);
FCurrentStamp:= 1;
end;
procedure TFileManager.DeleteFile(const AFileName: string);
var fileName: TFileLink;
RelativePath: string;
lDest, lSource: TStream;
begin
RelativePath:= TranslateFileName(AFileName);
fileName:= TryFileLink(RelativePath, False);
if fileName = nil then
raise EFileNotFoundException.Create(RelativePath);
if fileName.IsAddOn then
raise ENotImplemented.Create('Deleting a file from the addon is not yet implemented.')
else
TFile.Delete(fileName.FFileInfo.RealPath);
ExternalFileChange(AFileName);
end;
destructor TFileManager.Destroy;
begin
DisconnectAll;
FCache.Free;
FFileLinks.Free;
FResourceLoaders.Free;
FLoadedAddOns.Free;
FAddOnFiles.Free;
FFolderConnects.Free;
inherited;
end;
procedure TFileManager.DetachFileLink(AFileLink: TFileLink);
begin
with FFileLinks[AFileLink.FFileInfo] do begin
Remove(AFileLink);
if Count = 0 then begin
if AFileLink.FFileInfo.FAddOn <> nil then
FAddOnFiles[{$IFNDEF DEBUG}Pointer({$ENDIF}AFileLink.FFileInfo.FAddOn{$IFNDEF DEBUG}){$ENDIF}].Remove(AFileLink.FFileInfo);
FFileLinks.Remove(AFileLink.FFileInfo);
end;
end;
end;
procedure TFileManager.DisconnectAddOn(const AddOn: IAddOn; Directory: string);
var
i: Integer;
old: IAddOn;
begin
if AddOn = nil then
Exit;
Directory:= FullFileName(Directory);
for i := 0 to FLoadedAddOns.Count - 1 do
if (FLoadedAddOns[i].AddOn = AddOn) and (FLoadedAddOns[i].Root = Directory) then begin
old:= FLoadedAddOns[i].AddOn;
FLoadedAddOns.Delete(i);
DoResetFileAfterDisconnect(old);
Exit;
end;
end;
procedure TFileManager.DisconnectAll;
var batch: TFileManagerBatchConnection;
begin
batch.BeginUpdate(Self);
try
while FFolderConnects.Count > 0 do
DisconnectDirectory(FFolderConnects.Count - 1);
while FLoadedAddOns.Count > 0 do with FLoadedAddOns.Last do
DisconnectAddOn(AddOn, Root);
finally
batch.EndUpdate;
end;
end;
procedure TFileManager.DisconnectDirectory(Index: Integer);
var fc: TFolderConnect;
path: string;
begin
fc:= FFolderConnects[Index];
FFolderConnects.Delete(Index);
path:= fc.Root;
if path.StartsWith(FRootDirectory) then
Delete(path, 1, Length(FRootDirectory));
DoResetFileAfterDisconnect(path);
end;
procedure TFileManager.DisconnectDirectory(OldName, Directory: string);
var i: Integer;
begin
Directory:= FullFileName(Directory);
OldName:= FullFileName(OldName);
for i:= FFolderConnects.Count - 1 downto 0 do
if (FFolderConnects[i].Folder = OldName) and (FFolderConnects[i].Root = Directory) then
DisconnectDirectory(i);
end;
function TFileManager.DoGetObject(const FileName: string;
Func: TFileObjectCreatorObj; Options: TStreamOptions;
TrySync: Boolean): IFutureWithSoftCancel;
var Cache: TCacheData;
RelativePath: string;
begin
RelativePath:= TranslateFileName(FileName);
if not Assigned(Func) then begin
Func:= GetLoaderByName(RelativePath, Options);
if not Assigned(Func) then
raise Exception.Create('TFileManager.GetObject - не найден загрузчик ресурсов');
end;
Cache:= TryCacheNote(RelativePath, False);
if Cache = nil then
raise Exception.Create('Файл не найден:' + FileName);
Cache.Options:= Options;
if TrySync then
Result:= Cache.TryLoadSync(Func)
else
Result:= Cache.LoadAsync(Func);
end;
procedure TFileManager.DoResetFileAfterConnect(const ANewFolder: TFolderConnect);
procedure DeepProcess(const Path: string; Dir: TDirectoryCache);
var i: Integer;
str: string;
fInfo: TFileInfo;
f: TFileLink;
begin
for i := Dir.FilesCount - 1 downto 0 do begin
//ActualizeFileCache(Dir, i, ANewFolder.Root + Path + Dir.FFiles[i].Name);
//ускоренный вариант
f:= Dir.FFiles[i];
if f.HasSubscribers then begin
str:= ANewFolder.Folder + Path + f.Name;
if System.SysUtils.FileExists(str) then begin
fInfo:= EnsureFileInfo(str, nil);
if f.FFileInfo = fInfo then
raise Exception.Create('Wrong FileLink in DoResetFileAfterConnect');
ChangeLink(f, fInfo);
end;
end else begin
DetachFileLink(f);
f.Destroy;
Dir.FFiles.Delete(i);
end;
end;
for i := Dir.FoldersCount - 1 downto 0 do begin
DeepProcess(Path + Dir.Folders[i].Name + PathDelim, Dir.Folders[i]);
if Dir.FFolders[i].IsEmpty then begin
Dir.FFolders[i].Destroy;
Dir.FFolders.Delete(i);
end;
end;
end;
var ACurrentCache: TDirectoryCache;
path: string;
begin
if FBatchProcessor <> nil then begin
FBatchProcessor.ConnectDirectory(ANewFolder);
Exit;
end;
path:= ANewFolder.Root;
if path.StartsWith(FRootDirectory) then
path:= Copy(path, Length(FRootDirectory) + 1);
ACurrentCache:= FCache.Directory[path];
if ACurrentCache <> nil then
DeepProcess('', ACurrentCache);
end;
procedure TFileManager.DoResetFileAfterDisconnect(const AAddOn: IAddOn);
var i, j, fileIndex: Integer;
LocalDir: TDirectoryCache;
l: TList<TFileInfo>;
links: TList<TFileLink>;
begin
if FBatchProcessor <> nil then begin
FBatchProcessor.DisconnectAddOn(AAddOn);
Exit;
end;
if FAddOnFiles.TryGetValue({$IFNDEF DEBUG}Pointer({$ENDIF}AAddOn{$IFNDEF DEBUG}){$ENDIF}, l) then begin
for i := l.Count - 1 downto 0 do begin
if not FFileLinks.TryGetValue(l[i], links) then
raise Exception.CreateFmt('Addon file not cashed: %s', [l[i].FRealPath]);
for j := links.Count - 1 downto 0 do begin
if not FCache.TryGetFileData(links[j].FullName, LocalDir, fileIndex) then
raise Exception.CreateFmt('File not cached: %s', [links[j].FullName]);
ActualizeFileCache(LocalDir, fileIndex, links[j].FullName);
end;
end;
if l.Count = 0 then
FAddOnFiles.Remove({$IFNDEF DEBUG}Pointer({$ENDIF}AAddOn{$IFNDEF DEBUG}){$ENDIF});
end;
end;
procedure TFileManager.DoResetFileAfterDisconnect(const ARelativePath: string);
procedure DeepProcess(const ARelativePath: string; ACurrentCache: TDirectoryCache);
var i: Integer;
begin
for i := ACurrentCache.FilesCount - 1 downto 0 do
ActualizeFileCache(ACurrentCache, i, ARelativePath + ACurrentCache.Files[i].Name);
for i := ACurrentCache.FoldersCount - 1 downto 0 do begin
DeepProcess(ARelativePath + ACurrentCache.Folders[i].Name + PathDelim, ACurrentCache.Folders[i]);
if ACurrentCache.FFolders[i].IsEmpty then begin
ACurrentCache.FFolders[i].Destroy;
ACurrentCache.FFolders.Delete(i);
end;
end;
end;
var ACurrentCache: TDirectoryCache;
begin
if FBatchProcessor <> nil then begin
FBatchProcessor.DisconnectDirectory(ARelativePath);
Exit;
end;
ACurrentCache:= FCache.Directory[ARelativePath];
if ACurrentCache <> nil then
DeepProcess(ARelativePath, ACurrentCache);
end;
procedure TFileManager.DropAll(Dir: TDirectoryCache);
begin
end;
procedure TFileManager.DropNotChanged(Dir: TDirectoryCache);
var i, Index: Integer;
Cache: TCacheData;
fo: IFileObject;
temp: TListRecord<TPair<string, TCacheData>>;
dirs: TListRecord<TDirectoryCache>;
Instance: TCacheInstance;
tmp: TCacheInstance;
good: Boolean;
begin
{$MESSAGE WARN 'fix it'}
{MonitorEnter(Dir);
try
temp.Create(Dir.FilesCount);
dirs.Create(Dir.FoldersCount);
for i := Dir.FilesCount - 1 downto 0 do
Cache:= TCacheData(Objects[i]);
fo:= Cache.Load;
if (fo = nil) or (FO.GetChangeStamp = 0) then begin
temp.Add(TPair<string, TCacheData>.Create(Items[i], Cache));
Cache._AddRef;
FData.Delete(i);
end;
for i := Dir.FoldersCount - 1 downto 0 do
dirs.Add(Dir.Folders[i]);
finally
MonitorExit(Dir);
end;