tdocfile_u1.pas

是一个delphi的流程制作软件

///////////////////////////TDocFileStorage/////////////////////////////
//
//--------------------------------------------------------------------

constructor TDocFileStorage.Create(  Storage : IStorage  );
begin
   inherited Create;

   FStorage := Storage;

   if(  FStorage = nil  ) then
      FsLastError := 'Storage is nil'
   else
      FsLastError := '';
end;



destructor TDocFileStorage.Destroy;
begin
   FStorage := nil;

   inherited Destroy;
end;




function TDocFileStorage.MyOleCheck(  Hr : HResult  ) : boolean;
var
   bOk : boolean;
begin
   bOk := SUCCEEDED(  Hr  );

   if(  not bOk  ) then
   begin
         {Get the error string}
      FsLastError := SysErrorMessage(  Hr  );
      bOk := false;
   end;

   Result := bOk;
end;



function TDocFileStorage.GetStorageName : string;
var
   StatStg : TSTATSTG;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := '';
      Exit;
   end;

   FsLastError := '';

      {Return the name of this storage}
   FStorage.Stat(  StatStg,  0  );
   Result := StatStg.pwcsName;
end;



function TDocFileStorage.GetStorageCLSID : TCLSID;
var
   StatStg : TSTATSTG;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := CLSID_NULL;
      Exit;
   end;

   FsLastError := '';

      {Return storage's CLSID}
   FStorage.Stat(  StatStg,  0  );
   Result := StatStg.clsid;
end;



function TDocFileStorage.GetStorageCLSID_string : string;
var
   pw : PWideChar;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := '';
      Exit;
   end;

   FsLastError := '';

      {Return storage's CLSID as a string}
   StringFromCLSID(  GetStorageCLSID,  pw  );
   Result := pw;
   CoTaskMemFree(  pw  );
end;



function TDocFileStorage.DeleteElement(  sElementName : WideString  ) : boolean;
var
   Hr : HResult;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';

      {Delete the list}
   Hr := FStorage.DestroyElement(  PWideChar(sElementName)  );

   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := false;
      Exit;
   end;

   Result := true;
end;



function TDocFileStorage.RenameElement(  sOldName,  sNewName : WideString  ) : boolean;
var
  Hr : HResult;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';

      {Rename}
   Hr := FStorage.RenameElement(  PWideChar(sOldName),  PWideChar(sNewName)  );

      {If rename failed}
   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := false;
      Exit;
   end;

   Result := true;
end;



function TDocFileStorage.CopyTo(  DestStorage : IStorage  ) : boolean;
var
  Hr : HResult;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   if(  DestStorage = nil  ) then
   begin
      FsLastError := 'Destination Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';

      {Copy whole storage}
   Hr := FStorage.CopyTo(  0,  nil,  nil,  DestStorage  );

      {If move failed}
   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := false;
      Exit;
   end;

   Result := true;
end;



function TDocFileStorage.MoveElementTo(  sName : WideString;
                                       DestStorage : IStorage;
                                       sNewName : WideString;
                                       dwFlags : DWORD
                                     ) : boolean;
var
  Hr : HResult;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';

   if(  DestStorage = nil  ) then
   begin
      FsLastError := 'Destination storage is nil';
      Result := false;
      Exit;
   end;

      {Move}
   Hr := FStorage.MoveElementTo(  PWideChar(sName),
                                  DestStorage,
                                  PWideChar(sNewName),
                                  dwFlags
                                );

      {If move failed}
   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := false;
      Exit;
   end;

   Result := true;
end;



function TDocFileStorage.OpenStream(  sStreamName : WideString;  dwFlags : DWORD  ) : TDocFileStream;
var
   Hr : HResult;
   Stream : IStream;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := nil;
      Exit;
   end;

   FsLastError := '';

      {Open stream}
   Hr := FStorage.OpenStream(  PWideChar(sStreamName),
                               nil,
                               dwFlags,
                               0,
                               Stream
                             );

      {Opened?}
   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := nil;
      Exit;
   end;

   Result := TDocFileStream.Create(  Stream  );
end;



function TDocFileStorage.CreateStream(  sStreamName : WideString;  dwFlags : DWORD  ) : TDocFileStream;
var
   Hr : HResult;
   Stream : IStream;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := nil;
      Exit;
   end;

   FsLastError := '';

      {Create stream}
   Hr := FStorage.CreateStream(  PWideChar(sStreamName),
                                 dwFlags,
                                 0,
                                 0,
                                 Stream
                               );

      {Created?}
   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := nil;
      Exit;
   end;

   Result := TDocFileStream.Create(  Stream  );
end;



function TDocFileStorage.OpenCreateStream(  sStreamName : WideString;
                                          dwOpenFlags,  dwCreateFlags : DWORD
                                        ) : TDocFileStream;
var
   MyOleStream : TDocFileStream;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := nil;
      Exit;
   end;

   FsLastError := '';

      {Try to open}
   MyOleStream := OpenStream(  sStreamName,  dwOpenFlags  );

      {Was the stream opened?}
   if(  MyOleStream <> nil  ) then
   begin
      Result := MyOleStream;
      Exit;
   end;

      {Stream was not opened, so try to create}
   MyOleStream := CreateStream(  sStreamName,  dwCreateFlags  );

      {Was the stream created?}
   if(  MyOleStream <> nil  ) then
   begin
      Result := MyOleStream;
      Exit;
   end;

   Result := nil;
end;



function TDocFileStorage.OpenStorage(  sStorageName : WideString;
                                     dwFlags : DWORD
                                   ) : TDocFileStorage;
var
   Hr : HResult;
   Storage : IStorage;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := nil;
      Exit;
   end;

   FsLastError := '';

      {Open the storage}
   Hr := FStorage.OpenStorage(  PWideChar(sStorageName),
                                nil,
                                dwFlags,
                                nil,
                                0,
                                Storage
                              );

      {Check if the storage was opened}
   if(  not MyOleCheck(  Hr  )  ) then
   begin
      Result := nil;
      Exit;
   end;

      {Return the opened storage}
   Result := TDocFileStorage.Create(  Storage  );
end;



function TDocFileStorage.CreateStorage(  sStorageName : WideString;
                                       dwFlags : DWORD
                                     ) : TDocFileStorage;
var
   Hr : HResult;
   Storage : IStorage;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := nil;
      Exit;
   end;

   FsLastError := '';

      {Create a storage}
   Hr := FStorage.CreateStorage(  PWideChar(sStorageName),
                                  dwFlags,
                                  0,
                                  0,
                                  Storage
                                );

      {Created?}
   if(   not MyOleCheck(  Hr  )   ) then
   begin
      Result := nil;
      Exit;
   end;

   Result := TDocFileStorage.Create(  Storage  );
end;



function TDocFileStorage.OpenCreateStorage(  sStorage : WideString;
                                           dwOpenFlags,  dwCreateFlags : DWORD
                                         ) : TDocFileStorage;
var
   MyOleStorage : TDocFileStorage;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := nil;
      Exit;
   end;

   FsLastError := '';

      {Try to open}
   MyOleStorage := OpenStorage(  sStorage,  dwOpenFlags  );

      {Was the storage opened?}
   if(  MyOleStorage <> nil  ) then
   begin
      Result := MyOleStorage;
      Exit;
   end;

      {Storage was not opened, so try to create}
   MyOleStorage := CreateStorage(  sStorage,  dwCreateFlags  );

      {Was the storage created?}
   if(  MyOleStorage <> nil  ) then
   begin
      Result := MyOleStorage;
      Exit;
   end;

   Result := nil;
end;



function TDocFileStorage.EnumElements(  EnumFunc : EnumElementsCallBack_Func;
                                      pData : pointer
                                    ) : boolean;
var
   Hr : HResult;
   Enum : IEnumSTATSTG;
   StatStg : TStatStg;
   bContinue : boolean;
   NumFetched : integer;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';


      {Start enumeration}
   Hr := FStorage.EnumElements(  0,  nil,  0,  Enum  );

      {Enum started Ok?}
   if(  Hr <> S_OK  ) then
   begin
      FsLastError := 'Failed to start enum';
      Result := false;
      Exit;
   end;

   bContinue := true;

      {For every item in the STATSTG}
   repeat
         {Get 1 STATSTG}
      Hr := Enum.Next(  1,  StatStg,  @NumFetched  );

         {Was a STATSTG retrieved?}
      if(  Hr <> S_OK  ) then
         continue;

         {Call the call-back function}
      bContinue := EnumFunc(  StatStg.pwcsName,  StatStg.dwType,  pData  );

      {Until an error occurs, or enum function indicates a stop}
   until (  (Hr <> S_OK) or (not bContinue)  );

   Result := true;
end;



function TDocFileStorage.SetCLSID(  CLSID : TCLSID  ) : boolean;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';

   Result := SUCCEEDED(   FStorage.SetClass(  CLSID  )   );
end;



function TDocFileStorage.Commit(  dwFlag : DWORD  ) : boolean;
begin
   if(  FStorage = nil  ) then
   begin
      FsLastError := 'Storage is nil';
      Result := false;
      Exit;
   end;

   FsLastError := '';

   Result := SUCCEEDED(   FStorage.Commit(  dwFlag  )   );
end;


end.