olestd.pas

是一个delphi的流程制作软件

  try
    if Assigned (Storage) then
      OleCheck (Storage.RenameElement (WOldName, WNewName), NewName)
    else
      OleError (STG_E_STORAGECANTBENIL)
  finally
    OleStdFreeString (WOldName);
    OleStdFreeString (WNewName)
  end
end;

//--- OleStdGetEnumerator
// Returns the storage enumerator interface
function OleStdGetEnumerator (Storage : IStorage) : IEnumStatStg;
begin
  if Assigned (Storage) then
    OleCheck (Storage.EnumElements (0, nil, 0, Result))
  else
    OleError (STG_E_STORAGECANTBENIL)
end;

//--- OleStdDeleteElement
// Delete the named element
procedure OleStdDeleteElement (Storage : IStorage; const Name : string);
var
  Buffer : POleStr;
begin
  CheckName (Name);
  Buffer := OleStdCopyPasString (Name);
  try
    if Assigned (Storage) then
      OleCheck (Storage.DestroyElement (Buffer), Name)
    else
      OleError (STG_E_STORAGECANTBENIL)
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdCreateStream
// Create a new named IStream within the IStorage
function OleStdCreateStream (Storage : IStorage; const Name : string; Mode : integer) : IStream;
var
  Buffer : POleStr;
begin
  CheckName (Name);
  Buffer := OleStdCopyPasString (Name);
  try
    if Assigned (Storage) then
      OleCheck (Storage.CreateStream (Buffer, Mode, 0, 0, Result), Name)
    else
      OleError (STG_E_STORAGECANTBENIL)
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdOpenStream
// Open a named stream within a IStorage
function OleStdOpenStream (Storage : IStorage; const Name : string; Mode : integer) : IStream;
var
  Buffer : POleStr;
begin
  CheckName (Name);
  Buffer := OleStdCopyPasString (Name);
  try
    if Assigned (Storage) then
      OleCheck (Storage.OpenStream (Buffer, nil, Mode, 0, Result), Name)
    else
      OleError (STG_E_STORAGECANTBENIL)
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdIsStorage
// Returns true if the given filename is a IStorage file
function OleStdIsStorage (const Name : string) : boolean;
var
  Returned : HRESULT;
  Buffer : POleStr;
begin
  Buffer := OleStdCopyPasString (Name);
  try
    Returned := StgIsStorageFile (Buffer);
    case Returned of
      S_OK    : Result := true;
      S_FALSE : Result := false
    else
      Result := false;
      OleError (Returned, Name)
    end
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdIsStorage
// Returns true if the give ILockBytes interface is IStorage
function OleStdIsStorage (LockBytes : ILockBytes) : boolean;
var
  Returned : HRESULT;
begin
  Returned := StgIsStorageILockBytes(LockBytes);
  case Returned of
    S_OK    : Result := true;
    S_FALSE : Result := false
  else
    Result := false;
    OleError (Returned)
  end
end;

//--- OleStdCLSIDToString
// Wrapper for standard function to return a delphi string
function OleStdCLSIDToString (const CLSID : TCLSID) : string;
var
  Buffer : PWideChar;
begin
  StringFromCLSID (CLSID, Buffer);
  Result := Buffer;
  OleStdFreeString (Buffer)
end;

//--- OleStdStringToCLSID
// Try to convert a given string to a CLSID (very fussy)
function OleStdStringToCLSID (const Str : string) : TCLSID;
var
  Buffer : POleStr;
begin
  Buffer := OleStdCopyPasString (Str);
  try
    OleCheck (CLSIDFromString (Buffer, Result))
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdCLSIDProgId
// Wrapper for stadard call to obtain a ProgId returning a delphi string
function OleStdCLSIDToProgId (const CLSID : TCLSID) : string;
var
  Buffer : PWideChar;
begin
  ProgIDFromCLSID (CLSID, Buffer);
  Result := Buffer;
  OleStdFreeString (Buffer)
end;

