Chip 1999 March/Chip_1999-03_cd.bin/zkuste/delphi/INFO/DI9807BL.ZIP/Intf/Server/ChatChannel.pas

Pascal/Delphi Source File | 1998-05-08 | 4.6 KB | 193 lines

{ *****************************************************************************
  Implementing COM Component Callbacks in Delphi
  Code written for Delphi Informant publication

  Comments, questions, suggestions?
  Binh Ly, Systems Analyst ([e-mail])
  Brickhouse Data Systems (http://www.brickhouse.com)
  *****************************************************************************
}
unit ChatChannel;

interface

uses
  ComObj, ActiveX, ChatServer_TLB, Classes;

type
  TChatUsers = class;

  TChatChannel = class (TAutoObject, IChatChannel)
  protected
    { IChatChannel }
    function ConnectUser(const Callback: IChatEvent; var UserId: Integer): WordBool; safecall;
    function DisconnectUser(UserId: Integer): WordBool; safecall;
    procedure BroadcastMessage (const UserName, Message: WideString); safecall;
  protected
    FUsers : TChatUsers;
    procedure Initialize; override;
  public
    destructor Destroy; override;
    property Users : TChatUsers read FUsers;
  end;

  TChatUser = class
  public
    UserId : integer;
    Callback : IChatEvent;
  end;

  TChatUsers = class
  protected
    FItems : TList;
    FLastUserId : integer;
    function GetItems (i : integer) : TChatUser;
  public
    constructor Create;
    destructor Destroy; override;
    function AddUser (const Callback: IChatEvent; var UserId : integer): boolean;
    function DeleteUser (UserId : integer) : boolean;
    function FindUser (UserId : integer) : integer;
    function Count : integer;
    property Items [i : integer] : TChatUser read GetItems; default;
  end;

const
  MainChatChannel : IChatChannel = NIL;

implementation

uses
  ComServ
  ;

{ TChatChannel }

function TChatChannel.ConnectUser(const Callback: IChatEvent; var UserId: Integer): WordBool;
begin
  { connect new client and return connection id (UserId) }
  Result := Users.AddUser (Callback, UserId);
end;

function TChatChannel.DisconnectUser(UserId: Integer): WordBool;
begin
  { disconnect client using specified connection id }
  Result := Users.DeleteUser (UserId);
end;

procedure TChatChannel.BroadcastMessage (const UserName, Message: WideString);
var
  i : integer;
begin
  { loops through all client connections and issues the callback message broadcast }
  for i := 0 to Users.Count - 1 do
  begin
    try
      Users [i].Callback.GotMessage (UserName, Message);
    except
      { if error happened, this callback client probably disconnected
        prematurely; therefore we just ignore the error and process all
        remaining clients.
      }
    end;  { except }
  end;  { for }
end;

procedure TChatChannel.Initialize;
begin
  inherited;

  { create TChatUsers list helper }
  FUsers := TChatUsers.Create;
end;

destructor TChatChannel.Destroy;
begin
  { destroy TChatUsers list helper }
  FUsers.Free;

  inherited;
end;


{ TChatUsers }

function TChatUsers.GetItems (i : integer) : TChatUser;
begin
  { returns a single TChatUser by index }
  Result := TChatUser (FItems.Items [i]);
end;

constructor TChatUsers.Create;
begin
  inherited;

  { create internal TChatUsers list }
  FItems := TList.Create;
end;

destructor TChatUsers.Destroy;
var
  i : integer;
begin
  { destroy internal TChatUsers list }
  for i := 0 to Count - 1 do
    Items [i].Free;
  FItems.Free;

  inherited;
end;

function TChatUsers.AddUser (const Callback: IChatEvent; var UserId : integer): boolean;
var
  User : TChatUser;
begin
  { add a new TChatUser to the internal list and returns a unique UserId to caller }
  inc (FLastUserId);
  UserId := FLastUserId;

  User := TChatUser.Create;
  User.UserId := FLastUserId;
  User.Callback := Callback;
  FItems.Add (User);

  Result := TRUE;
end;

function TChatUsers.DeleteUser (UserId : integer) : boolean;
var
  i : integer;
begin
  { remove a TChatUser item from the list by UserId }
  Result := FALSE;
  i := FindUser (UserId);
  if (i >= 0) then begin
    Items [i].Free;
    FItems.Delete (i);
    Result := TRUE;
  end;  { if }
end;

function TChatUsers.FindUser (UserId : integer) : integer;
var
  i : integer;
begin
  { locate a TChatUser item in the list by UserId }
  Result := -1;
  for i := 0 to Count - 1 do
    if (Items [i].UserId = UserId) then begin
      Result := i;
      Break;
    end;  { if }
end;

function TChatUsers.Count : integer;
begin
  { returns the number of TChatUser items in the list }
  Result := FItems.Count;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TChatChannel, Class_ChatChannel, ciInternal);
end.