jclcom.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclCOM.pas.                                                                 }
{                                                                                                  }
{ The Initial Developer of the Original Code is Kevin S. Gallagher. Portions created by Kevin S.   }
{ Gallagher are Copyright (C) Kevin S. Gallagher. All Rights Reserved.                             }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Marcel van Brakel                                                                              }
{   Robert Marquardt (marquardt)                                                                   }
{   Scott Price (scottprice)                                                                       }
{   Robert Rossmair (rrossmair)                                                                    }
{   Olivier Sannier (obones)                                                                       }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ This unit contains Various COM (Component Object Model) utility routines.                        }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/03/08 08:33:22 $
// For history see end of file

unit JclCOM;

{$I jcl.inc}

interface

uses
  Windows, ActiveX, Classes,
  JclBase;

// Various definitions
const
  { Class ID's that may be reused }
  CLSID_StdComponentCategoriesMgr: TGUID = '{0002E005-0000-0000-C000-000000000046}';

  CATID_SafeForInitializing: TGUID = '{7DD95802-9882-11CF-9FA9-00AA006C42C4}';
  CATID_SafeForScripting: TGUID = '{7DD95801-9882-11CF-9FA9-00AA006C42C4}';

  icMAX_CATEGORY_DESC_LEN = 128;

type
  { For use with the Internet Explorer Component Categories Routines.  May be Reused. }
  TArrayCatID = array [0..0] of TGUID;

// Exception classes
type
  EInvalidParam = class(EJclError);

// DCOM and MDAC Related Tests and Utility Routines
function IsDCOMInstalled: Boolean;
function IsDCOMEnabled: Boolean;
function GetDCOMVersion: string;
function GetMDACVersion: string;

// Other Marshalling Routines to complement "CoMarshalInterThreadInterfaceInStream"
{ These routines will provide the ability to marshal an interface for a separate
  process or even for access by a separate machine.  However, to make things
  familiar to users of the existing CoMarshal... routine, I have kept the required
  parameters the same, apart from the "stm" type now being a Var rather than just
  an Out - to allow a little flexibility if the developer wants the destination
  to be a specific stream, otherwise it creates one into the passed variable! }

function MarshalInterThreadInterfaceInVarArray(const iid: TIID;
  unk: IUnknown; var VarArray: OleVariant): HRESULT;
function MarshalInterProcessInterfaceInStream(const iid: TIID;
  unk: IUnknown; var stm: IStream): HRESULT;
function MarshalInterProcessInterfaceInVarArray(const iid: TIID;
  unk: IUnknown; var VarArray: OleVariant): HRESULT;
function MarshalInterMachineInterfaceInStream(const iid: TIID;
  unk: IUnknown; var stm: IStream): HRESULT;
function MarshalInterMachineInterfaceInVarArray(const iid: TIID;
  unk: IUnknown; var VarArray: OleVariant): HRESULT;

// Internet Explorer Component Categories Routines
{ These routines help with the registration of:
    - Safe-Initialization &
    - Safe-for-Scripting
  of ActiveX controls or COM Automation Servers intended to be used in
  HTML pages displayed in Internet Explorer }
{ Conversion of an example found in Microsoft Development Network document:
  MSDN Home >  MSDN Library >  ActiveX Controls >  Overviews/Tutorials
  Safe Initialization and Scripting for ActiveX Controls }

function CreateComponentCategory(const CatID: TGUID; const sDescription: string): HRESULT;
function RegisterCLSIDInCategory(const ClassID: TGUID; const CatID: TGUID): HRESULT;
function UnRegisterCLSIDInCategory(const ClassID: TGUID; const CatID: TGUID): HRESULT;

// Stream Related Routines
{ IDE ISSUE:  These need to be at the bottom of the interface definition as otherwise
              the CTRL+SHIFT+ Up/Down arrows feature no-longer operates }

function ResetIStreamToStart(Stream: IStream): Boolean;
function SizeOfIStreamContents(Stream: IStream): Largeint;

{ Use VarIsEmpty to determine the result of the following XStreamToVariantArray routines!
  VarIsEmptry will return True if VarClear was called - indicating major problem! }

function StreamToVariantArray(Stream: TStream): OleVariant; overload;
function StreamToVariantArray(Stream: IStream): OleVariant; overload;

procedure VariantArrayToStream(VarArray: OleVariant; var Stream: TStream); overload;
procedure VariantArrayToStream(VarArray: OleVariant; var Stream: IStream); overload;

implementation

uses
  {$IFDEF FPC}
  Types,
  {$ENDIF FPC}
  SysUtils,
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  JclFileUtils, JclRegistry, JclResources, JclSysInfo, JclWin32;

{ Implementation Constants - may be reused by more than one routine }

const
  pcOLE32 = 'OLE32.dll';

  { TODO : Utility routine here might need to be re-vamped with the
           use of JclUnicode unit in mind. }

function StringToWideString(const Str: string): WideString;
var
  iLen: Integer;
begin
  iLen:= Length(Str) + 1;
  SetLength(Result, (iLen - 1));
  StringToWideChar(Str, PWideChar(Result), iLen);
end;

//=== DCOM and MDAC Related Tests and Utility Routines =======================

function IsDCOMInstalled: Boolean;
var
  OLE32: HMODULE;
begin
  { DCOM is installed by default on all but Windows 95 }
  Result := not (GetWindowsVersion in [wvUnknown, wvWin95, wvWin95OSR2]);
  if not Result then
  begin
    OLE32 := LoadLibrary(pcOLE32);
    if OLE32 > 0 then
    try
      Result := GetProcAddress(OLE32, PChar('CoCreateInstanceEx')) <> nil;
    finally
      FreeLibrary(OLE32);
    end;
  end;
end;

function IsDCOMEnabled: Boolean;
var
  RegValue: string;
begin
  RegValue := RegReadString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\OLE', 'EnableDCOM');
  Result := (RegValue = 'y') or (RegValue = 'Y');
end;

function GetDCOMVersion: string;
const
  DCOMVersionKey: PChar = 'CLSID\{bdc67890-4fc0-11d0-a805-00aa006d2ea4}\InstalledVersion';
begin
  { NOTE:  This does not work on Windows NT/2000! For a list of DCOM versions:
      http://support.microsoft.com/support/kb/articles/Q235/6/38.ASP }
  Result := '';
  if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and IsDCOMEnabled then
    Result := RegReadString(HKEY_CLASSES_ROOT, DCOMVersionKey, '')
  else
    { Possibly from DComExt.dll 慞roduct Version