+ ClassIDToProgID, resolves #10600

git-svn-id: trunk@9741 -

packages/winunits-base/src/activex.pp

@@ -42,7 +42,7 @@ TYPE
      OleChar             = WChar;
      LPOLESTR            = ^OLECHAR;
 
-CONST 
+CONST
    GUID_NULL  : TGUID =  '{00000000-0000-0000-0000-000000000000}';
 
      // bit flags for IExternalConnection
@@ -3194,6 +3194,7 @@ type
 
   function CoIsOle1Class(const _para1:TCLSID):BOOL;stdcall; external  'ole32.dll' name 'CoIsOle1Class';
 
+  function ProgIDFromCLSID(para:PCLSID; out _para2:POLESTR):HRESULT;stdcall; external  'ole32.dll' name 'ProgIDFromCLSID';
   function ProgIDFromCLSID(const _para1:TCLSID; out _para2:POLESTR):HRESULT;stdcall; external  'ole32.dll' name 'ProgIDFromCLSID';
 
   function CLSIDFromProgID(_para1:POLESTR; _para2:LPCLSID):HRESULT;stdcall; external  'ole32.dll' name 'CLSIDFromProgID';

packages/winunits-base/src/comobj.pp

@@ -186,6 +186,7 @@ unit comobj;
     procedure OleError(Code: HResult);
 
     function ProgIDToClassID(const id : string) : TGUID;
+    function ClassIDToProgID(const classID: TGUID): string;
 
     procedure DispatchInvoke(const Dispatch: IDispatch; CallDesc: PCallDesc;
        DispIDs: PDispIDList; Params: Pointer; Result: PVariant);
@@ -196,6 +197,7 @@ unit comobj;
 
     function ComClassManager : TComClassManager;
 
+
     type
       TCoCreateInstanceExProc = function(const clsid: TCLSID; unkOuter: IUnknown; dwClsCtx: DWORD; ServerInfo: PCoServerInfo;
       dwCount: ULONG; rgmqResults: PMultiQIArray): HResult stdcall;
@@ -363,6 +365,16 @@ implementation
      end;
 
 
+   function ClassIDToProgID(const classID: TGUID): string;
+     var
+       progid : LPOLESTR;
+     begin
+       OleCheck(ProgIDFromCLSID(@classID,progid));
+       result:=progid;
+       CoTaskMemFree(progid);
+     end;
+
+
    procedure SafeCallErrorHandler(err : HResult;addr : pointer);
      var
        info : IErrorInfo;