1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2002 by Florian Klaempfl
- member of the Free Pascal development team.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {$mode objfpc}
- {$H+}
- unit comobj;
- interface
- function CreateClassID : ansistring;
- function CreateComObject(const ClassID: TGUID) : IUnknown;
- function CreateRemoteComObject(const MachineName : WideString;const ClassID : TGUID) : IUnknown;
- function CreateOleObject(const ClassName : string) : IDispatch;
- function GetActiveOleObject(const ClassName: string) : IDispatch;
- implementation
- uses
- windows,activex;
- {$define FPC_COMOBJ_HAS_CREATE_CLASS_ID}
- function CreateClassID : ansistring;
- var
- ClassID : TCLSID;
- p : PWideChar;
- begin
- CoCreateGuid(ClassID);
- StringFromCLSID(ClassID,p);
- result:=p;
- CoTaskMemFree(p);
- end;
- function CreateComObject(const ClassID : TGUID) : IUnknown;
- begin
- {!!!!!!!}
- runerror(211);
- end;
- function CreateRemoteComObject(const MachineName : WideString;const ClassID : TGUID) : IUnknown;
- begin
- {!!!!!!!}
- runerror(211);
- end;
- function CreateOleObject(const ClassName : string) : IDispatch;
- begin
- {!!!!!!!}
- runerror(211);
- end;
- function GetActiveOleObject(const ClassName : string) : IDispatch;
- begin
- {!!!!!!!}
- runerror(211);
- end;
- end.
|