Доброго дня господа
Решение по пунктам
1. Создать класс, который будет подключать COM- сервер,
в нем одно поле (Edit1), которое будет меняться
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
unit frMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
SetCurrentDir(Edit1.Text);
end;
end.
2.File->New->Other->ActiveX->ActiveX Library
Это заготовка библиотеки проекта, меняем название, подключает frMain
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
library MyLibrary;
uses
ComServ,
MyLibrary_TLB in 'MyLibrary_TLB.pas',
MyClass in 'MyClass.pas' {MyClass: CoClass},
frMain in 'frMain.pas' {Form1};
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.
3.File->New->Other->ActiveX->Automation Object
Вводим имя сокласса = MyClass, + check на создание библиотеки типов
Создаем один Properry в окне редактора библиотеки типов = LastValue
Используя это свойство буду менять frMain.Edit1.Text
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
unit MyLibrary_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 11/09/2019 22:22:17 from Type Library described below.
// ************************************************************************ //
// Type Lib: C:\WORK\COM_MY\MyLibrary.tlb (1)
// LIBID: {4A03744B-CA0F-4144-952C-3AA83A5FC1E0}
// LCID: 0
// Helpfile:
// HelpString: MyLibrary 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
MyLibraryMajorVersion = 1;
MyLibraryMinorVersion = 0;
LIBID_MyLibrary: TGUID = '{4A03744B-CA0F-4144-952C-3AA83A5FC1E0}';
IID_IMyClass: TGUID = '{BD29A72C-421A-4F3A-9C7C-414F9BA055F9}';
CLASS_MyClass: TGUID = '{62C64048-DC29-4AEA-B9F3-3A0F7999130A}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IMyClass = interface;
IMyClassDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
MyClass = IMyClass;
// *********************************************************************//
// Interface: IMyClass
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {BD29A72C-421A-4F3A-9C7C-414F9BA055F9}
// *********************************************************************//
IMyClass = interface(IDispatch)
['{BD29A72C-421A-4F3A-9C7C-414F9BA055F9}']
function Get_LastValue: WideString; safecall;
procedure Set_LastValue(const Value: WideString); safecall;
property LastValue: WideString read Get_LastValue write Set_LastValue;
end;
// *********************************************************************//
// DispIntf: IMyClassDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {BD29A72C-421A-4F3A-9C7C-414F9BA055F9}
// *********************************************************************//
IMyClassDisp = dispinterface
['{BD29A72C-421A-4F3A-9C7C-414F9BA055F9}']
property LastValue: WideString dispid 201;
end;
// *********************************************************************//
// The Class CoMyClass provides a Create and CreateRemote method to
// create instances of the default interface IMyClass exposed by
// the CoClass MyClass. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMyClass = class
class function Create: IMyClass;
class function CreateRemote(const MachineName: string): IMyClass;
end;
implementation
uses ComObj;
class function CoMyClass.Create: IMyClass;
begin
Result := CreateComObject(CLASS_MyClass) as IMyClass;
end;
class function CoMyClass.CreateRemote(const MachineName: string): IMyClass;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MyClass) as IMyClass;
end;
end.
В коде сокласса -
- приписать момент создания основной формы
- write-read-er на изменение свойства LastValue
- прописать момент удаление формы
Т.е.
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
function Get_LastValue: WideString; safecall;
procedure Set_LastValue(const Value: WideString); safecall;
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
unit MyClass;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, AxCtrls, Classes, MyLibrary_TLB, StdVcl, frMain, Dialogs;
type
TMyClass = class(TAutoObject, IConnectionPointContainer, IMyClass)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
{ note: FEvents maintains a *single* event sink. For access to more
than one event sink, use FConnectionPoint.SinkList, and iterate
through the list of sinks. }
Form1: TForm1;
public
procedure Initialize; override;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
function Get_LastValue: WideString; safecall;
procedure Set_LastValue(const Value: WideString); safecall;
end;
implementation
uses ComServ;
procedure TMyClass.EventSinkChanged(const EventSink: IUnknown);
begin
end;
procedure TMyClass.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then FConnectionPoint := FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID, ckSingle, EventConnect) else FConnectionPoint := nil;
end;
function TMyClass.Get_LastValue: WideString;
begin
Result:=Form1.Edit1.Text;
end;
procedure TMyClass.Set_LastValue(const Value: WideString);
begin
Form1.Edit1.Text:=Value;
end;
procedure TMyClass.AfterConstruction;
begin
inherited;
Form1:= TForm1.Create(nil);
Form1.Show;
end;
procedure TMyClass.BeforeDestruction;
begin
ShowMessage('Disconnect');
if assigned(Form1) then Form1.Free;
inherited;
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyClass, Class_MyClass, ciMultiInstance, tmApartment);
end.
2. regsvr32.exe MyLibrarry.dll
3. Вызовы из VBS+MO
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Dim lb
On Error Resume Next
Err.Clear
MsgBox "Create Dll"
Set lb = CreateObject("MyLibrary.MyClass")
lb.LastValue = "huilo"
MsgBox lb.LastValue
MsgBox Err.Source & "_" & Err.Description & "_" & Err.Number
On Error Goto 0
MsgBox "Exit"
Dim w As New MyClass
Sub ff12()
w.LastValue = "huilo"
MsgBox w.LastValue
End Sub
Основная ошибка допущенная ранее - регистрация типа, а не объекта
3.File->New->Other->ActiveX->
Automation Object
initialization
TAutoObjectFactory.Create(ComServer, TMyClass, Class_MyClass, ciMultiInstance, tmApartment);
Всем сспасибо