const
CommandList:
array[0..2]
of string = (
'
NICK',
{ Define a nickname. RFC 2812 }
'
PASS',
{ Set a connection password. }
'
USER',
{ Specify the username, hostname and realname of a new user. }
);
...
type
TFlagSet =
set of (PASS, NICK, USER);
PConnectionList = ^TConnectionList;
TConnectionList =
record
SockID: integer;
Queue:
string;
flags: TFlagSet;
PASS:
string;
nick:
string;
user:
string;
Next: PConnectionList;
end;
TIRCd =
class(TCustomServerSocket)
private
FServerHost:
string;
FServerPassword:
string;
ConnectionListAnchor: PConnectionList;
procedure ClientConnect(Sender: TObject; ASocket: TCustomWinSocket);
procedure ClientDisconnect(Sender: TObject; ASocket: TCustomWinSocket);
procedure ClientRead(Sender: TObject; ASocket: TCustomWinSocket);
procedure RegisterUser(
var AIRCd: TIRCd;
var ASocket: TCustomWinSocket;
var CurrentConnection: PConnectionList);
procedure FreeUserData(SocketHandle: integer);
public
constructor Create(AOwner: TComponent);
override;
property Socket: TServerWinSocket
read FServerSocket;
property Active;
property Port;
property ServerHost:
string read FServerHost
write FServerHost;
property ServerPassword:
string read FServerPassword
write FServerPassword;
property OnClientConnect;
property OnClientDisconnect;
property OnClientRead;
end;
...
procedure TIRCd.ClientConnect(Sender: TObject; ASocket: TCustomWinSocket);
var
ConnectionListItem: PConnectionList;
CurrentListItem: PConnectionList;
begin
{ hier füg ich den user in die verkettete liste ein. }
new(ConnectionListItem);
ConnectionListItem^.SockID := ASocket.SocketHandle;
ConnectionListItem^.Queue := '
';
ConnectionListItem^.Next :=
nil;
if ConnectionListAnchor =
nil then
ConnectionListAnchor := ConnectionListItem
else
begin
CurrentListItem := ConnectionListAnchor;
while (CurrentListItem^.Next <>
nil)
do
CurrentListItem := CurrentListItem^.Next;
CurrentListItem^.Next := ConnectionListItem;
end;
end;
procedure TIRCd.ClientDisconnect(Sender: TObject; ASocket: TCustomWinSocket);
begin
FreeUserData(ASocket.SocketHandle);
end;
procedure TIRCd.ClientRead(Sender: TObject; ASocket: TCustomWinSocket);
var
CurrentConnection: PConnectionList;
CurrentLine:
string;
begin
CurrentConnection := ConnectionListAnchor;
while not (CurrentConnection^.SockID = ASocket.SocketHandle)
do
CurrentConnection := CurrentConnection^.Next;
with ASocket
do
begin
CurrentConnection^.Queue := CurrentConnection^.Queue + ReceiveText;
while pos(#13, CurrentConnection^.Queue) <> 0
do
CurrentConnection^.Queue[pos(#13, CurrentConnection^.Queue)] := #10;
while pos(#10#10, CurrentConnection^.Queue) <> 0
do
delete(CurrentConnection^.Queue, pos(#10#10, CurrentConnection^.Queue), 1);
while pos(#10, CurrentConnection^.Queue) <> 0
do
begin
CurrentLine := copy(CurrentConnection^.Queue, 1, pos(#10, CurrentConnection^.Queue)-1);
delete(CurrentConnection^.Queue, 1, pos(#10, CurrentConnection^.Queue));
if (PASS
in CurrentConnection^.flags)
or
((
not(PASS
in CurrentConnection^.flags))
and
((GetTok(CurrentLine, 1, '
') = '
PASS')
or
(GetTok(CurrentLine, 1, '
') = '
USER')
or
(GetTok(CurrentLine, 1, '
') = '
NICK')))
then
case IdxArrStr(CommandList, GetTok(CurrentLine, 1, #32))
of
0:
{NICK}
begin
CurrentConnection^.flags := CurrentConnection^.flags + [NICK];
CurrentConnection^.nick := GetTok(CurrentLine, 2, '
');
if ([PASS, NICK, USER] * CurrentConnection^.flags) = [PASS, NICK, USER]
then
//RegisterUser(self, ASocket, CurrentConnection);
end;
1:
{PASS}
begin
CurrentConnection^.flags := CurrentConnection^.flags + [PASS];
CurrentConnection^.PASS := GetTok(CurrentLine, 2, '
');
if ([PASS, NICK, USER] * CurrentConnection^.flags) = [PASS, NICK, USER]
then
//RegisterUser(self, ASocket, CurrentConnection);
end;
2:
{USER}
begin
if NumTok(CurrentLine, '
') > 1
then
begin
CurrentConnection^.flags := CurrentConnection^.flags + [USER];
CurrentConnection^.USER := GetTok(CurrentLine, 2, '
');
if ([PASS, NICK, USER] * CurrentConnection^.flags) = [PASS, NICK, USER]
then
RegisterUser(self, ASocket, CurrentConnection);
end
else ASocket.SendText(Format('
:%s %s %s USER :Not enough parameters', [FServerHost, '
461', CurrentConnection^.nick]) + #13#10);
end;
end;
end;
end;
end;
procedure TIRCd.FreeUserData(SocketHandle: integer);
var
CurrentConnectionItem: PConnectionList;
dummy: PConnectionList;
begin
if ConnectionListAnchor <>
nil then
begin
if ConnectionListAnchor^.SockID = SocketHandle
then
begin
CurrentConnectionItem := ConnectionListAnchor^.Next;
Dispose(ConnectionListAnchor);
ConnectionListAnchor := CurrentConnectionItem;
end
else
begin
CurrentConnectionItem := ConnectionListAnchor;
while (CurrentConnectionItem^.Next <>
nil)
do
begin
if CurrentConnectionItem^.Next^.SockID = SocketHandle
then
begin
dummy := CurrentConnectionItem^.Next^.Next;
Dispose(CurrentConnectionItem^.Next);
CurrentConnectionItem^.Next := dummy;
end
else CurrentConnectionItem := CurrentConnectionItem^.Next;
end;
end;
end;
end;
procedure TIRCd.RegisterUser(
var AIRCd: TIRCd;
var ASocket: TCustomWinSocket;
var CurrentConnection: PConnectionList);
var
hSock: integer;
begin
if (CurrentConnection^.PASS <> FServerPassword)
then
begin
hSock := ASocket.SocketHandle;
ASocket.SendText(Format('
ERROR :Closing Link: %s[%s] (Bad Password)', [CurrentConnection^.nick, ASocket.RemoteAddress]) + #13#10);
AIRCd.Socket.Disconnect(ASocket.SocketHandle);
FreeUserData(hSock);
end;
end;