For at kunne lave en IRC-client, skal du have et komponenent ved navn WSocket, jeg ved ikke helt hvor den downloades, men jeg har lige bixet lidt sammen til dig:
unit TestMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, SlyIrc, ComCtrls;
type
TfrmMain = class(TForm)
pnlButtons: TPanel;
edtHost: TEdit;
edtPort: TEdit;
edtNick: TEdit;
edtAltNick: TEdit;
lblHost: TLabel;
lblPort: TLabel;
lblNicks: TLabel;
btnConnect: TButton;
btnQuit: TButton;
sbrMain: TStatusBar;
pnlStatus: TPanel;
memStatus: TMemo;
edtUsername: TEdit;
lblUsername: TLabel;
chkShowTokens: TCheckBox;
pnlCommand: TPanel;
edtCommand: TEdit;
chkInvisible: TCheckBox;
chkServerNotices: TCheckBox;
chkWallops: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure btnQuitClick(Sender: TObject);
procedure edtCommandKeyPress(Sender: TObject; var Key: Char);
procedure chkInvisibleClick(Sender: TObject);
procedure chkServerNoticesClick(Sender: TObject);
procedure chkWallopsClick(Sender: TObject);
private
FSlyIrc: TSlyIrc;
procedure SlyIrcReceive(Sender: TObject; AResponse: String);
procedure SlyIrcSend(Sender: TObject; AResponse: String);
procedure SlyIrcAfterStateChange(Sender: TObject);
procedure SlyIrcResponse(Sender: TObject; ATokens: TIrcToken;
var Suppress: Boolean);
procedure SlyIrcUserModeChanged(Sender: TObject);
public
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
const
StateDesc: array [TSlyIrcState] of String = ('Not connected', 'Resolving host', 'Connecting', 'Connected',
'Registering', 'Ready', 'Aborting', 'Disconnecting');
procedure TfrmMain.FormCreate(Sender: TObject);
begin
FSlyIrc := TSlyIrc.Create(nil);
FSlyIrc.OnReceive := SlyIrcReceive;
FSlyIrc.OnSend := SlyIrcSend;
FSlyIrc.OnAfterStateChange := SlyIrcAfterStateChange;
FSlyIrc.OnResponse := SlyIrcResponse;
FSlyIrc.OnUserModeChanged := SlyIrcUserModeChanged;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
FSlyIrc.Free;
end;
procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
FSlyIrc.Host := edtHost.Text;
FSlyIrc.Port := edtPort.Text;
FSlyIrc.Nick := edtNick.Text;
FSlyIrc.AltNick := edtAltNick.Text;
FSlyIrc.Username := edtUsername.Text;
FSlyIrc.Connect;
end;
procedure TfrmMain.btnQuitClick(Sender: TObject);
begin
FSlyIrc.Quit('Bye bye');
end;
procedure TfrmMain.SlyIrcReceive(Sender: TObject; AResponse: String);
begin
memStatus.Lines.Add('>> ' + AResponse);
end;
procedure TfrmMain.SlyIrcAfterStateChange(Sender: TObject);
begin
sbrMain.SimpleText := StateDesc[FSlyIrc.State];
case FSlyIrc.State of
isNotConnected:
begin
memStatus.Lines.Add('Disconnected');
Caption := 'TestIRC';
end;
isResolvingHost:
memStatus.Lines.Add('Resolving host');
isConnecting:
memStatus.Lines.Add('Connecting to host');
isConnected:
memStatus.Lines.Add('Connected to host');
isRegistering:
memStatus.Lines.Add('Registering');
isReady:
Caption := Format('%s on %s - TestIRC', [FSlyIrc.Nick, FSlyIrc.Host]);
isAborting:
memStatus.Lines.Add('Aborting connection');
isDisconnecting:
memStatus.Lines.Add('Disconnecting');
end;
end;
procedure TfrmMain.SlyIrcSend(Sender: TObject; AResponse: String);
begin
memStatus.Lines.Add('<< ' + AResponse);
end;
procedure TfrmMain.SlyIrcResponse(Sender: TObject; ATokens: TIrcToken;
var Suppress: Boolean);
var
Line: String;
Index: Integer;
begin
if chkShowTokens.Checked then
begin
Line := '"' + ATokens[0] + '"';
for Index := 1 to ATokens.Count - 1 do
Line := Line + ', "' + ATokens[Index] + '"';
memStatus.Lines.Add(Line);
end;
end;
procedure TfrmMain.edtCommandKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
{ Suppress beep. }
Key := #0;
FSlyIrc.Send(edtCommand.Text);
edtCommand.Text := '';
end;
end;
procedure TfrmMain.SlyIrcUserModeChanged(Sender: TObject);
begin
memStatus.Lines.Add('User mode changed');
end;
procedure TfrmMain.chkInvisibleClick(Sender: TObject);
begin
if chkInvisible.Checked then
FSlyIrc.UserModes := FSlyIrc.UserModes + [umInvisible]
else
FSlyIrc.UserModes := FSlyIrc.UserModes - [umInvisible];
end;
procedure TfrmMain.chkServerNoticesClick(Sender: TObject);
begin
if chkServerNotices.Checked then
FSlyIrc.UserModes := FSlyIrc.UserModes + [umServerNotices]
else
FSlyIrc.UserModes := FSlyIrc.UserModes - [umServerNotices];
end;
procedure TfrmMain.chkWallopsClick(Sender: TObject);
begin
if chkWallops.Checked then
FSlyIrc.UserModes := FSlyIrc.UserModes + [umWallops]
else
FSlyIrc.UserModes := FSlyIrc.UserModes - [umWallops];
end;
end.
Og SlyIRC-komponenten skal se sådan ud:
unit SlyIrc;
interface
uses
Classes, WSocket;
const
DEFAULT_HOST = '';
DEFAULT_PORT = '6667';
DEFAULT_NICK = 'MyNick';
DEFAULT_ALTNICK = 'OtherNick';
DEFAULT_REALNAME = 'My real name';
DEFAULT_USERNAME = 'username';
DEFAULT_PASSWORD = '';
MAX_TOKEN_LENGTH = 512;
TOKEN_SEPARATOR = ' ';
TOKEN_ENDOFTOKENS = ':';
type
TSlyIrc = class;
TIrcObject = class(TObject)
private
FTag: Integer;
FData: TObject;
FSlyIrc: TSlyIrc;
FOwner: TIrcObject;
procedure SetData(const Value: TObject);
procedure SetSlyIrc(const Value: TSlyIrc);
procedure SetTag(const Value: Integer);
procedure SetOwner(const Value: TIrcObject);
public
constructor Create(AOwner: TIrcObject);
destructor Destroy; override;
procedure Notification(AIrcObject: TIrcObject; Operation: TOperation); virtual;
procedure PrivMsg(Text: String); virtual;
procedure Notice(Text: String); virtual;
property SlyIrc: TSlyIrc read FSlyIrc write SetSlyIrc;
property Owner: TIrcObject read FOwner write SetOwner;
property Data: TObject read FData write SetData;
property Tag: Integer read FTag write SetTag;
end;
TTokenSyntax = (tsResponse, tsMessage, tsCTCP);
TIrcToken = class(TObject)
private
FTokenString: String;
FCount: Integer;
FTokens: TList;
FSyntax: TTokenSyntax;
FBuffer: array [0..MAX_TOKEN_LENGTH] of Char;
procedure SetTokenString(const Value: String);
function GetTokens(Index: Integer): String;
function GetTokensFrom(Index: Integer): String;
procedure SetSyntax(const Value: TTokenSyntax);
protected
procedure Tokenize; virtual;
public
constructor Create;
destructor Destroy; override;
property TokenString: String read FTokenString write SetTokenString;
property Tokens[Index: Integer]: String read GetTokens; default;
property TokensFrom[Index: Integer]: String read GetTokensFrom;
property Count: Integer read FCount;
property Syntax: TTokenSyntax read FSyntax write SetSyntax;
end;
THandlerFunc = procedure (SlyIrc: TSlyIrc; AResponse: String; ATokens: TIrcToken;
var BreakChain: Boolean) of object;
PResponseHandler = ^TResponseHandler;
TResponseHandler = record
Response: String;
HandlerFunc: THandlerFunc;
PrevHandler: PResponseHandler;
end;
TIrcResponseHandlers = class(TObject)
private
FHandlers: TStringList;
FSlyIrc: TSlyIrc;
public
constructor Create(ASlyIrc: TSlyIrc);
destructor Destroy; override;
function AddHandler(Response: String; HandlerFunc: THandlerFunc): Integer;
procedure DeleteHandler(Index: Integer);
procedure RemoveHandler(Response: String);
function IndexOfHandler(Response: String): Integer;
procedure Handle(Tokens: TIrcToken);
end;
TSlyIrcState = (isNotConnected, isResolvingHost, isConnecting, isConnected,
isRegistering, isReady, isAborting, isDisconnecting);
TUserMode = (umInvisible, umOperator, umServerNotices, umWallops);
TUserModes = set of TUserMode;
TOnResponse = procedure (Sender: TObject; ATokens: TIrcToken; var Suppress: Boolean) of object;
TOnReceive = procedure (Sender: TObject; AResponse: String) of object;
TOnSend = procedure (Sender: TObject; AResponse: String) of object;
TSlyIrc = class(TComponent)
private
FRealName: String;
FPort: String;
FPassword: String;
FAltNick: String;
FHost: String;
FNick: String;
FChangeNickTo: String;
FWSocket: TWSocket;
FState: TSlyIrcState;
FTokens: TIrcToken;
FOnBeforeStateChange: TNotifyEvent;
FOnAfterStateChange: TNotifyEvent;
FOnResponse: TOnResponse;
FOnReceive: TOnReceive;
FOnSend: TOnSend;
FHandlers: TIrcResponseHandlers;
FUsername: String;
FActualNick: String;
FActualHost: String;
FUserModes: TUserModes;
FActualUserModes: TUserModes;
FOnUserModeChanged: TNotifyEvent;
procedure SetAltNick(const Value: String);
procedure SetNick(const Value: String);
function GetNick: String;
procedure SetPassword(const Value: String);
procedure SetPort(const Value: String);
procedure SetRealName(const Value: String);
procedure SetHost(const Value: String);
function GetHost: String;
procedure SessionConnected(Sender: TObject; Error: Word);
procedure SessionClosed(Sender: TObject; Error: Word);
procedure DnsLookupDone(Sender: TObject; Error: Word);
procedure DataAvailable(Sender: TObject; Error: Word);
procedure SetState(const Value: TSlyIrcState);
procedure Reset;
procedure SetUsername(const Value: String);
function GetUserModes: TUserModes;
procedure SetUserModes(const Value: TUserModes);
function CreateUserModeCommand(NewModes: TUserModes): String;
protected
procedure ProcessResponse(AResponse: String; var Suppress: Boolean); virtual;
procedure Receive(AResponse: String); virtual;
procedure Response(ATokens: TIrcToken; var Suppress: Boolean); virtual;
procedure UserModeChanged;
procedure AddHandlers;
procedure RplPing(SlyIrc: TSlyIrc; AResponse: String; ATokens: TIrcToken;
var BreakChain: Boolean);
procedure RplNick(SlyIrc: TSlyIrc; AResponse: String; ATokens: TIrcToken;
var BreakChain: Boolean);
procedure RplWelcome1(SlyIrc: TSlyIrc; AResponse: String; ATokens: TIrcToken;
var BreakChain: Boolean);
procedure ErrNicknameInUse(SlyIrc: TSlyIrc; AResponse: String; ATokens: TIrcToken;
var BreakChain: Boolean);
procedure RplMode(SlyIrc: TSlyIrc; AResponse: String; ATokens: TIrcToken;
var BreakChain: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Connect;
procedure Close;
procedure Send(Command: String);
procedure PrivMsg(Destination, Text: String);
procedure Notice(Destination, Text: String);
procedure Quit(Reason: String);
function ExtractNickFromAddress(Address: String): String;
property State: TSlyIrcState read FState;
property Socket: TWSocket read FWSocket;
property Handlers: TIrcResponseHandlers read FHandlers;
published
property Host: String read GetHost write SetHost;
property Port: String read FPort write SetPort;
property Nick: String read GetNick write SetNick;
property AltNick: String read FAltNick write SetAltNick;
property RealName: String read FRealName write SetRealName;
property Password: String read FPassword write SetPassword;
property Username: String read FUsername write SetUsername;
property UserModes: TUserModes read GetUserModes write SetUserModes;
{ Event properties. }
property OnBeforeStateChange: TNotifyEvent read FOnBeforeStateChange write FOnBeforeStateChange;
property OnAfterStateChange: TNotifyEvent read FOnAfterStateChange write FOnAfterStateChange;
property OnResponse: TOnResponse read FOnResponse write FOnResponse;
property OnReceive: TOnReceive read FOnReceive write FOnReceive;
property OnSend: TOnSend read FOnSend write FOnSend;
property OnUserModeChanged: TNotifyEvent read FOnUserModeChanged write FOnUserModeChanged;
end;
implementation
uses
SysUtils, Response;
constructor TIrcObject.Create(AOwner: TIrcObject);
begin
inherited Create;
SetOwner(AOwner);
if Assigned(FOwner) then
SetSlyIrc(FOwner.SlyIrc);
end;
destructor TIrcObject.Destroy;
begin
SetOwner(nil);
inherited;
end;
procedure TIrcObject.Notification(AIrcObject: TIrcObject;
Operation: TOperation);
begin
end;
procedure TIrcObject.PrivMsg(Text: String);
begin
end;
procedure TIrcObject.Notice(Text: String);
begin
end;
procedure TIrcObject.SetData(const Value: TObject);
begin
FData := Value;
end;
procedure TIrcObject.SetOwner(const Value: TIrcObject);
begin
if FOwner <> Value then
begin
if Assigned(FOwner) then
FOwner.Notification(Self, opRemove);
FOwner := Value;
if Assigned(FOwner) then
FOwner.Notification(Self, opInsert);
end;
end;
procedure TIrcObject.SetSlyIrc(const Value: TSlyIrc);
begin
FSlyIrc := Value;
end;
procedure TIrcObject.SetTag(const Value: Integer);
begin
FTag := Value;
end;
constructor TIrcToken.Create;
begin
FTokens := TList.Create;
FSyntax := tsResponse;
end;
destructor TIrcToken.Destroy;
begin
if Assigned(FTokens) then
FTokens.Free;
end;
function TIrcToken.GetTokens(Index: Integer): String;
var
TokenStart, TokenEnd: PChar;
begin
Result := '';
if Index < FCount then
begin
TokenStart := FTokens[Index];
if TokenStart = nil then
Exit;
TokenEnd := nil;
if Index < FTokens.Count - 1 then
TokenEnd := StrScan(TokenStart, TOKEN_SEPARATOR);
if TokenEnd = nil then
StrLCopy(FBuffer, TokenStart, High(FBuffer))
else
StrLCopy(FBuffer, TokenStart, TokenEnd - TokenStart);
Result := StrPas(FBuffer);
end;
end;
function TIrcToken.GetTokensFrom(Index: Integer): String;
var
TokenStart: PChar;
begin
Result := '';
if Index < FCount then
begin
TokenStart := FTokens[Index];
if TokenStart = nil then
Exit;
StrLCopy(FBuffer, TokenStart, High(FBuffer));
Result := StrPas(FBuffer);
end;
end;
procedure TIrcToken.SetSyntax(const Value: TTokenSyntax);
begin
FSyntax := Value;
end;
procedure TIrcToken.SetTokenString(const Value: String);
begin
if FSyntax = tsCTCP then
FTokenString := Copy(Value, 2, Length(Value) - 2)
else
FTokenString := Value;
Tokenize;
end;
procedure TIrcToken.Tokenize;
var
TokenPtr: PChar;
EndOfTokens: Boolean;
begin
FTokens.Clear;
FCount := 0;
if Length(FTokenString) > 0 then
begin
TokenPtr := PChar(FTokenString);
while (TokenPtr^ <> #0) and (TokenPtr^ = TOKEN_SEPARATOR) do
Inc(TokenPtr);
if TokenPtr^ = #0 then
Exit;
if FSyntax = tsResponse then
begin
if TokenPtr^ <> ':' then
begin
FTokens.Add(nil);
Inc(FCount);
end
else
begin
Inc(TokenPtr);
end;
end;
FTokens.Add(TokenPtr);
Inc(FCount);
while TokenPtr <> nil do
begin
if TokenPtr^ = #1 then
begin
TokenPtr := StrScan(TokenPtr + 1, #1);
if TokenPtr <> nil then
Inc(TokenPtr);
end
else
begin
TokenPtr := StrScan(TokenPtr, TOKEN_SEPARATOR);
end;
while (TokenPtr <> nil) and (TokenPtr^ <> #0) and (TokenPtr^ = TOKEN_SEPARATOR) do
Inc(TokenPtr);
if TokenPtr <> nil then
begin
EndOfTokens := (FSyntax = tsResponse) and (TokenPtr^ = TOKEN_ENDOFTOKENS);
if EndOfTokens then
Inc(TokenPtr);
if TokenPtr^ <> #0 then
begin
FTokens.Add(TokenPtr);
Inc(FCount);
end;
if EndOfTokens then
Break;
end;
end;
end;
end;
function TIrcResponseHandlers.AddHandler(Response: String; HandlerFunc: THandlerFunc): Integer;
var
Handler: PResponseHandler;
begin
Result := IndexOfHandler(Response);
if Result >= 0 then
begin
New(Handler);
Handler^.Response := Response;
Handler^.HandlerFunc := HandlerFunc;
Handler^.PrevHandler := PResponseHandler(FHandlers.Objects[Result]);
FHandlers.Objects[Result] := TObject(Handler);
end
else
begin
New(Handler);
Handler^.Response := Response;
Handler^.HandlerFunc := HandlerFunc;
Handler^.PrevHandler := nil;
Result := FHandlers.AddObject(Handler^.Response, TObject(Handler));
end;
end;
constructor TIrcResponseHandlers.Create(ASlyIrc: TSlyIrc);
begin
inherited Create;
FHandlers := TStringList.Create;
FHandlers.Sorted := True;
FHandlers.Duplicates := dupError;
FSlyIrc := ASlyIrc;
end;
procedure TIrcResponseHandlers.DeleteHandler(Index: Integer);
var
Handler: PResponseHandler;
begin
if (Index >= 0) and (Index < FHandlers.Count) then
begin
Handler := PResponseHandler(FHandlers.Objects[Index]);
if Handler^.PrevHandler <> nil then
FHandlers.Objects[Index] := TObject(Handler^.PrevHandler)
else
FHandlers.Delete(Index);
Dispose(Handler);
end;
end;
destructor TIrcResponseHandlers.Destroy;
begin
while FHandlers.Count > 0 do
DeleteHandler(0);
FHandlers.Free;
inherited;
end;
procedure TIrcResponseHandlers.Handle(Tokens: TIrcToken);
var
Index: Integer;
Handler: PResponseHandler;
BreakChain: Boolean;
begin
Index := IndexOfHandler(Tokens[1]);
if Index >= 0 then
begin
Handler := PResponseHandler(FHandlers.Objects[Index]);
BreakChain := False;
while Assigned(Handler) and not BreakChain do
begin
if Assigned(Handler^.HandlerFunc) then
Handler^.HandlerFunc(FSlyIrc, Tokens[1], Tokens, BreakChain);
Handler := Handler^.PrevHandler;
end;
end;
end;
function TIrcResponseHandlers.IndexOfHandler(Response: String): Integer;
begin
Result := FHandlers.IndexOf(Response);
end;
procedure TIrcResponseHandlers.RemoveHandler(Response: String);
begin
DeleteHandler(IndexOfHandler(Response));
end;
procedure TSlyIrc.Close;
begin
if FState = isReady then
begin
SetState(isDisconnecting);
Send('QUIT');
end
else
begin
if Assigned(FWSocket) then
begin
SetState(isDisconnecting);
FWSocket.Close;
end;
end;
end;
procedure TSlyIrc.Connect;
begin
if Assigned(FWSocket) and (FState = isNotConnected) then
begin
FActualHost := FHost;
FActualNick := FNick;
FChangeNickTo := '';
SetState(isResolvingHost);
FWSocket.DnsLookup(FHost);
end;
end;
constructor TSlyIrc.Create(AOwner: TComponent);
begin
inherited;
FHost := DEFAULT_HOST;
FPort := DEFAULT_PORT;
FNick := DEFAULT_NICK;
FAltNick := DEFAULT_ALTNICK;
FRealName := DEFAULT_REALNAME;
FPassword := DEFAULT_PASSWORD;
FUsername := DEFAULT_USERNAME;
FState := isNotConnected;
FTokens := TIrcToken.Create;
FHandlers := TIrcResponseHandlers.Create(Self);
if not (csDesigning in ComponentState) then
begin
FWSocket := TWSocket.Create(Self);
FWSocket.LineEnd := #10;
FWSocket.LineMode := True;
FWSocket.OnDnsLookupDone := DnsLookupDone;
FWSocket.OnSessionConnected := SessionConnected;
FWSocket.OnSessionClosed := SessionClosed;
FWSocket.OnDataAvailable := DataAvailable;
end;
AddHandlers;
end;
procedure TSlyIrc.DataAvailable(Sender: TObject; Error: Word);
var
AResponse: String;
Suppress: Boolean;
EndOfLineChars: Integer;
begin
if Error <> 0 then
begin
Reset;
end
else
begin
AResponse := FWSocket.ReceiveStr;
if Length(AResponse) > 0 then
begin
EndOfLineChars := 1;
if AResponse[Length(AResponse) - 1] = #13 then
Inc(EndOfLineChars);
SetLength(AResponse, Length(AResponse) - EndOfLineChars);
Receive(AResponse);
Suppress := False;
ProcessResponse(AResponse, Suppress);
end;
end;
end;
destructor TSlyIrc.Destroy;
begin
Reset;
if Assigned(FWSocket) then
FWSocket.Free;
if Assigned(FTokens) then
FTokens.Free;
FHandlers.Free;
inherited;
end;
procedure TSlyIrc.DnsLookupDone(Sender: TObject; Error: Word);
begin
if Error <> 0 then
begin
Reset;
end
else
begin
SetState(isConnecting);
FWSocket.Addr := FWSocket.DnsResult;
FWSocket.Port := FPort;
FWSocket.Connect;
end;
end;
procedure TSlyIrc.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FWSocket) then
FWSocket := nil;
end;
procedure TSlyIrc.Reset;
begin
SetState(isAborting);
if Assigned(FWSocket) then
FWSocket.Abort;
end;
procedure TSlyIrc.Send(Command: String);
begin
if Assigned(FOnSend) then
FOnSend(Self, Command);
if Assigned(FWSocket) and (FState in [isRegistering, isReady]) then
FWSocket.SendStr(Command + #13#10);
end;
procedure TSlyIrc.PrivMsg(Destination, Text: String);
begin
Send(Format('PRIVMSG %s :%s', [Destination, Text]));
end;
procedure TSlyIrc.Notice(Destination, Text: String);
begin
Send(Format('NOTICE %s :%s', [Destination, Text]));
end;
procedure TSlyIrc.SessionClosed(Sender: TObject; Error: Word);
begin
if Error <> 0 then
Reset
else
SetState(isNotConnected);
end;
procedure TSlyIrc.SessionConnected(Sender: TObject; Error: Word);
begin
if Error <> 0 then
begin
Reset;
end
else
begin
SetState(isConnected);
SetState(isRegistering);
if FPassword <> '' then
Send(Format('PASS %s', [FPassword]));
SetNick(FNick);
Send(Format('USER %s %s %s :%s', [FUsername, WSocket.LocalHostName, FHost, FRealName]));
end;
end;
procedure TSlyIrc.SetAltNick(const Value: String);
begin
FAltNick := Value;
end;
procedure TSlyIrc.SetNick(const Value: String);
begin
if Length(Value) > 0 then
begin
if FState in [isRegistering, isReady] then
begin
if Value <> FChangeNickTo then
begin
Send(Format('NICK %s', [Value]));
FChangeNickTo := Value;
end;
end
else
begin
FNick := Value;
end;
end;
end;
procedure TSlyIrc.SetPassword(const Value: String);
begin
FPassword := Value;
end;
procedure TSlyIrc.SetPort(const Value: String);
begin
FPort := Value;
end;
procedure TSlyIrc.SetRealName(const Value: String);
begin
FRealName := Value;
end;
procedure TSlyIrc.SetHost(const Value: String);
begin
FHost := Value;
end;
procedure TSlyIrc.SetUsername(const Value: String);
begin
FUsername := Value;
end;
procedure TSlyIrc.SetState(const Value: TSlyIrcState);
begin
if Value <> FState then
begin
if Assigned(FOnBeforeStateChange) then
FOnBeforeStateChange(Self);
FState := Value;
if Assigned(FOnAfterStateChange) then
FOnAfterStateChange(Self);
end;
end;
function TSlyIrc.GetUserModes: TUserModes;
begin
if FState in [isRegistering, isReady] then
Result := FActualUserModes
else
Result := FUserModes;
end;
procedure TSlyIrc.SetUserModes(const Value: TUserModes);
var
ModeString: String;
begin
if FState in [isRegistering, isReady] then
begin
ModeString := CreateUserModeCommand(Value);
if Length(ModeString) > 0 then
Send(Format('MODE %s %s', [FActualNick, ModeString]));
end
else
begin
FUserModes := Value;
end;
end;
procedure TSlyIrc.ProcessResponse(AResponse: String; var Suppress: Boolean);
begin
FTokens.Syntax := tsResponse;
FTokens.TokenString := AResponse;
FHandlers.Handle(FTokens);
Suppress := False;
Response(FTokens, Suppress);
end;
procedure TSlyIrc.Receive(AResponse: String);
begin
if Assigned(FOnReceive) then
FOnReceive(Self, AResponse);
end;
procedure TSlyIrc.Response(ATokens: TIrcToken; var Suppress: Boolean);
begin
if Assigned(FOnResponse) then
FOnResponse(Self, ATokens, Suppress);
end;
procedure TSlyIrc.UserModeChanged;
begin
if Assigned(FOnUserModeChanged) then
FOnUserModeChanged(Self);
end;
procedure TSlyIrc.Quit(Reason: String);
begin
Send(Format('QUIT :%s', [Reason]));
end;
procedure TSlyIrc.AddHandlers;
begin
FHandlers.AddHandler('PING', RplPing);
FHandlers.AddHandler('NICK', RplNick);
FHandlers.AddHandler(RPL_WELCOME1, RplWelcome1);
FHandlers.AddHandler(ERR_NICKNAMEINUSE, ErrNicknameInUse);
FHandlers.AddHandler('MODE', RplMode);
end;
function TSlyIrc.GetHost: String;
begin
if FState in [isRegistering, isReady] then
Result := FActualHost
else
Result := FHost;
end;
function TSlyIrc.GetNick: String;
begin
if FState in [isRegistering, isReady] then
Result := FActualNick
else
Result := FNick;
end;
function TSlyIrc.ExtractNickFromAddress(Address: String): String;
var
EndOfNick: Integer;
begin
Result := '';
EndOfNick := Pos('!', Address);
if EndOfNick > 0 then
Result := Copy(Address, 1, EndOfNick - 1);
end;
procedure TSlyIrc.RplNick(SlyIrc: TSlyIrc; AResponse: String;
ATokens: TIrcToken; var BreakChain: Boolean);
begin
if UpperCase(ExtractNickFromAddress(ATokens[0])) = UpperCase(FActualNick) then
FActualNick := ATokens[2];
end;
procedure TSlyIrc.RplPing(SlyIrc: TSlyIrc; AResponse: String;
ATokens: TIrcToken; var BreakChain: Boolean);
begin
SlyIrc.Send(Format('PONG %s', [ATokens[2]]));
end;
procedure TSlyIrc.RplWelcome1(SlyIrc: TSlyIrc; AResponse: String;
ATokens: TIrcToken; var BreakChain: Boolean);
begin
FActualHost := ATokens[0];
FActualNick := ATokens[2];
SetState(isReady);
if FUserModes <> [] then
Send(Format('MODE %s %s', [FActualNick, CreateUserModeCommand(FUserModes)]));
end;
procedure TSlyIrc.ErrNicknameInUse(SlyIrc: TSlyIrc; AResponse: String;
ATokens: TIrcToken; var BreakChain: Boolean);
begin
if FState = isRegistering then
begin
if FChangeNickTo = FNick then
SetNick(FAltNick)
else
Quit('Nick conflict');
end;
end;
function TSlyIrc.CreateUserModeCommand(NewModes: TUserModes): String;
const
ModeChars: array [umInvisible..umWallops] of Char = ('i', 'o', 's', 'w');
var
ModeDiff: TUserModes;
Mode: TUserMode;
begin
Result := '';
ModeDiff := FActualUserModes - NewModes;
if ModeDiff <> [] then
begin
Result := Result + '-';
for Mode := Low(TUserMode) to High(TUserMode) do
begin
if Mode in ModeDiff then
Result := Result + ModeChars[Mode];
end;
end;
ModeDiff := NewModes - FActualUserModes;
if ModeDiff <> [] then
begin
Result := Result + '+';
for Mode := Low(TUserMode) to High(TUserMode) do
begin
if Mode in ModeDiff then
Result := Result + ModeChars[Mode];
end;
end;
end;
procedure TSlyIrc.RplMode(SlyIrc: TSlyIrc; AResponse: String;
ATokens: TIrcToken; var BreakChain: Boolean);
var
Index: Integer;
ModeString: String;
AddMode: Boolean;
begin
if ATokens[2] = FActualNick then
begin
ModeString := ATokens[3];
AddMode := True;
for Index := 1 to Length(ModeString) do
begin
case ModeString[Index] of
'+':
AddMode := True;
'-':
AddMode := False;
'i':
if AddMode then
FActualUserModes := FActualUserModes + [umInvisible]
else
FActualUserModes := FActualUserModes - [umInvisible];
'o':
if AddMode then
FActualUserModes := FActualUserModes + [umOperator]
else
FActualUserModes := FActualUserModes - [umOperator];
's':
if AddMode then
FActualUserModes := FActualUserModes + [umServerNotices]
else
FActualUserModes := FActualUserModes - [umServerNotices];
'w':
if AddMode then
FActualUserModes := FActualUserModes + [umWallops]
else
FActualUserModes := FActualUserModes - [umWallops];
end;
end;
UserModeChanged;
end;
end;
end.
Og Response.pas skal se sådan ud:
unit Response;
interface
const
RPL_WELCOME1 = '001';
RPL_WELCOME2 = '002';
RPL_WELCOME3 = '003';
RPL_WELCOME4 = '004';
RPL_TRACELINK = '200';
RPL_TRACECONNECTING = '201';
RPL_TRACEHANDSHAKE = '202';
RPL_TRACEUNKNOWN = '203';
RPL_TRACEOPERATOR = '204';
RPL_TRACEUSER = '205';
RPL_TRACESERVER = '206';
RPL_TRACENEWTYPE = '208'; { <newtype> 0 <client name> }
RPL_STATSLINKINFO = '211'; { <linkname> <sendq> <sent messages> <sent bytes> <received messages> <received bytes> <time open> }
RPL_STATSCOMMANDS = '212'; { <command> <count> }
RPL_STATSCLINE = '213'; { C <host> * <name> <port> <class> }
RPL_STATSNLINE = '214'; { N <host> * <name> <port> <class> }
RPL_STATSILINE = '215'; { I <host> * <host> <port> <class> }
RPL_STATSKLINE = '216'; { K <host> * <username> <port> <class> }
RPL_STATSYLINE = '218'; { Y <class> <ping frequency> <connect frequency> <max sendq> }
RPL_ENDOFSTATS = '219'; { <stats letter> :End of /STATS report }
RPL_UMODEIS = '221'; { <user mode string> }
RPL_STATSLLINE = '241'; { L <hostmask> * <servername> <maxdepth> }
RPL_STATSUPTIME = '242'; { :Server Up %d days %d:%02d:%02d }
RPL_STATSOLINE = '243'; { O <hostmask> * <name> }
RPL_STATSHLINE = '244'; { H <hostmask> * <servername> }
RPL_LUSERCLIENT = '251'; { :There are <integer> users and <integer> invisible on <integer> servers }
RPL_LUSEROP = '252'; { <integer> :operator(s) online }
RPL_LUSERUNKNOWN = '253'; { <integer> :unknown connection(s) }
RPL_LUSERCHANNELS = '254'; { <integer> :channels formed }
RPL_LUSERME = '255'; { :I have <integer> clients and <integer> servers }
RPL_ADMINME = '256'; { <server> :Administrative info }
RPL_ADMINLOC1 = '257'; { :<admin info> }
RPL_ADMINLOC2 = '258'; { :<admin info> }
RPL_ADMINEMAIL = '259'; { :<admin info> }
RPL_TRACELOG = '261'; { File <logfile> <debug level> }
RPL_NONE = '300'; { Dummy reply number. Not used. }
RPL_AWAY = '301'; { <nick> :<away message> }
RPL_USERHOST = '302'; { :[<reply><space><reply>] }
RPL_ISON = '303'; { :[<nick> <space><nick>] }
RPL_UNAWAY = '305'; { :You are no longer marked as being away }
RPL_NOWAWAY = '306'; { :You have been marked as being away }
RPL_WHOISUSER = '311'; { <nick> <user> <host> * :<real name> }
RPL_WHOISSERVER = '312'; { <nick> <server> :<server info> }
RPL_WHOISOPERATOR = '313'; { <nick> :is an IRC operator }
RPL_WHOWASUSER = '314'; { <nick> <user> <host> * :<real name> }
RPL_ENDOFWHO = '315'; { <name> :End of /WHO list }
RPL_WHOISIDLE = '317'; { <nick> <integer> :seconds idle }
RPL_ENDOFWHOIS = '318'; { <nick> :End of /WHOIS list }
RPL_WHOISCHANNELS = '319'; { <nick> :[@|+]<channel><space> }
RPL_LISTSTART = '321'; { Channel :Users Name }
RPL_LIST = '322'; { <channel> <# visible> :<topic> }
RPL_LISTEND = '323'; { :End of /LIST }
RPL_CHANNELMODEIS = '324'; { <channel> <mode> <mode params> }
RPL_NOTOPIC = '331'; { <channel> :No topic is set }
RPL_TOPIC = '332'; { <channel> :<topic> }
RPL_INVITING = '341'; { <channel> <nick> }
RPL_SUMMONING = '342'; { <user> :Summoning user to IRC }
RPL_VERSION = '351'; { <version>.<debuglevel> <server> :<comments> }
RPL_WHOREPLY = '352'; { <channel> <user> <host> <server> <nick> <H|G>
[@|+] :<hopcount> <real name> } RPL_NAMREPLY = '353'; { <channel> :[[@|+]<nick> [[@|+]<nick> [...]]] }
RPL_LINKS = '364'; { <mask> <server> :<hopcount> <server info> }
RPL_ENDOFLINKS = '365'; { <mask> :End of /LINKS list }
RPL_ENDOFNAMES = '366'; { <channel> :End of /NAMES list }
RPL_BANLIST = '367'; { <channel> <banid> }
RPL_ENDOFBANLIST = '368'; { <channel> :End of channel ban list }
RPL_ENDOFWHOWAS = '369'; { <nick> :End of WHOWAS }
RPL_INFO = '371'; { :<string> }
RPL_MOTD = '372'; { :- <text> }
RPL_ENDOFINFO = '374'; { :End of /INFO list }
RPL_MOTDSTART = '375'; { ":- <server> Message of the day -," }
RPL_ENDOFMOTD = '376'; { :End of /MOTD command }
RPL_YOUREOPER = '381'; { :You are now an IRC operator }
RPL_REHASHING = '382'; { <config file> :Rehashing }
RPL_TIME = '391'; { }
RPL_USERSSTART = '392'; { :UserID Terminal Host }
RPL_USERS = '393'; { :%-8s %-9s %-8s }
RPL_ENDOFUSERS = '394'; { :End of users }
RPL_NOUSERS = '395'; { :Nobody logged in }
ERR_NOSUCHNICK = '401'; { <nickname> :No such nick/channel }
ERR_NOSUCHSERVER = '402'; { <server name> :No such server }
ERR_NOSUCHCHANNEL = '403'; { <channel name> :No such channel }
ERR_CANNOTSENDTOCHAN = '404'; { <channel name> :Cannot send to channel }
ERR_TOOMANYCHANNELS = '405'; { <channel name> :You have joined too many channels }
ERR_WASNOSUCHNICK = '406'; { <nickname> :There was no such nickname }
ERR_TOOMANYTARGETS = '407'; { <target> :Duplicate recipients. No message delivered }
ERR_NOORIGIN = '409'; { :No origin specified }
ERR_NORECIPIENT = '411'; { :No recipient given (<command>) }
ERR_NOTEXTTOSEND = '412'; { :No text to send }
ERR_NOTOPLEVEL = '413'; { <mask> :No toplevel domain specified }
ERR_WILDTOPLEVEL = '414'; { <mask> :Wildcard in toplevel domain }
ERR_UNKNOWNCOMMAND = '421'; { <command> :Unknown command }
ERR_NOMOTD = '422'; { :MOTD File is missing }
ERR_NOADMININFO = '423'; { <server> :No administrative info available }
ERR_FILEERROR = '424'; { :File error doing <file op> on <file> }
ERR_NONICKNAMEGIVEN = '431'; { :No nickname given }
ERR_ERRONEUSNICKNAME = '432'; { <nick> :Erroneus nickname }
ERR_NICKNAMEINUSE = '433'; { <nick> :Nickname is already in use }
ERR_NICKCOLLISION = '436'; { <nick> :Nickname collision KILL }
ERR_USERNOTINCHANNEL = '441'; { <nick> <channel> :They aren't on that channel }
ERR_NOTONCHANNEL = '442'; { <channel> :You're not on that channel }
ERR_USERONCHANNEL = '443'; { <user> <channel> :is already on channel }
ERR_NOLOGIN = '444'; { <user> :User not logged in }
ERR_SUMMONDISABLED = '445'; { :SUMMON has been disabled }
ERR_USERSDISABLED = '446'; { :USERS has been disabled }
ERR_NOTREGISTERED = '451'; { :You have not registered }
ERR_NEEDMOREPARAMS = '461'; { <command> :Not enough parameters }
ERR_ALREADYREGISTRED = '462'; { :You may not reregister }
ERR_NOPERMFORHOST = '463'; { :Your host isn't among the privileged }
ERR_PASSWDMISMATCH = '464'; { :Password incorrect }
ERR_YOUREBANNEDCREEP = '465'; { :You are banned from this server }
ERR_KEYSET = '467'; { <channel> :Channel key already set }
ERR_CHANNELISFULL = '471'; { <channel> :Cannot join channel (+l) }
ERR_UNKNOWNMODE = '472'; { <char> :is unknown mode char to me }
ERR_INVITEONLYCHAN = '473'; { <channel> :Cannot join channel (+i) }
ERR_BANNEDFROMCHAN = '474'; { <channel> :Cannot join channel (+b) }
ERR_BADCHANNELKEY = '475'; { <channel> :Cannot join channel (+k) }
ERR_NOPRIVILEGES = '481'; { :Permission Denied- You're not an IRC operator }
ERR_CHANOPRIVSNEEDED = '482'; { <channel> :You're not channel operator }
ERR_CANTKILLSERVER = '483'; { :You cant kill a server! }
ERR_NOOPERHOST = '491'; { :No O-lines for your host }
ERR_UMODEUNKNOWNFLAG = '501'; { :Unknown MODE flag }
ERR_USERSDONTMATCH = '502'; { :Cant change mode for other users }
implementation
end.
