1046 lines
29 KiB
Plaintext
1046 lines
29 KiB
Plaintext
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// ****************************************************************************
|
|
// * Unit Name : GSStorage
|
|
// * Purpose : Îáåðòê?íà?ñòðóêòóðèðîâàííû?õðàíèëèùåì äàííûõ (Com Storage)
|
|
// * Author : Àëåêñàíä?Áàãåëü
|
|
// * Copyright : Öåíò?Ãðàí?2001 - 2005 ?
|
|
// * Version : 1.34
|
|
// ****************************************************************************
|
|
//
|
|
|
|
unit EM.GSStorage;
|
|
|
|
interface
|
|
|
|
uses
|
|
WinApi.Windows, Classes, WinApi.ActiveX, AxCtrls, SysUtils, WinAPi.ShlObj;
|
|
|
|
const
|
|
CLRF = #13#10;
|
|
|
|
type
|
|
TStatStgEx = record
|
|
pwcsName: String[30];
|
|
dwType: Longint;
|
|
end;
|
|
|
|
TStatStgArray = array of TStatStgEx;
|
|
TGSStorageEnum = packed record
|
|
Count: Cardinal;
|
|
ElementEnum: TStatStgArray;
|
|
end;
|
|
|
|
GSCustomStorageException = class(Exception);
|
|
TGSStorageCursors = class;
|
|
TGSCustomStorage = class;
|
|
TGSStorage = class;
|
|
|
|
TGSStorageCursor = class(TCollectionItem)
|
|
private
|
|
FLockCount: Integer;
|
|
FID: ShortString;
|
|
FStorageInterface: IStorage;
|
|
FSubStorage: TGSStorageCursors;
|
|
FMode: Longint;
|
|
FOwner: TGSCustomStorage;
|
|
FParent: TGSStorageCursor;
|
|
procedure SetParam(const AOwner: TGSCustomStorage;
|
|
AParent: TGSStorageCursor);
|
|
function GetPath: String;
|
|
function GetLock: Boolean;
|
|
function GetLockCount: Integer;
|
|
procedure Lock;
|
|
procedure UnLock;
|
|
property Locked: Boolean read GetLock;
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure AddInstance;
|
|
class procedure ReleaseInstance;
|
|
{$ENDIF}
|
|
protected
|
|
procedure Garbage;
|
|
function ExistsObject(const AName: String; const AType: Longint;
|
|
var Exists: Boolean): Boolean;
|
|
function GetName: String;
|
|
public
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class function NumOfInstances: Integer;
|
|
{$ENDIF}
|
|
function Backward(var ACursor: TGSStorageCursor): Boolean;
|
|
constructor Create(Collection: TCollection); override;
|
|
function CreateStream(const AName: String): HRESULT;
|
|
function CreateStorage(const AName: String;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
function Copy(const AName: String;
|
|
const ACursor: TGSStorageCursor): HRESULT;
|
|
function DeleteStream(const AName: String): HRESULT;
|
|
function DeleteStorage(const AName: String): HRESULT;
|
|
destructor Destroy; override;
|
|
function Enumerate(var AData: TGSStorageEnum): HRESULT;
|
|
procedure FreeMemAfterEnum(var AData: TGSStorageEnum);
|
|
function FlushBuffer: HRESULT;
|
|
function MoveTo(const AName: String;
|
|
const ACursor: TGSStorageCursor): HRESULT;
|
|
function OpenStorage(const AName: String;
|
|
var ACursor: TGSStorageCursor; Verify: Boolean = True): HRESULT;
|
|
function StreamExists(const AName: String): Boolean;
|
|
function StorageExists(const AName: String): Boolean;
|
|
// function ReadStream(const AName: String;
|
|
// var AStream: TStream; Verify: Boolean = True): HRESULT;
|
|
function ReadStream(const AName: String;
|
|
AStream: TStream; Verify: Boolean = True): HRESULT;
|
|
function Rename(const AName, ANewName: String): HRESULT;
|
|
function WriteStream(const AName: String; const AStream: TMemoryStream): HRESULT;
|
|
procedure Release;
|
|
property Path: String read GetPath;
|
|
property Storages: TGSStorageCursors read FSubStorage;
|
|
end;
|
|
|
|
TGSStorageCursors = class(TCollection)
|
|
private
|
|
function GetItem(Index: Integer): TGSStorageCursor;
|
|
procedure SetItem(Index: Integer; const Value: TGSStorageCursor);
|
|
function Add: TGSStorageCursor;
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure AddInstance;
|
|
class procedure ReleaseInstance;
|
|
{$ENDIF}
|
|
protected
|
|
function FindStorageByName(
|
|
const AName: String; var Index: Cardinal): Boolean;
|
|
public
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class function NumOfInstances: Integer;
|
|
{$ENDIF}
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
property Items[Index: Integer]: TGSStorageCursor read GetItem write SetItem; default;
|
|
end;
|
|
|
|
TGSCustomStorage = class(TPersistent)
|
|
private
|
|
FRootStorage: TGSStorageCursor;
|
|
FMode: Longint;
|
|
FFileName: String;
|
|
FCanCreate: Boolean;
|
|
function GetActive: Boolean;
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure AddInstance;
|
|
class procedure ReleaseInstance;
|
|
{$ENDIF}
|
|
protected
|
|
function OpenFileEx(const AFileName: String;
|
|
const CanCreate: Boolean; const AMode: LongInt;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
procedure Garbage;
|
|
class function ClassSupport(const AFileName: String; Change: Boolean): HRESULT;
|
|
public
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class function NumOfInstances: Integer;
|
|
constructor Create;
|
|
{$ENDIF}
|
|
destructor Destroy; override;
|
|
function CreateCursor: TGSStorageCursor;
|
|
function ForceStorage(APath: String; var ACursor: TGSStorageCursor): HRESULT;
|
|
function OpenFileReadOnly(const AFileName: String;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
function OpenFile(const AFileName: String;
|
|
const CanCreate: Boolean; var ACursor: TGSStorageCursor): HRESULT;
|
|
function OpenStorage(APath: String; var ACursor: TGSStorageCursor): HRESULT;
|
|
procedure CloseFile;
|
|
function IsBussy: Boolean;
|
|
function ReConnect(var AStorage: TGSStorage;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
class function Compress(const AFileName: String): HRESULT;
|
|
class function IsStgValidBinaryFmt(const AFileName: String): HRESULT;
|
|
property Active: Boolean read GetActive;
|
|
end;
|
|
|
|
TGSStorage = class(TGSCustomStorage);
|
|
|
|
{ TGInfoStorage = class(TGSCustomStorage)
|
|
public
|
|
function WriteInteger
|
|
end; }
|
|
|
|
implementation
|
|
|
|
uses Variants, System.Win.ComObj;
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
var
|
|
TGSCustomStorage_Instance: Integer = 0;
|
|
TGSStorageCursor_Instance: Integer = 0;
|
|
TGSStorageCursors_Instance: Integer = 0;
|
|
{$ENDIF}
|
|
|
|
{ TGSStorage }
|
|
|
|
// Çàêðûòèå âñåõ äî÷åðíèõ Storage
|
|
// =============================================================================
|
|
procedure TGSCustomStorage.CloseFile;
|
|
begin
|
|
if Assigned(FRootStorage) then
|
|
begin
|
|
FreeAndNil(FRootStorage);
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(False, 'TGSCustomStorage.FRootStorage');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TGSCustomStorage.CreateCursor: TGSStorageCursor;
|
|
begin
|
|
if FRootStorage = nil then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
Result := FRootStorage;
|
|
end;
|
|
|
|
destructor TGSCustomStorage.Destroy;
|
|
begin
|
|
if Assigned(FRootStorage) then
|
|
FRootStorage.Free;
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(False, 'TGSCustomStorage.FRootStorage');
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
ReleaseInstance;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
|
|
function TGSCustomStorage.IsBussy: Boolean;
|
|
var
|
|
LocCount: Integer;
|
|
begin
|
|
LocCount := 0;
|
|
Inc(LocCount, FRootStorage.GetLockCount);
|
|
Result := LocCount > 1;
|
|
end;
|
|
|
|
|
|
function TGSCustomStorage.ReConnect(var AStorage: TGSStorage;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
begin
|
|
AStorage.CloseFile;
|
|
Result := AStorage.OpenFileEx(FFileName, FCanCreate, FMode, ACursor);
|
|
end;
|
|
|
|
|
|
// Àíàëîã ForceDirectory
|
|
// =============================================================================
|
|
function TGSCustomStorage.ForceStorage(APath: String;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
var
|
|
S: TStringList;
|
|
I: Integer;
|
|
begin
|
|
Result := S_FALSE;
|
|
if APath = '' then
|
|
raise Exception.Create(SysErrorMessage(ERROR_INVALID_PARAMETER));
|
|
S := TStringList.Create;
|
|
try
|
|
ACursor := FRootStorage;
|
|
if ACursor.GetName + '\' <> Copy(APath, 1, Length(ACursor.GetName) + 1) then
|
|
begin
|
|
Result := ERROR_PATH_NOT_FOUND;
|
|
Exit;
|
|
end;
|
|
Delete(APath, 1, Length(ACursor.GetName) + 1);
|
|
S.Text := StringReplace(APath, '\', CLRF, [rfReplaceAll]);
|
|
for I := 0 to S.Count - 1 do
|
|
begin
|
|
if ACursor.StorageExists(S.Strings[I]) then
|
|
Result := ACursor.OpenStorage(S.Strings[I], ACursor)
|
|
else
|
|
Result := ACursor.CreateStorage(S.Strings[I], ACursor);
|
|
if Result <> S_OK then
|
|
begin
|
|
FRootStorage.Garbage;
|
|
Exit;
|
|
end;
|
|
end;
|
|
finally
|
|
S.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TGSCustomStorage.Garbage;
|
|
begin
|
|
if FRootStorage <> nil then
|
|
FRootStorage.Garbage;
|
|
end;
|
|
|
|
|
|
// îòêðûòèå õðàíèëèù?(?ïåðåçàïèñü?èë?íå?
|
|
// =============================================================================
|
|
function TGSCustomStorage.OpenFile(const AFileName: String;
|
|
const CanCreate: Boolean; var ACursor: TGSStorageCursor): HRESULT;
|
|
begin
|
|
Result := OpenFileEx(AFileName, CanCreate,
|
|
STGM_READWRITE or STGM_SHARE_EXCLUSIVE, ACursor);
|
|
end;
|
|
|
|
|
|
// Ðåàëèçàö? îòêðûò? ôàéë?
|
|
// =============================================================================
|
|
function TGSCustomStorage.OpenFileEx(const AFileName: String;
|
|
const CanCreate: Boolean; const AMode: LongInt;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
begin
|
|
FMode := AMode;
|
|
FCanCreate := CanCreate;
|
|
FFileName := AFileName;
|
|
CloseFile;
|
|
FRootStorage := TGSStorageCursor.Create(nil);
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(True, 'TGSCustomStorage.FRootStorage');
|
|
{$ENDIF}
|
|
if CanCreate then
|
|
begin
|
|
ACursor := FRootStorage;
|
|
ACursor.SetParam(Self, nil);
|
|
Result := StgCreateDocfile(StringToOleStr(AFileName), FMode or STGM_CREATE, 0,
|
|
ACursor.FStorageInterface);
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(True, 'TGSCustomStorage.ACursor.FStorageInterface = ' + IntToStr(Integer(ACursor.FStorageInterface)));
|
|
{$ENDIF}
|
|
ACursor.Lock;
|
|
end
|
|
else
|
|
begin
|
|
if not FileExists(AFileName) then
|
|
begin
|
|
Result := ERROR_FILE_NOT_FOUND;
|
|
Exit;
|
|
end;
|
|
Result := StgIsStorageFile(StringToOleStr(AFileName));
|
|
if Result <> S_OK then Exit;
|
|
ACursor := FRootStorage;
|
|
ACursor.SetParam(Self, nil);
|
|
Result := StgOpenStorage(StringToOleStr(AFileName),
|
|
nil, FMode, nil, 0, ACursor.FStorageInterface);
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(True, 'TGSCustomStorage.ACursor.FStorageInterface = ' + IntToStr(Integer(ACursor.FStorageInterface)));
|
|
{$ENDIF}
|
|
ACursor.Lock;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TGSCustomStorage.OpenStorage(APath: String;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
var
|
|
S: TStringList;
|
|
I: Integer;
|
|
begin
|
|
Result := S_FALSE;
|
|
if APath = '' then
|
|
raise Exception.Create(SysErrorMessage(ERROR_INVALID_PARAMETER));
|
|
S := TStringList.Create;
|
|
try
|
|
ACursor := FRootStorage;
|
|
if APath[Length(APath)] <> '\' then APath := APath + '\';
|
|
if ACursor.GetName + '\' <> Copy(APath, 1, Length(ACursor.GetName) + 1) then
|
|
begin
|
|
Result := ERROR_PATH_NOT_FOUND;
|
|
Exit;
|
|
end;
|
|
Delete(APath, 1, Length(ACursor.GetName) + 1);
|
|
S.Text := StringReplace(APath, '\', CLRF, [rfReplaceAll]);
|
|
for I := 0 to S.Count - 1 do
|
|
if ACursor.StorageExists(S.Strings[I]) then
|
|
begin
|
|
if ACursor.OpenStorage(S.Strings[I], ACursor) <> S_OK then Exit
|
|
end
|
|
else
|
|
raise Exception.Create(SysErrorMessage(ERROR_PATH_NOT_FOUND));
|
|
Result := S_OK;
|
|
finally
|
|
S.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
// Îòêðûòèå õðàíèëèù??ðåæèìå ÷òåí?
|
|
// =============================================================================
|
|
function TGSCustomStorage.OpenFileReadOnly(
|
|
const AFileName: String; var ACursor: TGSStorageCursor): HRESULT;
|
|
begin
|
|
Result := OpenFileEx(AFileName, False, STGM_READ or STGM_SHARE_EXCLUSIVE,
|
|
ACursor);
|
|
end;
|
|
|
|
{ TGSStorageCursors }
|
|
|
|
function TGSStorageCursors.Add: TGSStorageCursor;
|
|
begin
|
|
Result := TGSStorageCursor(inherited Add);
|
|
end;
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure TGSStorageCursors.AddInstance;
|
|
begin
|
|
Inc(TGSStorageCursors_Instance);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
constructor TGSStorageCursors.Create;
|
|
begin
|
|
inherited Create(TGSStorageCursor);
|
|
{$IFDEF CLASS_INSTANCE}
|
|
AddInstance;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TGSStorageCursors.Destroy;
|
|
begin
|
|
{$IFDEF CLASS_INSTANCE}
|
|
ReleaseInstance;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
|
|
// Ïîèñ?îòêðûòîã?Storage ïî èìåí?
|
|
// =============================================================================
|
|
function TGSStorageCursors.FindStorageByName(
|
|
const AName: String; var Index: Cardinal): Boolean;
|
|
var
|
|
I: Cardinal;
|
|
begin
|
|
Result := False;
|
|
Index := 0;
|
|
if Count = 0 then Exit;
|
|
for I := 0 to Count - 1 do
|
|
if Items[I].GetName = AName then
|
|
begin
|
|
Result := True;
|
|
Index := I;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TGSStorageCursors.GetItem(Index: Integer): TGSStorageCursor;
|
|
begin
|
|
Result := TGSStorageCursor(inherited GetItem(Index));
|
|
end;
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class function TGSStorageCursors.NumOfInstances: Integer;
|
|
begin
|
|
Result := TGSStorageCursors_Instance;
|
|
end;
|
|
|
|
class procedure TGSStorageCursors.ReleaseInstance;
|
|
begin
|
|
Dec(TGSStorageCursors_Instance);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TGSStorageCursors.SetItem(Index: Integer;
|
|
const Value: TGSStorageCursor);
|
|
begin
|
|
inherited SetItem(Index, Value);
|
|
end;
|
|
|
|
{ TGSStorageCursor }
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure TGSStorageCursor.AddInstance;
|
|
begin
|
|
Inc(TGSStorageCursor_Instance);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
//
|
|
// =============================================================================
|
|
function TGSStorageCursor.Backward(var ACursor: TGSStorageCursor): Boolean;
|
|
begin
|
|
Result := FParent <> nil;
|
|
if Result then
|
|
begin
|
|
UnLock;
|
|
ACursor := FParent;
|
|
ACursor.Lock;
|
|
if not Locked then
|
|
Self.Free;
|
|
end;
|
|
end;
|
|
|
|
function TGSStorageCursor.Copy(const AName: String;
|
|
const ACursor: TGSStorageCursor): HRESULT;
|
|
begin
|
|
if ACursor = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.Copy() >> "ACursor = nil"');//SysErrorMessage(E_INVALIDARG));
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.Copy() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
//Result := FStorageInterface.CopyTo(0, nil, nil, ACursor.FStorageInterface);
|
|
Result := FStorageInterface.MoveElementTo(StringToOleStr(AName),
|
|
ACursor.FStorageInterface, StringToOleStr(AName), STGMOVE_COPY);
|
|
end;
|
|
|
|
constructor TGSStorageCursor.Create(Collection: TCollection);
|
|
var
|
|
ID: TGUID;
|
|
begin
|
|
inherited;
|
|
{$IFDEF CLASS_INSTANCE}
|
|
AddInstance;
|
|
{$ENDIF}
|
|
FSubStorage := TGSStorageCursors.Create;
|
|
(*{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(True, 'TGSStorageCursor - êîíñòðóêòî?);
|
|
CreateFreeLog(True, 'TGSStorageCursor.ACursor.FSubStorage');
|
|
{$ENDIF}*)
|
|
FLockCount := 0;
|
|
if CreateGUID(ID) <> S_OK then
|
|
raise EComponentError.Create('TGSStorageCursor.Create() >> "CreateGUID(ID) <> S_OK"');//SysErrorMessage(E_UNEXPECTED));
|
|
FID := GUIDToString(ID);
|
|
end;
|
|
|
|
function TGSStorageCursor.CreateStorage(const AName: String;
|
|
var ACursor: TGSStorageCursor): HRESULT;
|
|
var
|
|
Index: Cardinal;
|
|
begin
|
|
{ if ACursor = nil then
|
|
raise EComponentError.Create(SysErrorMessage(E_INVALIDARG));}
|
|
if FSubStorage.FindStorageByName(AName, Index) then
|
|
begin
|
|
Result := ERROR_ALREADY_EXISTS;
|
|
Exit;
|
|
end;
|
|
ACursor := FSubStorage.Add;
|
|
ACursor.SetParam(FOwner, Self);
|
|
Result := FStorageInterface.CreateStorage(StringToOleStr(AName),
|
|
FMode, 0, 0, ACursor.FStorageInterface);
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(True, 'TGSStorageCursor.ACursor.FStorageInterface = ' + IntToStr(Integer(ACursor.FStorageInterface)));
|
|
{$ENDIF}
|
|
ACursor.Lock;
|
|
end;
|
|
|
|
function TGSStorageCursor.CreateStream(const AName: String): HRESULT;
|
|
var
|
|
TmpStream:IStream;
|
|
begin
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.CreateStream( >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
Result := FStorageInterface.CreateStream(StringToOleStr(AName),
|
|
FMode, 0, 0, TmpStream);
|
|
TmpStream := nil;
|
|
end;
|
|
|
|
function TGSStorageCursor.DeleteStorage(const AName: String): HRESULT;
|
|
var
|
|
Index: Cardinal;
|
|
begin
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.DeleteStorage() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
if FSubStorage.FindStorageByName(AName, Index) then
|
|
begin
|
|
{ TODO : Äóìàòü - íóæíàë?òó?áëîêèðîâêà? }
|
|
{if FSubStorage.Items[Index].Locked then
|
|
raise EComponentError.Create(SysErrorMessage(ERROR_ACCESS_DENIED)); }
|
|
FSubStorage.Delete(Index);
|
|
end;
|
|
Result := FStorageInterface.DestroyElement(StringToOleStr(AName));
|
|
end;
|
|
|
|
function TGSStorageCursor.DeleteStream(const AName: String): HRESULT;
|
|
begin
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.DeleteStream() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
Result := FStorageInterface.DestroyElement(StringToOleStr(AName));
|
|
end;
|
|
|
|
destructor TGSStorageCursor.Destroy;
|
|
begin
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
//CreateFreeLog(False, 'TGSStorageCursor - äåñòðóêòîð');
|
|
//CreateFreeLog(False, 'TGSStorageCursor.ACursor.FSubStorage');
|
|
CreateFreeLog(False, 'TGSStorageCursor.FStorageInterface = ' + IntToStr(Integer(FStorageInterface)));
|
|
{$ENDIF}
|
|
FStorageInterface := nil;
|
|
FreeAndNil(FSubStorage);
|
|
{$IFDEF CLASS_INSTANCE}
|
|
ReleaseInstance;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
function TGSStorageCursor.Enumerate(var AData: TGSStorageEnum): HRESULT;
|
|
var
|
|
Enum: IEnumStatStg;
|
|
TmpElement: TStatStg;
|
|
ShellMalloc: IMalloc;
|
|
Fetched: Int64;
|
|
begin
|
|
if (CoGetMalloc(1, ShellMalloc) <> S_OK) or (ShellMalloc = nil) then
|
|
raise EComponentError.Create('CoGetMalloc failed.');
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.Enumerate() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
Result := FStorageInterface.EnumElements(0, nil, 0, Enum);
|
|
if Result = S_OK then
|
|
begin
|
|
AData.Count := 0;
|
|
ZeroMemory(@AData, SizeOf(AData));
|
|
Fetched := 1;
|
|
while Fetched > 0 do
|
|
if Enum.Next(1, TmpElement, @Fetched) = S_OK then
|
|
if ShellMalloc.DidAlloc(TmpElement.pwcsName) = 1 then
|
|
begin
|
|
Inc(AData.Count);
|
|
SetLength(AData.ElementEnum, AData.Count);
|
|
AData.ElementEnum[AData.Count - 1].pwcsName := String(TmpElement.pwcsName);
|
|
ShellMalloc.Free(TmpElement.pwcsName);
|
|
AData.ElementEnum[AData.Count - 1].dwType := TmpElement.dwType;
|
|
end;
|
|
end;
|
|
Enum := nil;
|
|
end;
|
|
|
|
function TGSStorageCursor.ExistsObject(const AName: String; const AType: Longint;
|
|
var Exists: Boolean): Boolean;
|
|
var
|
|
I: Integer;
|
|
Data: TGSStorageEnum;
|
|
begin
|
|
Data.Count := 0;
|
|
Result := Enumerate(Data) = S_OK;
|
|
try
|
|
Exists := False;
|
|
if Result then
|
|
if Data.Count > 0 then
|
|
for I := 0 to Data.Count - 1 do
|
|
begin
|
|
if Data.ElementEnum[I].pwcsName = AName then
|
|
begin
|
|
Exists := Data.ElementEnum[I].dwType = AType;
|
|
Exit;
|
|
end;
|
|
end;
|
|
finally
|
|
//FreeMemAfterEnum(Data);
|
|
end;
|
|
end;
|
|
|
|
function TGSStorageCursor.FlushBuffer: HRESULT;
|
|
begin
|
|
Result := FStorageInterface.Commit(STGC_DEFAULT);
|
|
end;
|
|
|
|
procedure TGSStorageCursor.FreeMemAfterEnum(var AData: TGSStorageEnum);
|
|
{var
|
|
I: Integer;}
|
|
begin
|
|
// for I := 0 to AData.Count - 1 do
|
|
// FreeMem(AData.ElementEnum[I].pwcsName);
|
|
AData.Count := 0;
|
|
SetLength(AData.ElementEnum, 0);
|
|
end;
|
|
|
|
procedure TGSStorageCursor.Garbage;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FSubStorage = nil then Exit;
|
|
if FSubStorage.Count > 0 then
|
|
for I := 0 to FSubStorage.Count - 1 do
|
|
begin
|
|
FSubStorage.Items[I].Garbage;
|
|
if not FSubStorage.Items[I].Locked then
|
|
FSubStorage.Items[I].Free;
|
|
end;
|
|
end;
|
|
|
|
function TGSStorageCursor.GetLock: Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := FLockCount > 0;
|
|
if not Result then
|
|
if FSubStorage.Count > 0 then
|
|
for I := 0 to FSubStorage.Count - 1 do
|
|
if FSubStorage.Items[I].Locked then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TGSStorageCursor.GetLockCount: Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := FLockCount;
|
|
if FSubStorage.Count > 0 then
|
|
for I := 0 to FSubStorage.Count - 1 do
|
|
Inc(Result, FSubStorage.Items[I].GetLockCount);
|
|
end;
|
|
|
|
function TGSStorageCursor.GetName: String;
|
|
var
|
|
Error: HRESULT;
|
|
StatStg: TStatStg;
|
|
ShellMalloc: IMalloc;
|
|
begin
|
|
Result := '';
|
|
if (CoGetMalloc(1, ShellMalloc) <> S_OK) or (ShellMalloc = nil) then
|
|
raise EComponentError.Create('CoGetMalloc failed.');
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.GetName() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
Error := FStorageInterface.Stat(StatStg, STATFLAG_DEFAULT);
|
|
if Error <> S_OK then
|
|
raise Exception.Create('TGSStorageCursor.GetName() >> "Error <> S_OK"');//SysErrorMessage(Error));
|
|
if ShellMalloc.DidAlloc(StatStg.pwcsName) = 1 then
|
|
begin
|
|
Result := String(StatStg.pwcsName);
|
|
ShellMalloc.Free(StatStg.pwcsName);
|
|
end;
|
|
end;
|
|
|
|
function TGSStorageCursor.GetPath: String;
|
|
begin
|
|
if FParent = nil then
|
|
Result := GetName
|
|
else
|
|
Result := FParent.GetPath + '\' + GetName;
|
|
end;
|
|
|
|
procedure TGSStorageCursor.Lock;
|
|
begin
|
|
Inc(FLockCount);
|
|
end;
|
|
|
|
function TGSStorageCursor.MoveTo(const AName: String;
|
|
const ACursor: TGSStorageCursor): HRESULT;
|
|
var
|
|
Index: Cardinal;
|
|
begin
|
|
if ACursor = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.MoveTo() >> "ACursor = nil"');//SysErrorMessage(E_INVALIDARG));
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.MoveTo() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
if FSubStorage.FindStorageByName(AName, Index) then
|
|
Result := E_ACCESSDENIED
|
|
else
|
|
Result := FStorageInterface.MoveElementTo(StringToOleStr(AName),
|
|
ACursor.FStorageInterface, StringToOleStr(AName), STGMOVE_MOVE);
|
|
end;
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class function TGSStorageCursor.NumOfInstances: Integer;
|
|
begin
|
|
Result := TGSStorageCursor_Instance;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TGSStorageCursor.OpenStorage(const AName: String;
|
|
var ACursor: TGSStorageCursor; Verify: Boolean = True): HRESULT;
|
|
var
|
|
Index: Cardinal;
|
|
begin
|
|
//if ACursor = nil then
|
|
//raise EComponentError.Create(SysErrorMessage(E_INVALIDARG));
|
|
if fSubStorage.FindStorageByName(AName, Index) then
|
|
begin
|
|
Result := S_OK;
|
|
ACursor := FSubStorage.Items[Index];
|
|
ACursor.Lock;
|
|
Exit;
|
|
end;
|
|
|
|
if Verify then
|
|
if not StorageExists(AName) then
|
|
raise EComponentError.Create(SysErrorMessage(ERROR_PATH_NOT_FOUND));
|
|
|
|
if ACursor <> nil then
|
|
if ACursor.FID = FID then UnLock;
|
|
|
|
ACursor := FSubStorage.Add;
|
|
ACursor.SetParam(FOwner, Self);
|
|
|
|
Result := FStorageInterface.OpenStorage(StringToOleStr(AName),
|
|
nil, FMode, nil, 0, ACursor.FStorageInterface);
|
|
{$IFDEF CREATE_FREE_LOG}
|
|
CreateFreeLog(True, 'TGSCustomStorage.ACursor.FStorageInterface = ' + IntToStr(Integer(ACursor.FStorageInterface)));
|
|
{$ENDIF}
|
|
ACursor.Lock;
|
|
end;
|
|
|
|
// ?äàííîé ôóíêöè?ïðîâåðÿòü = åñëè ðåçóëüòà?íå S_OK òî ñìîòðåòü AStream <> nil
|
|
//function TGSStorageCursor.ReadStream(const AName: String;
|
|
// var AStream: TStream; Verify: Boolean = True): HRESULT;
|
|
|
|
// ½ºÆ®¸²À» ÀÌ ÇÔ¼ö¿¡¼ »ý¼ºÇÏÁö ¾Ê°Ô ¼öÁ¤ 18_1123 15:53:21 sunk
|
|
function TGSStorageCursor.ReadStream(const AName: String;
|
|
AStream: TStream; Verify: Boolean = True): HRESULT;
|
|
var
|
|
TmpStream:IStream;
|
|
OS:TOleStream;
|
|
Buff: array of Byte;
|
|
I, Err: Integer;
|
|
|
|
procedure DoReadAnything;
|
|
begin
|
|
{ DONE : Âîçìîæíà óòå÷êà ïà?òè, òà?êà?AStream óæ?áóäå?ñîçäàí!!! }
|
|
// Õà?ñàìè ïðîâåðÿþò
|
|
|
|
|
|
// Ïîïûòê?âûòàùèòü õîòü ÷ò?íèáóäü...
|
|
SetLength(Buff, OS.Size);
|
|
Err := 0;
|
|
I := 0;
|
|
OS.Position := 0;
|
|
while I < OS.Size do
|
|
try
|
|
OS.Read(Buff[I - Err], 1);
|
|
Inc(I);
|
|
except
|
|
Break;
|
|
end;
|
|
AStream.Write(Buff[0], I);
|
|
end;
|
|
|
|
begin
|
|
// AStream := nil;
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.ReadStream() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
if Verify then
|
|
begin
|
|
if StreamExists(AName) then
|
|
Result := FStorageInterface.OpenStream(StringToOleStr(AName),
|
|
nil, FMode, 0, TmpStream)
|
|
else
|
|
raise EComponentError.Create('TGSStorageCursor.ReadStream() >> "StreamExists(AName) = false"');//SysErrorMessage(ERROR_PATH_NOT_FOUND));
|
|
end
|
|
else
|
|
Result := FStorageInterface.OpenStream(StringToOleStr(AName),
|
|
nil, FMode, 0, TmpStream);
|
|
if Result = S_OK then
|
|
begin
|
|
// AStream := TMemoryStream.Create;
|
|
AStream.Position := 0;
|
|
OS := TOleStream.Create(TmpStream);
|
|
try
|
|
OS.Position := 0;
|
|
try
|
|
AStream.CopyFrom(OS, OS.Size);
|
|
except
|
|
on E: EOleException do
|
|
begin
|
|
Result := E.ErrorCode;
|
|
DoReadAnything;
|
|
Exit;
|
|
end;
|
|
on E: Exception do
|
|
begin
|
|
Result := S_FALSE;
|
|
DoReadAnything;
|
|
end;
|
|
end;
|
|
AStream.Position := 0;
|
|
finally
|
|
OS.Free;
|
|
TmpStream := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGSStorageCursor.Release;
|
|
begin
|
|
if FID = FOwner.FRootStorage.FID then Exit;
|
|
Free;
|
|
FOwner.Garbage;
|
|
end;
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure TGSStorageCursor.ReleaseInstance;
|
|
begin
|
|
Dec(TGSStorageCursor_Instance);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TGSStorageCursor.Rename(const AName, ANewName: String): HRESULT;
|
|
begin
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.Rename() >> "FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
Garbage;
|
|
Result := FStorageInterface.RenameElement(StringToOleStr(AName),
|
|
StringToOleStr(ANewName));
|
|
end;
|
|
|
|
procedure TGSStorageCursor.SetParam(const AOwner: TGSCustomStorage;
|
|
AParent: TGSStorageCursor);
|
|
begin
|
|
FMode := AOwner.FMode;
|
|
FOwner := AOwner;
|
|
FParent := AParent;
|
|
end;
|
|
|
|
function TGSStorageCursor.StorageExists(const AName: String): Boolean;
|
|
var
|
|
Exists: Boolean;
|
|
begin
|
|
Result := False;
|
|
if ExistsObject(AName, STGTY_STORAGE, Exists) then
|
|
Result := Exists;
|
|
end;
|
|
|
|
function TGSStorageCursor.StreamExists(const AName: String): Boolean;
|
|
var
|
|
Exists: Boolean;
|
|
begin
|
|
Result := False;
|
|
if ExistsObject(AName, STGTY_STREAM, Exists) then
|
|
Result := Exists;
|
|
end;
|
|
|
|
procedure TGSStorageCursor.UnLock;
|
|
begin
|
|
Dec(FLockCount);
|
|
end;
|
|
|
|
function TGSStorageCursor.WriteStream(const AName: String;
|
|
const AStream: TMemoryStream): HRESULT;
|
|
var
|
|
TmpStream:IStream;
|
|
OS:TOleStream;
|
|
begin
|
|
if FStorageInterface = nil then
|
|
raise EComponentError.Create('TGSStorageCursor.WriteStream() >> " FStorageInterface = nil"');//SysErrorMessage(E_UNEXPECTED));
|
|
if StreamExists(AName) then
|
|
Result := FStorageInterface.OpenStream(StringToOleStr(AName),
|
|
nil, FMode, 0, TmpStream)
|
|
else
|
|
begin
|
|
// Ïðàâèì ãëþê êîãä?ñòðè?ïðèñóòñòâóåò íî åã?íå?ïð?åíóìåðàöèè
|
|
// Òóïî ñîçäàå?åã? åñëè íå ñîçäàë? - óäàëÿåì ?îïÿòü ñîçäàå?
|
|
Result := FStorageInterface.CreateStream(StringToOleStr(AName),
|
|
FMode, 0, 0, TmpStream);
|
|
if Result <> S_OK then
|
|
begin
|
|
FStorageInterface.DestroyElement(StringToOleStr(AName));
|
|
Result := FStorageInterface.CreateStream(StringToOleStr(AName),
|
|
FMode, 0, 0, TmpStream);
|
|
end;
|
|
end;
|
|
if Result = S_OK then
|
|
begin
|
|
{ TODO : ?TmpStream óäàëÿòü íóæí? }
|
|
OS := TOleStream.Create(TmpStream);
|
|
try
|
|
AStream.Position := 0;
|
|
OS.CopyFrom(AStream, AStream.Size);
|
|
finally
|
|
OS.Free;
|
|
TmpStream := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TGSCustomStorage.Compress(const AFileName: String): HRESULT;
|
|
begin
|
|
Result := ClassSupport(AFileName, True);
|
|
end;
|
|
|
|
class function TGSCustomStorage.IsStgValidBinaryFmt(
|
|
const AFileName: String): HRESULT;
|
|
begin
|
|
Result := ClassSupport(AFileName, False);
|
|
end;
|
|
|
|
class function TGSCustomStorage.ClassSupport(const AFileName: String;
|
|
Change: Boolean): HRESULT;
|
|
var
|
|
Src, Dest: IStorage;
|
|
begin
|
|
Result := S_FALSE;
|
|
if not FileExists(AFileName) then Exit;
|
|
Result := StgOpenStorage(StringToOleStr(AFileName), nil,
|
|
STGM_READ or STGM_SHARE_EXCLUSIVE, nil, 0, Src);
|
|
if Result = S_OK then
|
|
try
|
|
Result := StgCreateDocfile(StringToOleStr(String(AFileName) + '~'),
|
|
STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Dest);
|
|
if Result = S_OK then
|
|
try
|
|
Result := Src.CopyTo(0, nil, nil, Dest);
|
|
finally
|
|
Dest := nil;
|
|
end;
|
|
finally
|
|
Src := nil;
|
|
if Result = S_OK then
|
|
begin
|
|
if Change then
|
|
begin
|
|
if Result = S_OK then
|
|
if not DeleteFile(AFileName) then
|
|
Result := S_FALSE
|
|
else
|
|
RenameFile(AFileName + '~', AFileName);
|
|
end else begin
|
|
if Result = S_OK then
|
|
if not DeleteFile(AFileName + '~') then
|
|
Result := S_FALSE
|
|
end;
|
|
end else
|
|
DeleteFile(AFileName + '~'); // »èÁ¦ Ãß°¡ 18_0726 15:11:38 sunk
|
|
end;
|
|
end;
|
|
|
|
function TGSCustomStorage.GetActive: Boolean;
|
|
begin
|
|
Result := FRootStorage.FStorageInterface <> nil;
|
|
end;
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
class procedure TGSCustomStorage.AddInstance;
|
|
begin
|
|
Inc(TGSCustomStorage_Instance);
|
|
end;
|
|
|
|
constructor TGSCustomStorage.Create;
|
|
begin
|
|
AddInstance;
|
|
end;
|
|
|
|
class function TGSCustomStorage.NumOfInstances: Integer;
|
|
begin
|
|
Result := TGSCustomStorage_Instance;
|
|
end;
|
|
|
|
class procedure TGSCustomStorage.ReleaseInstance;
|
|
begin
|
|
Dec(TGSCustomStorage_Instance);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF CLASS_INSTANCE}
|
|
|
|
initialization
|
|
|
|
finalization
|
|
|
|
if TGSCustomStorage_Instance > 0 then
|
|
raise GSCustomStorageException.Create(Format('%d instances of TGSCustomStorage active', [TGSCustomStorage_Instance]));
|
|
|
|
if TGSStorageCursor_Instance > 0 then
|
|
raise GSCustomStorageException.Create(Format('%d instances of TGSStorageCursor active', [TGSStorageCursor_Instance]));
|
|
|
|
if TGSStorageCursors_Instance > 0 then
|
|
raise GSCustomStorageException.Create(Format('%d instances of TGSStorageCursors active', [TGSStorageCursors_Instance]));
|
|
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|