main.~pas

Delphi7数据库开发教程,包含该书21套实例

unit main;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, ServerDemoApp_TLB, StdVcl, Provider, DBTables, DB, Variants;

type
  TMIDASDemo = class(TRemoteDataModule, IMIDASDemo)
    Query1: TQuery;
    Database1: TDatabase;
    Session1: TSession;
    DataSetProvider1: TDataSetProvider;
    procedure Query1AfterOpen(DataSet: TDataSet);
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure RemoteDataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function GetServerDBNames: OleVariant; safecall;
    procedure SetServerDBName(const DBName, User, Password: WideString);
      safecall;
  public
    { Public declarations }
  end;

implementation

uses ServerDemo;

{$R *.DFM}

class procedure TMIDASDemo.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;

//从服务器中获得数据库名列表
function TMIDASDemo.GetServerDBNames: OleVariant;
var i:integer;
    DBNames:TStringList;
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 TMIDASDemo.SetServerDBName(const DBName, User,
  Password: WideString);
begin
  try
    with Database1 do
    begin
      Close;
      AliasName := DBName;
      if User <> '' then
         Params.Values['UserName'] := User;
      if Password <> '' then
         Params.Values['Password'] := Password;
      Open;
    end;
  except
    on E: EDBEngineError do
    begin
      if User <> '' then
         raise Exception.Create('无效的用户名')
      else if Password <> '' then
         raise Exception.Create('无效的密码')
      else
         raise;
    end;
  end;
end;

//当打开查询时更新显示
procedure TMIDASDemo.Query1AfterOpen(DataSet: TDataSet);
begin
  with Form1.lblQueryNum do
    Caption := IntToStr(StrToInt(Caption) + 1);
end;


//当建立一个客户端连接时更新显示
procedure TMIDASDemo.RemoteDataModuleCreate(Sender: TObject);
begin
  with Form1.lblClientNum do
    Caption := IntToStr(StrToInt(Caption) + 1);
end;

//当断开与客户端连接时更新显示
procedure TMIDASDemo.RemoteDataModuleDestroy(Sender: TObject);
begin
   with Form1.lblClientNum do
    Caption := IntToStr(StrToInt(Caption) - 1);
end;

initialization
  TComponentFactory.Create(ComServer, TMIDASDemo,
    Class_MIDASDemo, ciMultiInstance, tmApartment);
end.