//---OleStdSaveRootStorage
// Creates and opens a new storage object nested within this storage object.
procedure OleStdSaveRootStorage (RootStorage : IRootStorage; const Name : string);
var
  Buffer : POleStr;
begin
  Buffer := OleStdCopyPasString (Name);
  try
    if Assigned (RootStorage) then
      OleCheck (RootStorage.SwitchToFile (Buffer), Name)
    else
      OleError (STG_E_STORAGECANTBENIL)
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdSetTimes

procedure OleStdSetTimes (Storage : IStorage; const Name : string; Created, Accessed, Modified : TFileTime);
var
  Buffer : POleStr;
begin
  Buffer := OleStdCopyPasString (Name);
  try
    if Assigned (Storage) then
      OleCheck (Storage.SetElementTimes (Buffer, Created, Accessed, Modified), Name)
    else
      OleError (STG_E_STORAGECANTBENIL)
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdSetTimes
// Touch times associated with storage file
procedure OleStdSetTimes (const Name : string; Created, Accessed, Modified : TFileTime);
var
  Buffer : POleStr;
begin
  Buffer := OleStdCopyPasString (Name);
  try
    OleCheck (StgSetTimes (Buffer, Created, Accessed, Modified), Name)
  finally
    OleStdFreeString (Buffer)
  end
end;

//--- OleStdWriteClass
// Simple wrapper to produce an exception on error
procedure OleStdWriteClass (Storage : IStorage; CLSID : TCLSID);
begin
  OleCheck (WriteClassStg (Storage, CLSID))
end;

function OleStdReadClass (Storage : IStorage) : TCLSID;
begin
  OleCheck (ReadClassStg (Storage, Result))
end;

//---OleStdWriteFmt & OleStdReadFmt
// Read and write format and user type name to a storage
procedure OleStdWriteFmt (Storage : IStorage; Format : TClipFormat; const UserType : string);
var
  Buffer : POleStr;
begin
  Buffer := OleStdCopyPasString (UserType);
  try
    OleCheck (WriteFmtUserTypeStg (Storage, Format, Buffer))
  finally
    OleStdFreeString (Buffer)
  end
end;

procedure OleStdReadFmt (Storage : IStorage; var Format : TClipFormat; var UserType : string);
var
  Buffer : POleStr;
begin
  OleCheck (ReadFmtUserTypeStg (Storage, Format, Buffer));
  UserType := Buffer;
  OleStdFreeString (Buffer)
end;

//--- SetFormatEtc
// Fill in a TFormatEtc record using one line of code with lots
// of defaults
function SetFormatEtc (Cf : TClipFormat; med: Longint; td: PDVTargetDevice = nil;
  Asp: Longint = DVASPECT_CONTENT; li: Longint = -1) : TFormatEtc;
begin
  with Result do
  begin
    cfFormat := cf;
    dwAspect := asp;
    ptd := td;
    tymed := med;
    lindex := li
  end
end;

// Internal function
function CreateICorDC (ptd : PDVTargetDevice; IC : boolean) : hDC;
var
  DriverName,
  DeviceName,
  PortName : PChar;
  DevMode : PDevMode;
begin
//  Result := 0;
  if not Assigned (ptd) then
    if IC then
      Result := CreateIC ('DISPLAY', nil, nil, nil)
    else
      Result := CreateDC ('DISPLAY', nil, nil, nil)
  else begin
    if ptd.tdExtDevmodeOffset = 0 then
      DevMode := nil
    else
      DevMode := PDevMode (integer (ptd) + ptd.tdExtDevmodeOffset);

    DriverName := PChar (ptd) + ptd.tdDriverNameOffset;
    if ptd.tdDeviceNameOffset = 0 then
      DeviceName := nil
    else
      DeviceName := PChar (ptd) + ptd.tdDeviceNameOffset;

    if ptd.tdPortNameOffset = 0 then
      PortName := nil
    else
      PortName   := PChar (Ptd) + ptd.tdPortNameOffset;

    if IC then
      Result := CreateIC (DriverName, DeviceName, PortName, DevMode)
    else
      Result := CreateDC (DriverName, DeviceName, PortName, DevMode)
  end
