pmultithreaddemoserver_tlb.pas

就是这本书的随书代码。包括《实战Delphi 5.x-分布式多层应用系统篇》

procedure TFreezeServerStub.FreezeMeFor(const vID: WideString; iSeconds: Integer);
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('FreezeMeFor', True, OutBuf);
  OutBuf.PutWideText(PWideChar(Pointer(vID)));
  OutBuf.PutLong(iSeconds);
  FStub.Invoke(OutBuf, InBuf);
end;

{ TFreezeServerSkeleton }

constructor TFreezeServerSkeleton.Create(const InstanceName: string; const Impl: IUnknown);
begin
  inherited;
  inherited InitSkeleton('FreezeServer', InstanceName, 'IDL:PMultiThreadDemoServer/IFreezeServer:1.0', tmMultiThreaded, True);
  FIntf := Impl as IFreezeServer;
end;

procedure TFreezeServerSkeleton.GetImplementation(out Impl: IUnknown);
begin
  Impl := FIntf;
end;

procedure TFreezeServerSkeleton.FreezeMeFor(const InBuf: IMarshalInBuffer; Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  vID: WideString;
  iSeconds: Integer;
begin
  vID := UnmarshalWideText(InBuf);
  iSeconds := InBuf.GetLong;
  FIntf.FreezeMeFor(vID, iSeconds);
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
end;

{ THoldServerStub }

procedure THoldServerStub.HoldMeFor(const vID: WideString; iSeconds: Integer);
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('HoldMeFor', True, OutBuf);
  OutBuf.PutWideText(PWideChar(Pointer(vID)));
  OutBuf.PutLong(iSeconds);
  FStub.Invoke(OutBuf, InBuf);
end;

{ THoldServerSkeleton }

constructor THoldServerSkeleton.Create(const InstanceName: string; const Impl: IUnknown);
begin
  inherited;
  inherited InitSkeleton('HoldServer', InstanceName, 'IDL:PMultiThreadDemoServer/IHoldServer:1.0', tmMultiThreaded, True);
  FIntf := Impl as IHoldServer;
end;

procedure THoldServerSkeleton.GetImplementation(out Impl: IUnknown);
begin
  Impl := FIntf;
end;

procedure THoldServerSkeleton.HoldMeFor(const InBuf: IMarshalInBuffer; Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  vID: WideString;
  iSeconds: Integer;
begin
  vID := UnmarshalWideText(InBuf);
  iSeconds := InBuf.GetLong;
  FIntf.HoldMeFor(vID, iSeconds);
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
end;

class function CoFreezeServer.Create: IFreezeServer;
begin
  Result := CreateComObject(CLASS_FreezeServer) as IFreezeServer;
end;

class function CoFreezeServer.CreateRemote(const MachineName: string): IFreezeServer;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_FreezeServer) as IFreezeServer;
end;

procedure TFreezeServer.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{3CA3C3A3-89F3-11D3-8DB9-0080C8518D0A}';
    IntfIID:   '{3CA3C3A1-89F3-11D3-8DB9-0080C8518D0A}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TFreezeServer.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as IFreezeServer;
  end;
end;

procedure TFreezeServer.ConnectTo(svrIntf: IFreezeServer);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TFreezeServer.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TFreezeServer.GetDefaultInterface: IFreezeServer;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TFreezeServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TFreezeServerProperties.Create(Self);
{$ENDIF}
end;

destructor TFreezeServer.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TFreezeServer.GetServerProperties: TFreezeServerProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure TFreezeServer.FreezeMeFor(const vID: WideString; iSeconds: Integer);
begin
  DefaultInterface.FreezeMeFor(vID, iSeconds);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TFreezeServerProperties.Create(AServer: TFreezeServer);
begin
  inherited Create;
  FServer := AServer;
end;

function TFreezeServerProperties.GetDefaultInterface: IFreezeServer;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

class function TFreezeServerCorbaFactory.CreateInstance(const InstanceName: string): IFreezeServer;
begin
  Result := CorbaFactoryCreateStub('IDL:PMultiThreadDemoServer/FreezeServerFactory:1.0', 'FreezeServer',
    InstanceName, '', IFreezeServer) as IFreezeServer;
end;

class function CoHoldServer.Create: IHoldServer;
begin
  Result := CreateComObject(CLASS_HoldServer) as IHoldServer;
end;

class function CoHoldServer.CreateRemote(const MachineName: string): IHoldServer;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_HoldServer) as IHoldServer;
end;

procedure THoldServer.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{3CA3C3A7-89F3-11D3-8DB9-0080C8518D0A}';
    IntfIID:   '{3CA3C3A5-89F3-11D3-8DB9-0080C8518D0A}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure THoldServer.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as IHoldServer;
  end;
end;

procedure THoldServer.ConnectTo(svrIntf: IHoldServer);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure THoldServer.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function THoldServer.GetDefaultInterface: IHoldServer;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor THoldServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := THoldServerProperties.Create(Self);
{$ENDIF}
end;

destructor THoldServer.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function THoldServer.GetServerProperties: THoldServerProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure THoldServer.HoldMeFor(const vID: WideString; iSeconds: Integer);
begin
  DefaultInterface.HoldMeFor(vID, iSeconds);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor THoldServerProperties.Create(AServer: THoldServer);
begin
  inherited Create;
  FServer := AServer;
end;

function THoldServerProperties.GetDefaultInterface: IHoldServer;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

class function THoldServerCorbaFactory.CreateInstance(const InstanceName: string): IHoldServer;
begin
  Result := CorbaFactoryCreateStub('IDL:PMultiThreadDemoServer/HoldServerFactory:1.0', 'HoldServer',
    InstanceName, '', IHoldServer) as IHoldServer;
end;

procedure Register;
begin
  RegisterComponents('Servers',[TFreezeServer, THoldServer]);
end;

initialization
  CorbaStubManager.RegisterStub(IFreezeServer, TFreezeServerStub);
  CorbaInterfaceIDManager.RegisterInterface(IFreezeServer, 'IDL:PMultiThreadDemoServer/IFreezeServer:1.0');
  CorbaSkeletonManager.RegisterSkeleton(IFreezeServer, TFreezeServerSkeleton);
  CorbaStubManager.RegisterStub(IHoldServer, THoldServerStub);
  CorbaInterfaceIDManager.RegisterInterface(IHoldServer, 'IDL:PMultiThreadDemoServer/IHoldServer:1.0');
  CorbaSkeletonManager.RegisterSkeleton(IHoldServer, THoldServerSkeleton);

end.