Hallo!
ich mache gerade meine ersten Schritte mit COM und bin dabei auf ein paar Probleme gestoßen die ich bis jetzt leider nicht löschen konnte.
Worum geht's:
Ich will ein Programm (Server) durch ein anderes (Client) fernsteuern. Sofern der Server nicht bereits läuft soll der Client diesen starten. Vom Server soll immer höchstens eine Instanz aktiv sein.
Was habe ich gemacht:
Für den Server habe ich zunächst ein neues VCL-Form Projekt erstellt und auf das Form habe ich zwei TEdits gesetzt. Dann habe ich über Datei/Neu/Weitere.../ActiveX/ ein Automatisierungsobjekt (TCOMTester) für das Projekt erstellt. Das Interface enthält Getter und Setter für die Edit Texte und eine Methode mit der eine Nachricht angezeigt werden soll:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
| ICOMTester = interface(IDispatch)
['{70419B55-8B32-434A-8023-BA303A150146}']
function ShowTestMessage(const Text: WideString): WideString; stdcall;
function Get_Edit1Text: WideString; safecall;
procedure Set_Edit1Text(const Value: WideString); safecall;
function Get_Edit2Text: WideString; safecall;
procedure Set_Edit2Text(const Value: WideString); safecall;
property Edit1Text: WideString read Get_Edit1Text write Set_Edit1Text;
property Edit2Text: WideString read Get_Edit2Text write Set_Edit2Text;
end; |
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:
| type
TCOMTester = class(TAutoObject, ICOMTester)
protected
function Get_Edit1Text: WideString; safecall;
function Get_Edit2Text: WideString; safecall;
function ShowTestMessage(const Text: WideString): WideString; stdcall;
procedure Set_Edit1Text(const Value: WideString); safecall;
procedure Set_Edit2Text(const Value: WideString); safecall;
end;
implementation
uses ComServ, main , Dialogs;
function TCOMTester.Get_Edit1Text: WideString;
begin
result := Form1.Edit1.Text;
end;
function TCOMTester.Get_Edit2Text: WideString;
begin
result := Form1.Edit2.Text;
end;
function TCOMTester.ShowTestMessage(const Text: WideString): WideString;
begin
ShowMessage(Text);
result := 'Es wurde eine Nachricht mit folgendem Text angezeigt'+#13#13+Text;
end;
procedure TCOMTester.Set_Edit1Text(const Value: WideString);
begin
Form1.Edit1.Text := Value;
end;
procedure TCOMTester.Set_Edit2Text(const Value: WideString);
begin
Form1.Edit2.Text := Value;
end;
initialization
TAutoObjectFactory.Create(ComServer, TCOMTester, Class_COMTester,
ciSingleInstance, tmApartment);
end. |
Für den Client habe ich dann ebenfalls ein neue VCL-Form Anwendung erstellt und über "Komponente/Komponente improtieren..." einen Wrapper für den Server erstellt:
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:
| {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TCOMTesterProperties= class;
{$ENDIF}
TCOMTester = class(TOleServer)
private
FIntf: ICOMTester;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TCOMTesterProperties;
function GetServerProperties: TCOMTesterProperties;
{$ENDIF}
function GetDefaultInterface: ICOMTester;
protected
procedure InitServerData; override;
function Get_Edit1Text: WideString;
procedure Set_Edit1Text(const Value: WideString);
function Get_Edit2Text: WideString;
procedure Set_Edit2Text(const Value: WideString);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: ICOMTester);
procedure Disconnect; override;
function ShowTestMessage(const Text: WideString): WideString;
property DefaultInterface: ICOMTester read GetDefaultInterface;
property Edit1Text: WideString read Get_Edit1Text write Set_Edit1Text;
property Edit2Text: WideString read Get_Edit2Text write Set_Edit2Text;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TCOMTesterProperties read GetServerProperties;
{$ENDIF}
end; |
Auf dem Form von dem Client habe ich dann ein Edit, zwei Radio-Buttons und einen Button platziert. Beim Klick auf den Button soll folgendes passieren:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
| procedure TForm1.Button1Click(Sender: TObject);
var
tester: TCOMTester;
str: string;
begin
tester := TCOMTester.Create(nil);
str := tester.ShowTestMessage('Hallo Welt!'); ShowMessage(str);
if Edit1RB.Checked then
tester.Edit1Text := Edit1.Text
else
tester.Edit2Text := Edit1.Text;
tester.Free;
end; |
Hierbei kommt es nun zu folgenden Problemen:
1. Wir "tester.ShowTestMessage(...)" kommt es zu einer Zugriffsverletzung in der rpcrt4.dll. Was hat es damit aufsicht?
2. Bei jedem Klick auf den Button öffnet sich ein Fenster des Servers bei dem dann der Edit Text gesetzt wird. Ich möchte aber erreichen, dass der Text immer im gleichen Server geändert wird. Hierfür habe ich ciSingleInstance verwendet aber das scheint ja nicht die Lösung zu sein. Was mache ich also falsch?
Besten Dank für eure Hilfe!
Ares
jaenicke