end;

//--- OleStdCreateDC
// Returns a device context as a PDVTargetDevice
function OleStdCreateDC (ptd : PDVTargetDevice) : hDC;
begin
  Result := CreateICorDC (ptd, false)
end;

//--- OleStdCreateIC
// Same as OleStdCreateDC, except that information context is created, rather 
// than a whole device context.  (CreateIC is used rather than CreateDC).
// OleStdDeleteDC is still used to delete the information context.
function OleStdCreateIC (ptd : PDVTargetDevice) : hDC;
begin
  Result := CreateICorDC (ptd, true)
end;

(* @@ need to fix this
/*
 * OleStdCreateTargetDevice()
 *
 * Purpose:
 *
 * Parameters:
 *
 * Return Value:
 *    SCODE  -  S_OK if successful
 */
STDAPI_(DVTARGETDEVICE FAR* ) OleStdCreateTargetDevice(LPPRINTDLG lpPrintDlg)
{
        DVTARGETDEVICE FAR* ptd=NULL;
        LPDEVNAMES lpDevNames, pDN;
        LPDEVMODE lpDevMode, pDM;
        UINT nMaxOffset;
        LPSTR pszName;
        DWORD dwDevNamesSize, dwDevModeSize, dwPtdSize;

        if ((pDN = (LPDEVNAMES)GlobalLock(lpPrintDlg->hDevNames)) == NULL) {
                goto errReturn;
        }

        if ((pDM = (LPDEVMODE)GlobalLock(lpPrintDlg->hDevMode)) == NULL) {
                goto errReturn;
        }

        nMaxOffset =  (pDN->wDriverOffset > pDN->wDeviceOffset) ?
                pDN->wDriverOffset : pDN->wDeviceOffset ;

        nMaxOffset =  (pDN->wOutputOffset > nMaxOffset) ?
                pDN->wOutputOffset : nMaxOffset ;

        pszName = (LPSTR)pDN + nMaxOffset;

        dwDevNamesSize = (DWORD)(nMaxOffset+lstrlen(pszName) + 1/* NULL term */);
        dwDevModeSize = (DWORD) (pDM->dmSize + pDM->dmDriverExtra);

        dwPtdSize = sizeof(DWORD) + dwDevNamesSize + dwDevModeSize;

        if ((ptd = (DVTARGETDEVICE FAR* )OleStdMalloc(dwPtdSize)) != NULL) {

                // copy in the info
                ptd->tdSize = (UINT)dwPtdSize;

                lpDevNames = (LPDEVNAMES) &ptd->tdDriverNameOffset;
                _fmemcpy(lpDevNames, pDN, (size_t)dwDevNamesSize);

                lpDevMode=(LPDEVMODE)(/*(LPSTR)*/&ptd->tdDriverNameOffset+dwDevNamesSize);
                _fmemcpy(lpDevMode, pDM, (size_t)dwDevModeSize);

                ptd->tdDriverNameOffset += 4 ;
                ptd->tdDeviceNameOffset += 4 ;
                ptd->tdPortNameOffset   += 4 ;
                ptd->tdExtDevmodeOffset = (UINT)dwDevNamesSize + 4 ;
        }

errReturn:
        GlobalUnlock(lpPrintDlg->hDevNames);
        GlobalUnlock(lpPrintDlg->hDevMode);

        return ptd;
}
*)

//--- OleStdDeleteTargetDevice
procedure OleStdDeleteTargetDevice (ptd : PDVTargetDevice);
begin
  if Assigned (ptd) then
    OleStdFree (ptd)
end;

//--- OleStdCopyTargetDevice()
// Duplicate a TARGETDEVICE struct. this function allocates memory for
// the copy. the caller MUST free the allocated copy when done with it
// using the standard allocator returned from CoGetMalloc.