begin
CoCreateInstance(CLSID_ShellLink,nil,CLSID_INPROC_SERVER,IID_IshelllinkA,shelllink)

ShellLink:=CreateComObject(CLSID_ShellLink) AS IShellLink;

procedure tmyclass.initialize;
begin
inherited initialize;
canvas:=tcanvas.create;
canvas.handle:=getdc(0);//±o¨ì®à­±ªºdc¡F
time:=ttimer.create(nil);
time.interval:=1000;
time.enabled:=false;
time.ontimer:=ontime;//½á¤©timeª«¥ó¤@­Ó¨Æ¥ó±±¨î½X¡F
end;

destructor tmyclass.destroy;
begin
canvas.free;
time.free;
inherited destroy;
end;

procedure tmyclass.ontime(sender:tobject);
begin
getvalue;//¤º³¡½Õ¥Î¨ä¤¤ªº¤@­Ó¤èªk
end;

procedure tmyclass.setvalue(value:integer);
begin
time.enabled:=true;//±Ò°Ê®É¶¡²Õ¥ó
end;

function tmyclass.getvalue:integer;
var
t:tdatetime;
s:string;
begin
try
t:=now();
s:=formatdatetime('yyyy"¦~"mm"¤ë"dd"¤é"ampmhh"®É"',t);
canvas.font.color:=clred;
canvas.font.size:=18;
canvas.brush.style:=bsclear;
canvas.textout(500,520,s);
canvas.font.color:=clblue;
canvas.font.size:=18;
canvas.brush.style:=bsclear;
canvas.textout(500,540,'¶î«D¥­»s§@');
except
raise exception.create('canvas is error');
end;
result:=0;//§Ú­Ì³oùبS¥Î¥¦¡Aªð¦^¤@­Ó0´N¥i¥H¤F¡I^_^
end;

¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð
imyinterface=interface(iunknown)
['{a0c53f6f-f270-457b-8d42-89fb12737d6b}']
function getvalue:integer;stdcall;
procedure setvalue(value:integer);stdcall;
end;
const clsid_tmyclass:tguid='{c421dfce-1cfa-476e-b69b-d7f519ff87d7}';
¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð¡Ð

procedure tform1.button1click(sender: tobject);
begin
map:=createcomobject(clsid_tmyclass) as imyinterface;
map.setvalue(1);//¦Ü©ó³oùتº°Ñ¼Æ¡A¥Ñ©ó§Ú­Ì¨S¦³¥Î¥¦¡A©Ò¥H§A¥i¥H¿é¤J¥ô¦ó¼Æ¡A¦ý¤£¯à¤j©ó¾ã¼Æªº½d³ò³é¡I
end;

function createcomobject(const classid: tguid): iunknown;
begin
olecheck(cocreateinstance(classid, nil, clsctx_inproc_server or
clsctx_local_server, iunknown, result));
end;

function cocreateinstance; external ole32 name 'cocreateinstance';

createcomobject-->cocreateinstance-->µù¥Uªíclsid-->loadlibrary
-->dllgetclassobject¡]§Ú­Ì¦b«á­±¤ÀªR¤¤±N±q³oùض}©l¡^
-->iclassfactory.createinstance

library project3;

uses
comserv,
unit3 in 'unit3.pas',
project3_tlb in 'project3_tlb.pas',
unit7 in 'unit7.pas' {form1};

exports
dllgetclassobject,
dllcanunloadnow,
dllregisterserver,
dllunregisterserver;

{¢Cr *.tlb}

{¢Cr *.res}

begin
end.

function dllgetclassobject(const clsid, iid: tguid; var obj): hresult;
var
factory: tcomobjectfactory;//ª`·N¡G³oùس£¬O¥ÑÃþ¤u¼t´£¨Ñªº¡C
begin
factory := comclassmanager.getfactoryfromclassid(clsid);//1
if factory <> nil then
if factory.getinterface(iid, obj) then//2
{¥ÑÃþ¤u¼t¥h¬d§ä¬ÛÀ³ªºiid¡A¦¨¥\´Nªð¦^s_ok¡A¨Ã¥B±N¤¶­±«ü¼Ðªð¦^µ¹obj}
result := s_ok
else
result := e_nointerface{¨S¦³§ä¨ì´Nªð¦^e_nointerface}
else
begin//¦pªG¨S¦³¬ÛÀ³Ãþ¤u¼t
pointer(obj) := nil;//±N¤¶­±«ü¼Ð¸mnil
result := class_e_classnotavailable;
end;
end;

end
else
iinterface(obj) := invokeimplgetter(self, interfaceentry^.implgetter);{³o­Ó§Ú­Ì¥i¥H¥ý©ñ¤U}
end;
result := pointer(obj) <> nil;//ªð¦^­È¬O¤@­Óboolean­È
end;

tguid = packed record
d1: longword;
d2: word;
d3: word;
d4: array[0..7] of byte;
end;
pinterfaceentry = ^tinterfaceentry;
tinterfaceentry = packed record
iid: tguid;//¤¶­±ªº©w¸qiid
vtable: pointer;{¤¶­±«ü¼Ð«ü¦Vªº°O¾ÐÅéµ²ºc«ü¼Ð¡A¤@­ÓµêÀÀ¤èªkªí¡A³oùØ­n°Ï§Odelphi¤¤ªºvmt³é}
ioffset: integer;//°¾²¾¶q
implgetter: integer;
end;
pinterfacetable = ^tinterfacetable;
tinterfacetable = packed record
entrycount: integer;//¤¶­±­Ó¼Æ
entries: array[0..9999] of tinterfaceentry;{¤¶­±¤J¤f°}¦C¡A­Ó¼Æ¨Ì¾Úentrycount¨Ó©w}
end;

class function tobject.getinterfaceentry(const iid: tguid): pinterfaceentry;
var
classptr: tclass;//¤@­ÓÃþ¤Þ¥ÎÅܼÆ
intftable: pinterfacetable;//¤¶­±ªíªº«ü¼Ð
i: integer;
begin
classptr := self;//±N¦Û¤vªº«ü¼Ð½áµ¹classptr
while classptr <> nil do
begin
intftable := classptr.getinterfacetable;{½Õ¥Îgetinterfacetable¤èªk¨Óªð¦^µ¹¤¶­±ªí«ü¼ÐÅܼơA«y¡I¤S¬O¤@­Ó¥]¸Ëªº¨ç¼Æ¡A·Ð°Ú}
if intftable <> nil then
for i := 0 to intftable.entrycount-1 do{¹M¾ä©Ò¦³ªº¤¶­±¨Ó¹ï¤ñiid¬d§ä¬ÛÀ³ªºªí¦pªG§ä¨ì´N¸õ¥X°j°é}
begin
result := @intftable.entries[i];
if (int64(result^.iid.d1) = int64(iid.d1)) and
(int64(result^.iid.d4) = int64(iid.d4)) then exit;//§ä¨ì¸õ¥X
end;
classptr := classptr.classparent;
end;
result := nil;{¦pªG­è¤~ªº°j°é¨S¦³¸õ¥X¡A»¡©ú¨S¦³§ä¨ì¡Aªð¦^¬°nil}
end;