unit CBServerTest_Impl;
interface
type
TCBServerTest =
class(TAutoObject, ICBServerTest)
private
FSrvDaten :
String;
FBeobachterList : TInterfaceList;
FServerTestHandle : Integer;
procedure BeobachternBenachrichtigen;
protected
function Get_SrvDaten: WideString;
safecall;
procedure MeldeAn(
const Beob: IBeobachter);
safecall;
procedure MeldeAb(
const Beob: IBeobachter);
safecall;
procedure Set_SrvDaten(
const Value: WideString);
safecall;
public
procedure Initialize;
override;
end;
implementation
uses SysUtils, Dialogs, ComServ;
function TCBServerTest.Get_SrvDaten: WideString;
begin
Get_SrvDaten := FSrvDaten;
end;
procedure TCBServerTest.MeldeAn(
const Beob: IBeobachter);
var i:Integer;
FBeobachter: IBeobachter;
begin
if FBeobachterList =
nil then
FBeobachterList := TInterfaceList.Create;
i := FBeobachterList.Add(Beob);
FBeobachter := IBeobachter(FBeobachterList[i]);
FBeobachter.Aktualisiere('
TCBServer.MeldeAn');
end;
procedure TCBServerTest.MeldeAb(
const Beob: IBeobachter);
var i:Integer;
begin
if FBeobachterList <>
nil then
begin
i := FBeobachterList.IndexOf(Beob);
FBeobachterList.Delete(i);
end;
procedure TCBServerTest.Set_SrvDaten(
const Value: WideString);
begin
FSrvDaten := Value;
BeobachternBenachrichtigen;
end;
procedure TCBServerTest.BeobachternBenachrichtigen;
var i :integer;
begin
if FBeobachterList <>
nil then
begin
for i:=0
to FBeobachterList.Count-1
do
begin
IBeobachter(FBeobachterList[i]).Aktualisiere('
Aktuelle Serverdaten: '+FSrvDaten);
end;
end;
end;
procedure TCBServerTest.Initialize;
begin
inherited Initialize;
RegisterActiveObject(Self
as IUnknown, Class_CBServerTest01,
ACTIVEOBJECT_WEAK, FServerTestHandle);
FSrvDaten := '
server Initialize';
CoInitialize(
nil);
end;
Client Seite:
procedure FormCreate(Sender: TObject);
procedure DatentZuSrvClick(Sender: TObject);
procedure DatenVonSrvClick(Sender: TObject);
procedure AnmeldenClick(Sender: TObject);
procedure AbmeldenClick(Sender: TObject);
private
{ Private-Deklarationen }
FCBServerTest : ICBServerTest01;
FBeobachter : IBeobachter;
FAngemeldet : Boolean;
procedure BeobachterAbmelden;
procedure TClientDlg.FormCreate(Sender: TObject);
var aSrvObj : IUnknown;
begin
GetActiveObject(CLASS_CBServerTest01,
nil, aSrvObj);
if Assigned(aSrvObj)
then
begin
FCBServerTest := aSrvObj
as ICBServerTest01;
// MsgAnSrv := 'Connect mit ROT-Instanz';
end
else
begin
FCBServerTest := CoCBServerTest01.Create;
// MsgAnSrv := 'Connect mit neuer Instanz';
end;
FAngemeldet := False;
FBeobachter := CoClientTestObj.Create
as IBeobachter;
end;
procedure TClientDlg.DatentZuSrvClick(Sender: TObject);
begin
FCBServerTest.SrvDaten := Edit1.Text;
end;
procedure TClientDlg.DatenVonSrvClick(Sender: TObject);
begin
Edit2.Text := FCBServerTest.SrvDaten;
end;
procedure TClientDlg.AnmeldenClick(Sender: TObject);
begin
if(
not FAngemeldet)
then
begin
FCBServerTest.MeldeAn(FBeobachter);
FAngemeldet := True;
end;
end;
procedure TClientDlg.AbmeldenClick(Sender: TObject);
begin
BeobachterAbmelden;
end;
procedure TClientDlg.BeobachterAbmelden;
begin
if(FAngemeldet)
then
begin
FCBServerTest.MeldeAb(FBeobachter);
FAngemeldet := False;
end;
end;
end.