mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 13:59:47 +02:00
+ initial revision
This commit is contained in:
parent
c6ea429567
commit
7b33d50f62
28
rtl/objpas/comobj.inc
Normal file
28
rtl/objpas/comobj.inc
Normal file
@ -0,0 +1,28 @@
|
||||
{
|
||||
$Id$
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$ifndef FPC_COMOBJ_HAS_CREATE_CLASS_ID}
|
||||
{ any ideas for a generic implementation? }
|
||||
function CreateClassID : ansistring;
|
||||
begin
|
||||
result:='';
|
||||
end;
|
||||
{$endif FPC_COMOBJ_HAS_CREATE_CLASS_ID}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-10 16:09:25 florian
|
||||
+ initial revision
|
||||
}
|
22
rtl/objpas/comobjh.inc
Normal file
22
rtl/objpas/comobjh.inc
Normal file
@ -0,0 +1,22 @@
|
||||
{
|
||||
$Id$
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
function CreateClassID : ansistring;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-10 16:09:25 florian
|
||||
+ initial revision
|
||||
}
|
50
rtl/win32/comobj.pp
Normal file
50
rtl/win32/comobj.pp
Normal file
@ -0,0 +1,50 @@
|
||||
{
|
||||
$Id$
|
||||
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}
|
||||
unit comobj;
|
||||
|
||||
interface
|
||||
|
||||
{$ifndef VER1_0}
|
||||
{$i comobjh.inc}
|
||||
{$endif VER1_0}
|
||||
|
||||
implementation
|
||||
|
||||
{$ifndef VER1_0}
|
||||
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;
|
||||
|
||||
{$i comobj.inc}
|
||||
{$endif VER1_0}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-10 16:09:39 florian
|
||||
+ initial revision
|
||||
}
|
Loading…
Reference in New Issue
Block a user