calldm.pas

来自「这是一个网络数据库回调例程,基于SocketConnection的」· PAS 代码 · 共 77 行

{Program to demonstrate callbacks between server and client over SocketServer.
This uses the new capabilities in D4.

Written by Dan Miser
Copyright 1998}
unit CallDM;

interface

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

type
  TServer = class(TRemoteDataModule, IServer)
    Table1: TTable;
  private
    { Private declarations }
//    FCallback: IClient; {Cannot use early binding callback in socket mode}
    FCallback: OleVariant;
  public
    { Public declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure SetCallback(aCallback: OleVariant); safecall;
    procedure TraverseTable; safecall;
  end;

var
  Server: TServer;

implementation

{$R *.DFM}

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

procedure TServer.SetCallback(aCallback: OleVariant);
begin
  FCallback:=aCallback;
end;

procedure TServer.TraverseTable;
var
  bContinue: WordBool;
  iRecordCount: integer;
begin
  Table1.Open;
  Table1.First;
  iRecordCount:=Table1.RecordCount;
  bContinue:=true;
  while (not Table1.eof) and bContinue do
  begin
    Table1.Next;
    FCallback.Progress(Table1.RecNo ,iRecordCount, bContinue);
  end;
  Table1.Close;
  FCallback.Done;
end;

initialization
  TComponentFactory.Create(ComServer, TServer,
    Class_Server, ciMultiInstance, tmApartment);
end.