servdata.pas

Delphi_7.0数据库开发源代码。有内容十一章节

unit servdata;



interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, DataBkr, serv_tlb, Db, DBTables,
  Provider, Variants;

type
  TAdHocQueryDemo = class(TRemoteDataModule, IAdHocQueryDemo)
    AdHocQuery: TQuery;
    AdHocProvider: TDataSetProvider;
    Database1: TDatabase;
    Session1: TSession;
    procedure AdHocQueryDemoCreate(Sender: TObject);
    procedure AdHocQueryDemoDestroy(Sender: TObject);
    procedure AdHocQueryAfterOpen(DataSet: TDataSet);
  protected
    function GetDatabaseNames: OleVariant; safecall;
    procedure SetDatabaseName(const DBName, Password: WideString); safecall;
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
  end;

var
  AdHocQueryDemo: TAdHocQueryDemo;

implementation

uses ServMain, BDE;

{$R *.dfm}

function TAdHocQueryDemo.GetDatabaseNames: OleVariant;
var
  I: Integer;
  DBNames: TStrings;
begin
  //返回客户端的数据库名称的所有列表
  DBNames := TStringList.Create;
  try
    Session1.GetDatabaseNames(DBNames); //得到可用数据库名
    Result := VarArrayCreate([0, DBNames.Count - 1], varOleStr);
    for I := 0 to DBNames.Count - 1 do
      Result[I] := DBNames[I];
  finally
    DBNames.Free;
  end;
end;

procedure TAdHocQueryDemo.SetDatabaseName(const DBName,
  Password: WideString);
begin
  //命名一个新的数据库名
  try
    Database1.Close;
    Database1.AliasName := DBName;
    if Password <> '' then
      Database1.Params.Values['PASSWORD'] := Password;
    Database1.Open;
  except
    //如果数据库打开失败的话，假设它需要的密码不对并且就此产生一个特殊的例外向客户端
    //索取密码

    on E: EDBEngineError do
      if (Password = '') then  //如果密码为空
        raise Exception.Create('Password Required') else
        raise;
  end;
end;

procedure TAdHocQueryDemo.AdHocQueryDemoCreate(Sender: TObject);
begin
  //更新客户端连接数
  MainForm.UpdateClientCount(1);
end;

procedure TAdHocQueryDemo.AdHocQueryDemoDestroy(Sender: TObject);
begin
  //更新客户端连接数
  MainForm.UpdateClientCount(-1);
end;

procedure TAdHocQueryDemo.AdHocQueryAfterOpen(DataSet: TDataSet);
begin
  //更新已经执行查询的总数
  MainForm.IncQueryCount;
end;

class procedure TAdHocQueryDemo.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

initialization
  TComponentFactory.Create(ComServer, TAdHocQueryDemo,
    Class_AdHocQueryDemo, ciMultiInstance);
end.