▲包含窗体的进程内自动化服务器 (in-process Automation server，DLL)
by lazybones
第一步，建立ActiveX Library
File->New->Other->ActiveX Library，存盘取名inprocess
第二步，添加Automation Object
File->New->Other->Automation Object，CoClass Name取名getstring，选择Igetstring，单击New Property按钮旁边的下拉箭头，增加一个Read Only的属性thestring，Type为 BSTR，单击New Method，增加一个freeform方法，再单击New Method，增加一个showmodelform方法，单击Parameters标签，Name为str，Type为BSTR，刷新
第三步，添加窗体
File->New->Form，添加一个编辑框。全部保存
第四部，完善代码
首先需要在unit1中uses unit2，再完成代码，编译、注册
//ActiveX Library
library inprocess;
uses
ComServ,
inprocess_TLB in 'inprocess_TLB.pas',
Unit1 in 'Unit1.pas',
Unit2 in 'Unit2.pas' {Form2};
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.
//Automation Object
unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, inprocess_TLB, StdVcl,unit2;
type
Tgetstring = class(TAutoObject, Igetstring)
protected
function Get_thestring: WideString; safecall;
procedure freeform; safecall;
procedure showmodelform(const str: WideString); safecall;
end;
implementation
uses ComServ;
function Tgetstring.Get_thestring: WideString;
begin
result:=form2.Edit1.Text;
end;
procedure Tgetstring.freeform;
begin
form2.Free;
end;
procedure Tgetstring.showmodelform(const str: WideString);
begin
form2:=TForm2.Create(nil);
form2.Edit1.Text:=str;
form2.ShowModal;//注意，和上一句顺序不能颠倒
end;
initialization
TAutoObjectFactory.Create(ComServer, Tgetstring, Class_getstring,
ciMultiInstance, tmApartment);
end.
//Automation Object(TLB)
unit inprocess_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 2005-7-23 23:17:31 from Type Library described below.
// ************************************************************************ //
// Type Lib: C:/Documents and Settings/Administrator/My Documents/Borland Studio Projects/ooo/inprocess.tlb (1)
// LIBID: {5B026064-6CED-4AEB-9AF4-7B246AF2518B}
// LCID: 0
// Helpfile:
// HelpString: inprocess Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
inprocessMajorVersion = 1;
inprocessMinorVersion = 0;
LIBID_inprocess: TGUID = '{5B026064-6CED-4AEB-9AF4-7B246AF2518B}';
IID_Igetstring: TGUID = '{D2D01F47-D4EB-4D87-91F5-AF6600E8DFAF}';
CLASS_getstring: TGUID = '{A2E7576F-16DC-404C-8145-9F0F0BE50868}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
Igetstring = interface;
IgetstringDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
getstring = Igetstring;
// *********************************************************************//
// Interface: Igetstring
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {D2D01F47-D4EB-4D87-91F5-AF6600E8DFAF}
// *********************************************************************//
Igetstring = interface(IDispatch)
['{D2D01F47-D4EB-4D87-91F5-AF6600E8DFAF}']
function Get_thestring: WideString; safecall;
procedure freeform; safecall;
procedure showmodelform(const str: WideString); safecall;
property thestring: WideString read Get_thestring;
end;
// *********************************************************************//
// DispIntf: IgetstringDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {D2D01F47-D4EB-4D87-91F5-AF6600E8DFAF}
// *********************************************************************//
IgetstringDisp = dispinterface
['{D2D01F47-D4EB-4D87-91F5-AF6600E8DFAF}']
property thestring: WideString readonly dispid 201;
procedure freeform; dispid 202;
procedure showmodelform(const str: WideString); dispid 203;
end;
// *********************************************************************//
// The Class Cogetstring provides a Create and CreateRemote method to
// create instances of the default interface Igetstring exposed by
// the CoClass getstring. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
Cogetstring = class
class function Create: Igetstring;
class function CreateRemote(const MachineName: string): Igetstring;
end;
implementation
uses ComObj;
class function Cogetstring.Create: Igetstring;
begin
Result := CreateComObject(CLASS_getstring) as Igetstring;
end;
class function Cogetstring.CreateRemote(const MachineName: string): Igetstring;
begin
Result := CreateRemoteComObject(MachineName, CLASS_getstring) as Igetstring;
end;
end.
// Form2
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Edit1: TEdit;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
end.
‘VBA控制器代码
Private Sub CommandButton1_Click()
Dim auto
Dim ret
Set auto = CreateObject("inprocess.getstring"
auto.showmodelform ("Welcom"
ret = auto.thestring
auto.freeform
MsgBox ret
End Sub
总结：
1、 曲折地实现了预想的功能。
2、 实验显示，在CreateObject之后，Show或ShowModel之前，对于控制器来说，服务器的窗体及控件不可用；而一旦ShowModel，进程则停留在服务器，只有在窗体关闭后，进程才回到控制器，总之，控制器不能直接通过服务器的属性来对其进行设定很不爽。
3、 下一课题是如何将数据库封装成服务器，在控制器和服务器之间传递复杂数据类型。
