uqueryserver.pas

《Delphi开发人员指南》配书原码

unit uQueryServer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ComObj, StdVcl,
  CorbaObj, db, dbtables, orbpas, SimpleCorbaServer_TLB, frmqueryserver;

type

  TQueryServer = class(TCorbaImplementation, IQueryServer)
  private
    { Private declarations }
    FDatabase: TDatabase;
    FQuery: TQuery;
  public
    { Public declarations }
    constructor Create(Controller: IObject; AFactory: TCorbaFactory); override;
    destructor Destroy; override;
  protected
    function Data: OleVariant; safecall;
    function Get_BOF: WordBool; safecall;
    function Get_EOF: WordBool; safecall;
    function Get_FieldCount: Integer; safecall;
    function Get_SQL: WideString; safecall;
    function Login(const Db, User, Password: WideString): WordBool; safecall;
    procedure First; safecall;
    procedure Last; safecall;
    procedure Next; safecall;
    procedure Prev; safecall;
    procedure Set_SQL(const Value: WideString); safecall;
    function Execute: WordBool; safecall;
  end;

implementation

uses CorbInit;

function TQueryServer.Data: OleVariant;
var
  i : integer;
begin
  //Pack and send data.
  Result := VarArrayCreate([0,FQuery.FieldCount-1],varOLEStr);
  for i := 0 to FQuery.FieldCount - 1 do
  begin
    Result[i] := FQuery.Fields[i].AsString;
  end;
end;

function TQueryServer.Get_BOF: WordBool;
begin
  Result := FQuery.BOF;
end;

function TQueryServer.Get_EOF: WordBool;
begin
  Result := FQuery.EOF;
end;

function TQueryServer.Get_FieldCount: Integer;
begin
  Result := FQuery.FieldCount;
end;

function TQueryServer.Get_SQL: WideString;
begin
  Result := FQuery.SQL.Text;
end;

function TQueryServer.Login(const Db, User,
  Password: WideString): WordBool;
begin
  if FDatabase.Connected then FDatabase.Close;
  FDatabase.AliasName := Db;
  FDatabase.Params.Clear;
  FDatabase.Params.Add('USER NAME=' + User);
  FDatabase.Params.Add('PASSWORD=' + Password);
  FDatabase.Open;
end;

procedure TQueryServer.First;
begin
  FQuery.First;
end;

procedure TQueryServer.Last;
begin
  FQuery.Last;
end;

procedure TQueryServer.Next;
begin
  FQuery.Next;
end;

procedure TQueryServer.Prev;
begin
  FQuery.Prior;
end;

procedure TQueryServer.Set_SQL(const Value: WideString);
begin
  FQuery.SQL.Clear;
  FQuery.SQL.Add(Value);
end;

constructor TQueryServer.Create(Controller: IObject;
  AFactory: TCorbaFactory);
begin
  inherited Create(Controller,AFactory);
  form1.caption := 'Instance Available';
  FDatabase := TDatabase.Create(nil);
  FDatabase.LoginPrompt := false;
  FDatabase.DatabaseName := 'CorbaDb';
  FDatabase.HandleShared := true;
  FQuery := TQuery.Create(nil);
  FQuery.DatabaseName := 'CorbaDb';
end;

destructor TQueryServer.Destroy;
begin
  form1.caption := 'Instance Gone.';
  FQuery.Free;
  FDatabase.Free;
  inherited Destroy;
end;

function TQueryServer.Execute: WordBool;
begin
  FQuery.Close;
  FQuery.Open;
end;

initialization
  TCorbaObjectFactory.Create('QueryServerFactory', 'QueryServer', 'IDL:SimpleCorbaServer/QueryServerFactory:1.0', IQueryServer,
    TQueryServer, iMultiInstance, tmSingleThread);
end.