Neustart meines Automationserver Programms unterbinden?

[Karsten Strobel]

Ich habe folgendes Problem: Mein Automationsserver Programm darf nur manuell gestartet werden.

Der Server unterstützt mehrere Instanzen eines Automationsobjektes (TClassInstancing=ciMultiInstance) und es soll jedem Client möglich sein, eine solche Instanz anzufordern (per COM und DCOM).

Aber: Der Automationsserver (also das Programm, das das Automationsobjekt implementiert) darf nicht durch die Anforderung eines Clients gestartet werden. Das muss immer manuell passieren. Dabei kann ich keine spezielle Prüfung im Client unterbringen, weil dieser evtl. von anderen Entwicklern programmiert wird. Es muss also serverseitig verhindert werden. Wie kann ich das realisieren?

Danke und Gruss
Karsten Strobel

[Andreas Kosch]

Hallo Karsten,

für diese Aufgabe muss der COM Server eine eigene Class Factory implementieren. Das folgende Beispiel mit <i>TManuellStartAutoObjectFactory</i> demonstriert dies:

Automation-Server:
<pre>
<b>unit</b> COMmanuellerStart_Impl;

<font color="#003399"><i>{$WARN SYMBOL_PLATFORM OFF}</i></font>

<b>interface</b>

<b>uses</b>
ComObj, ActiveX, COMmanuellerStart_TLB, StdVcl;

<b>type</b>
TCOMmanuellStartObj = <b>class</b>(TAutoObject, ICOMmanuellStartObj)
<b>protected</b>
<b>procedure</b> DoWork(<b>const</b> Param1: WideString; out Param2: WideString);
<b>safecall</b>;
<b>end</b>;

TManuellStartAutoObjectFactory = <b>class</b>(TAutoObjectFactory)
<b>private</b>
<b>public</b>
<b>function</b> CreateComObject(<b>const</b> Controller: IUnknown): TComObject; <b>override</b>;
<b>end</b>;

<b>var</b>
bOK : Boolean = False;

<b>implementation</b>

<b>uses</b> ComServ;

<font color="#003399"><i>{ TManuellStartAutoObjectFactory }</i></font>

<b>function</b> TManuellStartAutoObjectFactory.CreateComObject(
<b>const</b> Controller: IInterface): TComObject;
<b>begin</b>
<b>if</b> bOK <b>then</b>
Result := <b>inherited</b> CreateComObject(Controller)
<b>else</b>
Result := <b>nil</b>;
<b>end</b>;

<font color="#003399"><i>{ TCOMmanuellStartObj }</i></font>

<b>procedure</b> TCOMmanuellStartObj.DoWork(<b>const</b> Param1: WideString;
out Param2: WideString);
<b>begin</b>
Param2 := Param1 + <font color="#9933CC">' OK'</font>;
<b>end</b>;

<b>initialization</b>
TManuellStartAutoObjectFactory.Create(ComServer, TCOMmanuellStartObj,
Class_COMmanuellStartObj, ciMultiInstance, tmApartment);

<b>end</b>.
</pre>

Formular des Automation-Server: Nur dann, wenn die Checkbox angekreuzt ist, können sich Clients über COM/DCOM mit einer Instanz des Automation-Objekts verbinden:
<pre>
<b>unit</b> COMmanuellerStartFrm;

<b>interface</b>

<b>uses</b>
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

<b>type</b>
TForm1 = <b>class</b>(TForm)
CheckBox1: TCheckBox;
<b>procedure</b> CheckBox1Click(Sender: TObject);
<b>private</b>
<font color="#003399"><i>{ Private-Deklarationen }</i></font>
<b>public</b>
<font color="#003399"><i>{ Public-Deklarationen }</i></font>
<b>end</b>;

<b>var</b>
Form1: TForm1;

<b>implementation</b>

<font color="#003399"><i>{$R *.dfm}</i></font>

<b>uses</b> COMmanuellerStart_Impl;

<b>procedure</b> TForm1.CheckBox1Click(Sender: TObject);
<b>begin</b>
<b>if</b> Checkbox1.Checked <b>then</b>
bOK := True
<b>else</b>
bOK := False;
<b>end</b>;

<b>end</b>.

</pre&gt