All pastes #807585 Raw Edit

Unbenannt

public text v1 · immutable
·published 2007-12-06 20:54 UTC
rendered paste body
unit uchat;

{$mode objfpc}{$H+}

interface

uses Classes, lNet;

type TChatSystem=class;
     TChatConnection=class;
     TChatConnectionClass=class of TChatConnection;

type TChatChannel=class
      constructor Create(AName:String;ASystem:TChatSystem;AConnection:TChatConnection);virtual;
      destructor Destroy;override;
      private
      FSystem     : TChatSystem;
      FConnection : TChatConnection;
      FName       : String;
      public
      property ChatSystem:TChatSystem read FSystem;
      property ChatConnection:TChatConnection read FConnection;
      property Name:String read FName;
     end;

type TChatConnection=class
      constructor Create(AName:String;ASystem:TChatSystem;ANick,AParam:String);
      destructor Destroy;override;
      procedure CloseAll;
      private
      FSystem   : TChatSystem;
      FName     : String;
      FChannels : TList;
      function GetChannel(i:Integer):TChatChannel;
      procedure InternChannelDestroy(Channel:TChatChannel);
      public
      property Name:String read FName;
      property ChatSystem:TChatSystem read FSystem;
      function ChannelCount:Integer;
      property Channels[i:Integer]:TChatChannel read GetChannel;
     end;
  
type TChatSystem=class
      constructor Create;
      destructor Destroy;override;
      procedure NewConnection(AName,ATyp,ANick,AParam:String);
      procedure CloseAll;
      private
      FConnections : TList;
      function GetConnection(i:Integer):TChatConnection;
      function GetChannel(i:Integer):TChatChannel;
      procedure InternConnectionDestroy(Connection:TChatConnection);
      public
      function ConnectionCount:Integer;
      property Connections[i:Integer]:TChatConnection read GetConnection;
      function ChannelCount:Integer;
      property Channels[i:Integer]:TChatChannel read GetChannel;
     end;
     
type TIRCChatConnection=Class
      constructor Create(AName:String;ASystem:TChatSystem;ANick,AParam:String);
     end;
     
procedure RegisterChatConnectionType(ID:String;ACT:TChatConnectionClass);

implementation

var ChatConnectionTypes:TStringList;

constructor TIRCChatConnection.Create(AName:String;ASystem:TChatSystem;ANick,AParam:String);
begin
end;

constructor TChatChannel.Create(AName:String;ASystem:TChatSystem;AConnection:TChatConnection);
begin
 inherited Create;
 FName       := AName;
 FSystem     := ASystem;
 FConnection := AConnection;
end;

destructor TChatChannel.Destroy;
begin
 FConnection.InternChannelDestroy(Self);
 inherited Destroy;
end;

function TChatConnection.GetChannel(i:Integer):TChatChannel;
begin
 if i<FChannels.Count then Result:=TChatChannel(FChannels[i]) else Result:=Nil;
end;

procedure TChatConnection.InternChannelDestroy(Channel:TChatChannel);
var i:Integer;
begin
 i:=FChannels.IndexOf(Channel);
 if i>=0 then FChannels.Delete(i);
end;

function TChatConnection.ChannelCount:Integer;
begin
 Result:=FChannels.Count;
end;

procedure TChatConnection.CloseAll;
begin
 while FChannels.Count<>0 do TChatChannel(FChannels[0]).Free;
end;

constructor TChatConnection.Create(AName:String;ASystem:TChatSystem;ANick,AParam:String);
begin
 inherited Create;
 FName   := AName;
 FSystem := ASystem;
 FChannels := TList.Create;
end;

destructor TChatConnection.Destroy;
begin
 CloseAll;
 FChannels.Free;
 FSystem.InternConnectionDestroy(Self);
 inherited Destroy;
end;

procedure TChatSystem.InternConnectionDestroy(Connection:TChatConnection);
var i:Integer;
begin
 i:=FConnections.IndexOf(Connection);
 if i>=0 then FConnections.Delete(i);
end;

procedure TChatSystem.NewConnection(AName,ATyp,ANick,AParam:String);
var Connection:TChatConnection;
begin
 Connection:=TChatConnection.Create(Aname,Self,ANick,AParam);
 if Connection<>nil then FConnections.Add(Connection);
end;

procedure TChatSystem.CloseAll;
begin
 while FConnections.Count<>0 do TChatConnection(FConnections[0]).Free;
end;

function TChatSystem.ChannelCount:Integer;
var i:Integer;
begin
 Result:=0;
 for i:=0 to FConnections.Count-1 do
 begin
  Inc(Result,TChatConnection(FConnections[i]).ChannelCount);
 end;
end;

function TChatSystem.GetChannel(i:Integer):TChatChannel;
var n:Integer;
begin
 n:=0;
 while (n<FConnections.Count) and (i<TChatConnection(FConnections[n]).ChannelCount) do Inc(n);
 if n<FConnections.Count then Result:=TChatConnection(FConnections[n]).Channels[i] else Result:=Nil;
end;

function TChatSystem.ConnectionCount:Integer;
begin
 Result:=FConnections.Count;
end;

function TChatSystem.GetConnection(i:Integer):TChatConnection;
begin
 if i<FConnections.Count then Result:=TChatConnection(FConnections[i]);
end;

constructor TChatSystem.Create;
begin
 inherited Create;
 FConnections:=TList.Create;
end;

destructor TChatSystem.Destroy;
begin
 CloseAll;
 FConnections.Free;
 inherited Destroy;
end;

procedure RegisterChatConnectionType(ID:String;ACT:TChatConnectionClass);
begin
 ChatConnectionTypes.AddObject(ID,TObject(ACT));
end;

initialization
 ChatConnectionTypes:=TStringList.Create;
finalization
 ChatConnectionTypes.Free;
end.