unit2.pas

ADO+DCOM例程 服务器与客户端 有源码 请大家指点

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, Project1_TLB, StdVcl, Provider, DBTables, Db;

type
  TMyDataServer = class(TRemoteDataModule, IMyDataServer)
    Query1: TQuery;
    Database1: TDatabase;
    Session1: TSession;
    DataSetProvider1: TDataSetProvider;
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure RemoteDataModuleDestroy(Sender: TObject);
    procedure Query1AfterOpen(DataSet: TDataSet);
    function DataSetProvider1DataRequest(Sender: TObject;
      Input: OleVariant): OleVariant;
  private
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function GetDB: OleVariant; safecall;
    procedure SetDB(const DBN, Pwd: WideString); safecall;
  public
    { Public declarations }
  end;

implementation
uses unit1;
{$R *.DFM}

class procedure TMyDataServer.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 TMyDataServer.GetDB: OleVariant;
var i:integer;
    DBN:Tstrings;
begin
  DBN := TstringList.Create;
  try
    Session1.GetDatabaseNames(DBN);
    Result := VarArrayCreate([0,DBN.count - 1],varOleStr);
    for i := 0 to DBN.Count - 1 do
      Result[i] := DBN[i];
  finally
    DBN.free;
  end;
end;

procedure TMyDataServer.SetDB(const DBN, Pwd: WideString);
begin
  try
    Database1.Close;
    Database1.AliasName := DBN;
    if Pwd <> '' then
      Database1.Params.Values['PASSWORD'] := Pwd;
      Database1.Open;
  except
    on E: EDBEngineError do
      if (Pwd = '') then
        raise Exception.Create('请输入密码')
      else
        raise;   
  end;
end;

procedure TMyDataServer.RemoteDataModuleCreate(Sender: TObject);
begin
  Form1.UpdateClientCount(1);
end;

procedure TMyDataServer.RemoteDataModuleDestroy(Sender: TObject);
begin
   Form1.UpdateClientCount(-1);
end;

procedure TMyDataServer.Query1AfterOpen(DataSet: TDataSet);
begin
  Form1.UpdateQueryCount; 
end;

function TMyDataServer.DataSetProvider1DataRequest(Sender: TObject;
  Input: OleVariant): OleVariant;
begin
  with (Sender as TDataSetProvider) do
    begin
      (DataSet as TQuery).SQL.Text := input;
       (DataSet as TQuery).ExecSQL;
       Result := Data;
    end;
end;

initialization
  TComponentFactory.Create(ComServer, TMyDataServer,
    Class_MyDataServer, ciMultiInstance, tmApartment);
end.