SCAR Code:
program IscaRC;
{
IRC client written in scar
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
}
{
Notable contributers
- yakman (started the project)
- mixster (for ideas, suggestions and general support)
- wizzup (ditto mixster)
}
type
User = record
powers, name: string;
end;
Channel = record
name: string;
users: array of User; //sorted list
Tab: TTabSheet;
TextArea: TRichEdit;
InputEditBox, TopicEditBox: TEdit;
UserCountLabel: TLabel;
NamesTextArea: TMemo;
end;
//gui vars
var
MainForm: TForm;
MainPageControl: TPageControl;
FormHighlightingTimer: TTimer;
ConfigPage: TTabSheet;
NickEditBox, PortEditBox, ServerEditBox, UsernameEditBox, RealnameEditBox, PasswordEditBox, HighlightEditBox: TEdit;
ConnectButton: TButton;
TimestampCheckbox, KickRejoinCheckbox: TCheckBox;
NetworkTab: TTabSheet;
NetworkTextArea: TRichEdit;
NetworkInputEditBox, NetworkTopicEditBox: TEdit;
//gui vars accessable from the main thread
var
autorejoin: Boolean;
highlight_list: TStringList;
is_highlight: boolean;
//irc vars
var
irc_nick: string;
irc_server: string;
irc_port: Integer;
irc_username, irc_realname, irc_nickserv: string;
network_name: string;
channel_list: array of Channel;
var //socket connection
sock_fd: Integer;
buffer: string;
buf_pos, buf_len: Integer;
//script constants
const
Version = '0.9';
CRLF = #13 + #10;
default_irc_nick = 'nickname';
default_irc_server = 'irc.freenode.net';
default_irc_port = '6667';
default_irc_username = 'username';
default_irc_realname = 'realname';
default_irc_nickserv = '';
default_irc_highlight = '';
default_prefix_modes = 'vo'; //ordered least powerful to most
default_prefix_status = '+@';
default_chan_mode_param = 'bdeIqk';
default_chan_mode_param_set = 'lfJD';
default_chan_mode_no_param = 'cgijLmnPQrRstz';
main_form_caption = 'IscaRC';
no_color = -1;
topic_color = clPurple;
banlist_color = clAquamarine;
slash_me_color = clBlue;
nick_color = slash_me_color;
mode_color = slash_me_color;
ctcp_color = clOlive;
quit_color = clChocolate;
kick_color = clGold;
part_color = clBrass;
join_color = clGreen;
highlight_color = clRed;
invite_color = clCopper;
highlight_sound = 'C:/windows/media/notify.wav';
function MakeTimestamp: string;
var
hour, min, sec, msec: word;
h, m: string;
begin
DecodeTime(now, hour, min, sec, msec);
h:= IntToStr(hour);
m:= IntToStr(min);
if(hour < 10)then
h:= '0' + h;
if(min < 10)then
m:= '0' + m;
Result:= '[' + h + ':' + m + ']';
end;
procedure MainFormFocused;
begin
FormHighlightingTimer.Enabled:= False;
MainForm.Caption:= main_form_caption + ': ' + irc_nick + ' @ ' + network_name;
GetApplication.Title:= main_form_caption + ': ' + irc_nick + ' @ ' + network_name;
end;
//invoked when the network text area is clicked
procedure NetworkTextAreaOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
NetworkInputEditBox.SetFocus;
MainFormFocused;
end;
//invoked when a main text area gets a key event
procedure TextAreaOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
src: TRichEdit;
begin
src:= TRichEdit(Sender);
if(ssCtrl in Shift)and(key = 67)then //ctrl + c
src.CopyToClipboard;
end;
procedure TextAreaOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
f: Integer;
src: TRichEdit;
begin
MainFormFocused;
src:= TRichEdit(Sender);
for f:= 0 to High(channel_list) do
if(channel_list[f].TextArea = src)then
begin
channel_list[f].InputEditBox.SetFocus;
Exit;
end
end;
//when you change to any tab except config
procedure ChangeTabFromConfig(Sender: TObject);
var
src: TTabSheet;
temp: string;
begin
autorejoin:= KickRejoinCheckbox.Checked;
//highlight_list.Free;
highlight_list:= TStringList.Create;
highlight_list.Clear;
highlight_list.DelimitedText:= HighlightEditBox.Text;
highlight_list.Delimiter:= ',';
src:= TTabSheet(Sender);
temp:= src.Caption;
Delete(temp, 1, 1);
if(src.Caption[1] = '*')or(src.Caption[1] = '+')then
src.Caption:= temp;
end;
//when main form is resized
procedure MainFormOnResize(Sender: TObject);
var
f: Integer;
begin
MainFormFocused;
NetworkInputEditBox.Width:= MainForm.Width; //these cant do Align
NetworkTopicEditBox.Width:= MainForm.Width;
for f:=0 to High(channel_list) do
begin
channel_list[f].InputEditBox.Width:= MainForm.Width;
channel_list[f].TopicEditBox.Width:= MainForm.Width;
end;
end;
procedure ConnectButtonOnClick(Sender: TObject);
begin
irc_nick:= NickEditBox.Text;
irc_server:= ServerEditBox.Text;
irc_port:= StrToIntDef(PortEditBox.Text, 6667);
irc_username:= UsernameEditBox.Text;
irc_realname:= RealnameEditBox.Text;
irc_nickserv:= PasswordEditBox.Text;
NickEditBox.Enabled:= False;
ServerEditBox.Enabled:= False;
PortEditBox.Enabled:= False;
UsernameEditBox.Enabled:= False;
RealnameEditBox.Enabled:= False;
PasswordEditBox.Enabled:= False;
//ConnectButton.Caption:= 'Disconnect'; //TODO
ConnectButton.Enabled:= False;
MainPageControl.ActivePage:= NetworkTab;
end;
procedure SendData(data: string); forward;
function NextToken(var strtok: string; c: char): string; forward;
function NextTokenSafe(var strtok: string; c: char): string; forward;
procedure CheckFirstColon(var str: string); forward;
procedure AddToAnyText(chan_index: Integer; Line: string; Color: Integer); forward;
function LookupChannel(name: string): Integer; forward;
procedure HandleSlashCommand(Line: string; chan_index: Integer);
var
linetok, cmd, str1: string;
c: integer;
begin
linetok:= Line;
cmd:= Uppercase(NextTokenSafe(linetok, ' '));
if(cmd = 'MSG')then
begin
str1:= NextToken(linetok, ' '); //target
CheckFirstColon(linetok);
if(str1 = #0)then
begin
AddToAnyText(-1, '/msg [target] [text]', no_color);
Exit;
end;
SendData('PRIVMSG ' + str1 + ' :' + linetok);
channel_list[chan_index].TextArea.Lines.Add('-' + str1 + '- ' + linetok);
end else
if(cmd = 'JOIN')or(cmd = 'MODE')or(cmd = 'NICK')then
begin //cmds which will just be sent
SendData(cmd + ' ' + linetok);
end else
if(cmd = 'PART')then
begin
if(chan_index = -1)then
Exit;
SendData('PART ' + channel_list[chan_index].name + ' :' + linetok);
end else
if(cmd = 'KICK')then
begin
if(chan_index = -1)then
Exit;
str1:= NextTokenSafe(linetok, ' '); //name
SendData('KICK ' + channel_list[chan_index].name + ' ' + str1 + ' :' + linetok);
end else
if(cmd = 'TOPIC')then
begin
if(chan_index = -1)then
Exit;
SendData('TOPIC ' + channel_list[chan_index].name + ' :' + linetok);
end else
if(cmd = 'CYCLE')then
begin
if(chan_index = -1)then
Exit;
str1:= channel_list[chan_index].name;
SendData('PART ' + str1);
SendData('JOIN ' + str1);
end else
if(cmd = 'CTCP')then
begin
str1:= NextToken(linetok, ' '); //target
if(str1 = #0)then
begin
AddToAnyText(-1, '/ctcp [channel] [request]', no_color);
Exit;
end;
SendData('PRIVMSG ' + str1 + ' :' + #1 + linetok + #1);
AddToAnyText(c, '>' + str1 + '< ' + linetok, ctcp_color);
end else
if(cmd = 'ME')then
begin
SendData('PRIVMSG ' + channel_list[chan_index].name + ' :' + #1 + 'ACTION ' + linetok + #1);
AddToAnyText(c, '* ' + irc_nick + linetok, slash_me_color);
end else
if(cmd = 'PING')then
begin
str1:= NextTokenSafe(linetok, ' '); //target
if(str1 = '')then
begin
AddToAnyText(-1, '/ping [target]', no_color);
Exit;
end;
SendData('PRIVMSG ' + str1 + ' :' + #1 + 'PING ' + IntToStr(GetTickCount) + #1);
end else
if(cmd = 'NAMES')then //TODO this is just a shitty workaround for a bug
begin
end else
SendData(cmd + ' ' + linetok);
end;
{
procedure InputEditBoxOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
writeln(inttostr(key));
//TODO find a way to implement pressing tab for nick completion
// if(StartsWith('!tab ', linetok))then
// begin
// str1:= Copy(linetok, 6, Length(linetok));
// for t:= 0 to High(channel_list[0].users) do
// if(Lowercase(str1) = Lowercase(Left(channel_list[0].users[t].name, Length(str1))))then
// SendData('PRIVMSG ' + channel_list[0].name + ' :' + channel_list[0].users[t].name);
// end
end;
}
procedure InputEditBoxOnKeyPress(Sender: TObject; var Key: Char);
var
src: TEdit;
line: string;
f: Integer;
begin
if(key <> #13)then
Exit;
src:= TEdit(Sender);
line:= src.Text;
src.Text:= '';
if(line = '')then
Exit;
if(src <> NetworkInputEditBox)then
for f:= 0 to High(channel_list) do
if(channel_list[f].InputEditBox = src)then
Break;
if(line[1] = '/')and(line[2] <> '/')then
begin
Delete(line, 1, 1);
HandleSlashCommand(line, f);
end
else
begin
if(src = NetworkInputEditBox)then
Exit;
if(line[2] = '/')then
Delete(line, 1, 1);
SendData('PRIVMSG ' + channel_list[f].name + ' :' + line);
channel_list[f].TextArea.Lines.Add('<' + irc_nick + '> ' + line);
end
end;
procedure MainFormOnCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if(sock_fd = -1)then
Exit;
try
FreeConnection(sock_fd);
sock_fd:= -1;
except
writeln('error with freeconnection');
end
end;
procedure MainPageControlOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//TODO make popup menus
end;
procedure FormHighlightingOnTimer(Sender: TObject);
begin
if(Pos('HIGHLIGHTED', MainForm.Caption) <> 0)then
begin
MainForm.Caption:= main_form_caption + ': ' + irc_nick + ' @ ' + network_name;
GetApplication.Title:= main_form_caption + ': ' + irc_nick + ' @ ' + network_name;
end
else
begin
MainForm.Caption:= main_form_caption + ': ' + irc_nick + ' @ ' + network_name + ' YOU''RE HIGHLIGHTED';
GetApplication.Title:= main_form_caption + ': ' + irc_nick + ' @ ' + network_name + ' YOU''RE HIGHLIGHTED';;
end;
end;
procedure UnsafeCreateMainForm;
var
Label1, Label2, Label3, Label5, Label6, Label7, Label8, Label9: TLabel;
GroupBox1: TGroupBox;
Panel1, Panel2: TPanel;
begin
MainForm := CreateForm;
MainForm.Width := 716;
MainForm.Height := 517;
MainForm.Position:= poScreenCenter;
MainForm.Caption := main_form_caption;
MainForm.Font.Color := clWindowText;
MainForm.Font.Name := 'Fixedsys';
MainForm.Constraints.MinHeight:= MainForm.Height;
MainForm.Constraints.MinWidth:= MainForm.Width;
MainForm.OnCloseQuery:= @MainFormOnCloseQuery;
FormHighlightingTimer:= TTimer.Create(MainForm);
FormHighlightingTimer.Interval:= 750;
FormHighlightingTimer.OnTimer:= @FormHighlightingOnTimer;
FormHighlightingTimer.Enabled:= False;
MainPageControl := TPageControl.Create(MainForm);
MainPageControl.Parent := MainForm;
MainPageControl.Align := alClient;
MainPageControl.TabStop:= False;
MainPageControl.OnMouseDown:= @MainPageControlOnMouseDown;
ConfigPage := TTabSheet.Create(MainForm);
ConfigPage.Caption := 'Config';
ConfigPage.PageControl := MainPageControl;
Label1 := TLabel.Create(MainForm);
Label1.Parent := ConfigPage;
Label1.Left := 360;
Label1.Top := 140;
Label1.Width := 190;
Label1.Height := 20;
Label1.Caption := 'Extra Words to highlight on';
Label1.Font.Color := clWindowText;
Label1.Font.Height := -16;
Label1.ParentFont := False;
HighlightEditBox := TEdit.Create(MainForm);
HighlightEditBox.Parent := ConfigPage;
HighlightEditBox.Left := 360;
HighlightEditBox.Top := 160;
HighlightEditBox.Width := 201;
HighlightEditBox.Height := 24;
HighlightEditBox.Font.Color := clWindowText;
HighlightEditBox.Font.Height := -13;
HighlightEditBox.ParentFont := False;
HighlightEditBox.TabOrder := 4;
HighlightEditBox.Text := default_irc_highlight;
Label2 := TLabel.Create(MainForm);
Label2.Parent := ConfigPage;
Label2.Left := 360;
Label2.Top := 186;
Label2.Width := 87;
Label2.Height := 13;
Label2.Caption := 'Comma Seperated';
KickRejoinCheckbox := TCheckBox.Create(MainForm);
KickRejoinCheckbox.Parent := ConfigPage;
KickRejoinCheckbox.Left := 360;
KickRejoinCheckbox.Top := 104;
KickRejoinCheckbox.Width := 200;
KickRejoinCheckbox.Height := 17;
KickRejoinCheckbox.Caption := 'Auto-Rejoin on Kick';
KickRejoinCheckbox.Font.Color := clWindowText;
KickRejoinCheckbox.Font.Height := -13;
KickRejoinCheckbox.ParentFont := False;
KickRejoinCheckbox.TabOrder := 12;
GroupBox1 := TGroupBox.Create(MainForm);
GroupBox1.Parent := ConfigPage;
GroupBox1.Left := 16;
GroupBox1.Top := 72;
GroupBox1.Width := 329;
GroupBox1.Height := 217;
GroupBox1.Caption := 'IRC';
GroupBox1.TabOrder := 1;
Label5 := TLabel.Create(GroupBox1);
Label5.Parent := GroupBox1;
Label5.Left := 16;
Label5.Top := 152;
Label5.Width := 73;
Label5.Height := 20;
Label5.Caption := 'Realname';
Label5.Font.Color := clWindowText;
Label5.Font.Height := -16;
Label5.ParentFont := False;
Label6 := TLabel.Create(GroupBox1);
Label6.Parent := GroupBox1;
Label6.Left := 16;
Label6.Top := 24;
Label6.Width := 30;
Label6.Height := 20;
Label6.Caption := 'Nick';
Label6.Font.Color := clWindowText;
Label6.Font.Height := -16;
Label6.ParentFont := False;
Label7 := TLabel.Create(GroupBox1);
Label7.Parent := GroupBox1;
Label7.Left := 16;
Label7.Top := 120;
Label7.Width := 74;
Label7.Height := 20;
Label7.Caption := 'Username';
Label7.Font.Color := clWindowText;
Label7.Font.Height := -16;
Label7.ParentFont := False;
Label8 := TLabel.Create(GroupBox1);
Label8.Parent := GroupBox1;
Label8.Left := 16;
Label8.Top := 88;
Label8.Width := 29;
Label8.Height := 20;
Label8.Caption := 'Port';
Label8.Font.Color := clWindowText;
Label8.Font.Height := -16;
Label8.ParentFont := False;
Label9 := TLabel.Create(GroupBox1);
Label9.Parent := GroupBox1;
Label9.Left := 16;
Label9.Top := 56;
Label9.Width := 46;
Label9.Height := 20;
Label9.Caption := 'Server';
Label9.Font.Color := clWindowText;
Label9.Font.Height := -16;
Label9.ParentFont := False;
Label3 := TLabel.Create(GroupBox1);
Label3.Parent := GroupBox1;
Label3.Left := 16;
Label3.Top := 184;
Label3.Width := 59;
Label3.Height := 20;
Label3.Caption := 'Nickserv';
Label3.Font.Color := clWindowText;
Label3.Font.Height := -16;
Label3.ParentFont := False;
NickEditBox := TEdit.Create(GroupBox1);
NickEditBox.Parent := GroupBox1;
NickEditBox.Left := 96;
NickEditBox.Top := 24;
NickEditBox.Width := 217;
NickEditBox.Height := 24;
NickEditBox.Font.Color := clWindowText;
NickEditBox.Font.Height := -13;
NickEditBox.ParentFont := False;
NickEditBox.TabOrder := 1;
NickEditBox.Text := default_irc_nick;
ServerEditBox := TEdit.Create(GroupBox1);
ServerEditBox.Parent := GroupBox1;
ServerEditBox.Left := 96;
ServerEditBox.Top := 56;
ServerEditBox.Width := 217;
ServerEditBox.Height := 24;
ServerEditBox.Font.Color := clWindowText;
ServerEditBox.Font.Height := -13;
ServerEditBox.ParentFont := False;
ServerEditBox.TabOrder := 4;
ServerEditBox.Text := default_irc_server;
PortEditBox := TEdit.Create(GroupBox1);
PortEditBox.Parent := GroupBox1;
PortEditBox.Left := 96;
PortEditBox.Top := 88;
PortEditBox.Width := 217;
PortEditBox.Height := 24;
PortEditBox.Font.Color := clWindowText;
PortEditBox.Font.Height := -13;
PortEditBox.ParentFont := False;
PortEditBox.TabOrder := 3;
PortEditBox.Text := default_irc_port;
RealnameEditBox := TEdit.Create(GroupBox1);
RealnameEditBox.Parent := GroupBox1;
RealnameEditBox.Left := 96;
RealnameEditBox.Top := 152;
RealnameEditBox.Width := 217;
RealnameEditBox.Height := 24;
RealnameEditBox.Font.Color := clWindowText;
RealnameEditBox.Font.Height := -13;
RealnameEditBox.ParentFont := False;
RealnameEditBox.TabOrder := 0;
RealnameEditBox.Text := default_irc_realname;
UsernameEditBox := TEdit.Create(GroupBox1);
UsernameEditBox.Parent := GroupBox1;
UsernameEditBox.Left := 96;
UsernameEditBox.Top := 120;
UsernameEditBox.Width := 217;
UsernameEditBox.Height := 24;
UsernameEditBox.Font.Color := clWindowText;
UsernameEditBox.Font.Height := -13;
UsernameEditBox.ParentFont := False;
UsernameEditBox.TabOrder := 2;
UsernameEditBox.Text := default_irc_username;
PasswordEditBox := TEdit.Create(GroupBox1);
PasswordEditBox.Parent := GroupBox1;
PasswordEditBox.Left := 96;
PasswordEditBox.Top := 184;
PasswordEditBox.Width := 217;
PasswordEditBox.Height := 24;
PasswordEditBox.Font.Color := clWindowText;
PasswordEditBox.Font.Height := -13;
PasswordEditBox.ParentFont := False;
PasswordEditBox.TabOrder := 5;
PasswordEditBox.Text := default_irc_nickserv;
ConnectButton := TButton.Create(MainForm);
ConnectButton.Parent := ConfigPage;
ConnectButton.Left := 16;
ConnectButton.Top := 24;
ConnectButton.Width := 97;
ConnectButton.Height := 33;
ConnectButton.Caption := 'Connect';
ConnectButton.Font.Color := clWindowText;
ConnectButton.Font.Height := -21;
ConnectButton.Font.Style := [fsBold];
ConnectButton.ParentFont := False;
ConnectButton.TabOrder := 2;
ConnectButton.OnClick:= @ConnectButtonOnClick;
TimestampCheckbox := TCheckBox.Create(MainForm);
TimestampCheckbox.Parent := ConfigPage;
TimestampCheckbox.Left := 360;
TimestampCheckbox.Top := 72;
TimestampCheckbox.Width := 129;
TimestampCheckbox.Height := 17;
TimestampCheckbox.Caption := 'Use Timestamps';
TimestampCheckbox.Font.Color := clWindowText;
TimestampCheckbox.Font.Height := -13;
TimestampCheckbox.ParentFont := False;
TimestampCheckbox.TabOrder := 3;
NetworkTab:= TTabSheet.Create(MainForm);
NetworkTab.Caption:= 'Network';
NetworkTab.PageControl:= MainPageControl;
NetworkTab.OnShow:= @ChangeTabFromConfig;
NetworkTextArea := TRichEdit.Create(MainForm);
NetworkTextArea.Parent := NetworkTab;
NetworkTextArea.Left := 0;
NetworkTextArea.Top := 25;
NetworkTextArea.Width := 561;
NetworkTextArea.Height := 439;
NetworkTextArea.Align := alClient;
NetworkTextArea.Font.Color := clWindowText;
NetworkTextArea.Font.Size:= 12;
NetworkTextArea.ParentFont := False;
NetworkTextArea.TabOrder := 8;
NetworkTextArea.WordWrap:= True;
NetworkTextArea.ScrollBars:= ssVertical;
NetworkTextArea.HideScrollBars:= False;
NetworkTextArea.TabStop:= False;
NetworkTextArea.OnMouseUp:= @NetworkTextAreaOnMouseUp;
NetworkTextArea.OnKeyDown:= @TextAreaOnKeyDown;
Panel1 := TPanel.Create(MainForm);
Panel1.Parent := NetworkTab;
Panel1.Left := 0;
Panel1.Top := 464;
Panel1.Width := 654;
Panel1.Height := 26;
Panel1.Align := alBottom;
Panel1.BevelOuter := bvNone;
Panel1.TabOrder := 1;
NetworkInputEditBox := TEdit.Create(Panel1);
NetworkInputEditBox.Parent := Panel1;
NetworkInputEditBox.Left := 0;
NetworkInputEditBox.Top := 0;
NetworkInputEditBox.Width := MainForm.Width;
NetworkInputEditBox.Height := 24;
NetworkInputEditBox.Font.Color := clWindowText;
NetworkInputEditBox.Font.Height := -13;
NetworkInputEditBox.ParentFont := False;
NetworkInputEditBox.TabOrder := 0;
NetworkInputEditBox.OnKeyPress:= @InputEditBoxOnKeyPress;
//NetworkInputEditBox.OnKeyDown:= @InputEditBoxOnKeyDown;
Panel2 := TPanel.Create(MainForm);
Panel2.Parent := NetworkTab;
Panel2.Left := 0;
Panel2.Top := 0;
Panel2.Width := 654;
Panel2.Height := 25;
Panel2.Align := alTop;
Panel2.BevelOuter := bvNone;
Panel2.TabOrder := 3;
NetworkTopicEditBox := TEdit.Create(Panel2);
NetworkTopicEditBox.Parent := Panel2;
NetworkTopicEditBox.Left := 0;
NetworkTopicEditBox.Top := 0;
NetworkTopicEditBox.Width := MainForm.Width;
NetworkTopicEditBox.Height := 21;
NetworkTopicEditBox.TabOrder := 0;
NetworkTopicEditBox.TabStop:= False;
MainForm.OnResize:= @MainFormOnResize;
MainForm.Show;
end;
procedure CreateMainForm;
var
t: TVariantArray;
begin
ThreadSafeCall('UnsafeCreateMainForm', t);
end;
procedure UnsafeCreateChannelTab(chan_index: Integer);
var
Panel1, Panel2, Panel3: TPanel;
begin
channel_list[chan_index].Tab:= TTabSheet.Create(MainForm);
channel_list[chan_index].Tab.Caption:= channel_list[chan_index].name;
channel_list[chan_index].Tab.PageControl:= MainPageControl;
channel_list[chan_index].Tab.OnShow:= @ChangeTabFromConfig;
channel_list[chan_index].TextArea := TRichEdit.Create(MainForm);
channel_list[chan_index].TextArea.Parent := channel_list[chan_index].Tab;
channel_list[chan_index].TextArea.Left := 0;
channel_list[chan_index].TextArea.Top := 25;
channel_list[chan_index].TextArea.Width := 561;
channel_list[chan_index].TextArea.Height := 439;
channel_list[chan_index].TextArea.Align := alClient;
channel_list[chan_index].TextArea.Font.Color := clWindowText;
channel_list[chan_index].TextArea.Font.Size:= 12;
channel_list[chan_index].TextArea.ParentFont := False;
channel_list[chan_index].TextArea.TabOrder := 8;
channel_list[chan_index].TextArea.WordWrap:= True;
channel_list[chan_index].TextArea.ScrollBars:= ssVertical;
channel_list[chan_index].TextArea.HideScrollBars:= False;
channel_list[chan_index].TextArea.TabStop:= False;
channel_list[chan_index].TextArea.Lines.Add('Joined ' + channel_list[chan_index].name);
channel_list[chan_index].TextArea.OnMouseUp:= @TextAreaOnMouseUp;
channel_list[chan_index].TextArea.OnKeyDown:= @TextAreaOnKeyDown;
Panel1 := TPanel.Create(MainForm);
Panel1.Parent := channel_list[chan_index].Tab;
Panel1.Left := 0;
Panel1.Top := 464;
Panel1.Width := 654;
Panel1.Height := 26;
Panel1.Align := alBottom;
Panel1.BevelOuter := bvNone;
Panel1.Caption := '';
Panel1.TabOrder := 1;
channel_list[chan_index].InputEditBox := TEdit.Create(Panel1);
channel_list[chan_index].InputEditBox.Parent := Panel1;
channel_list[chan_index].InputEditBox.Left := 0;
channel_list[chan_index].InputEditBox.Top := 0;
channel_list[chan_index].InputEditBox.Width := MainForm.Width;
channel_list[chan_index].InputEditBox.Height := 24;
channel_list[chan_index].InputEditBox.Font.Color := clWindowText;
channel_list[chan_index].InputEditBox.Font.Height := -13;
channel_list[chan_index].InputEditBox.ParentFont := False;
channel_list[chan_index].InputEditBox.TabOrder := 0;
channel_list[chan_index].InputEditBox.OnKeyPress:= @InputEditBoxOnKeyPress;
//channel_list[chan_index].InputEditBox.OnKeyDown:= @InputEditBoxOnKeyDown;
Panel3 := TPanel.Create(MainForm);
Panel3.Parent := channel_list[chan_index].Tab;
Panel3.Left := 533;
Panel3.Top := 25;
Panel3.Width := 121;
Panel3.Height := 439;
Panel3.Align := alRight;
Panel3.BevelOuter := bvNone;
Panel3.Caption := 'Panel3';
Panel3.TabOrder := 3;
channel_list[chan_index].UserCountLabel := TLabel.Create(Panel3);
channel_list[chan_index].UserCountLabel.Parent := Panel3;
channel_list[chan_index].UserCountLabel.Left := 0;
channel_list[chan_index].UserCountLabel.Top := 0;
channel_list[chan_index].UserCountLabel.Width := 121;
channel_list[chan_index].UserCountLabel.Height := 25;
channel_list[chan_index].UserCountLabel.Align := alTop;
channel_list[chan_index].UserCountLabel.Alignment := taCenter;
channel_list[chan_index].UserCountLabel.Caption := '0 Total';
channel_list[chan_index].UserCountLabel.Font.Color := clWindowText;
channel_list[chan_index].UserCountLabel.Font.Height := -16;
channel_list[chan_index].UserCountLabel.Font.Style := [fsBold];
channel_list[chan_index].UserCountLabel.ParentFont := False;
channel_list[chan_index].NamesTextArea := TMemo.Create(MainForm);
channel_list[chan_index].NamesTextArea.Parent := Panel3;
channel_list[chan_index].NamesTextArea.Left := 0;
channel_list[chan_index].NamesTextArea.Top := 25;
channel_list[chan_index].NamesTextArea.Width := 121;
channel_list[chan_index].NamesTextArea.Height := 439;
channel_list[chan_index].NamesTextArea.Align := alRight;
channel_list[chan_index].NamesTextArea.Font.Size:= 12;
channel_list[chan_index].NamesTextArea.TabOrder := 2;
channel_list[chan_index].NamesTextArea.TabStop:= False;
channel_list[chan_index].NamesTextArea.ReadOnly:= True;
channel_list[chan_index].NamesTextArea.ScrollBars:= ssBoth;
channel_list[chan_index].NamesTextArea.WordWrap:= False;
Panel2 := TPanel.Create(MainForm);
Panel2.Parent := channel_list[chan_index].Tab;
Panel2.Left := 0;
Panel2.Top := 0;
Panel2.Width := 654;
Panel2.Height := 25;
Panel2.Align := alTop;
Panel2.BevelOuter := bvNone;
Panel2.TabOrder := 3;
channel_list[chan_index].TopicEditBox := TEdit.Create(Panel2);
channel_list[chan_index].TopicEditBox.Parent := Panel2;
channel_list[chan_index].TopicEditBox.Left := 0;
channel_list[chan_index].TopicEditBox.Top := 0;
channel_list[chan_index].TopicEditBox.Width := MainForm.Width;
channel_list[chan_index].TopicEditBox.Height := 21;
channel_list[chan_index].TopicEditBox.TabOrder := 0;
channel_list[chan_index].TopicEditBox.TabStop:= False;
MainPageControl.ActivePage:= channel_list[chan_index].Tab;
end;
procedure CreateChannelTab(chan_index: Integer);
var
t: TVariantArray;
begin
t:= [chan_index];
ThreadSafeCall('UnsafeCreateChannelTab', t);
end;
procedure UnsafeDisposeChannelTab(chan_index: Integer);
begin
channel_list[chan_index].Tab.Parent:= nil;
channel_list[chan_index].Tab.Free;
if(chan_index = 0)then
MainPageControl.ActivePage:= NetworkTab
else
MainPageControl.ActivePage:= channel_list[chan_index - 1].Tab;
end;
procedure DisposeChannelTab(chan_index: Integer);
var
t: TVariantArray;
begin
t:= [chan_index];
ThreadSafeCall('UnsafeDisposeChannelTab', t);
end;
procedure UnsafeSetMainFormCaption(Caption: string);
begin
MainForm.Caption:= main_form_caption + ': ' + Caption;
GetApplication.Title:= main_form_caption + ': ' + Caption;
end;
procedure SetMainFormCaption(Caption: string);
var
t: TVariantArray;
begin
t:= [Caption];
ThreadSafeCall('UnsafeSetMainFormCaption', t);
end;
procedure UnsafeUpdateNamesTextArea(chan_index: Integer);
var
f: Integer;
begin
channel_list[chan_index].UserCountLabel.Caption
:= IntToStr(GetArrayLength(channel_list[chan_index].users)) +' Total';
channel_list[chan_index].NamesTextArea.Lines.Clear;
for f:= 0 to High(channel_list[chan_index].users) do
channel_list[chan_index].NamesTextArea.Lines.Add(channel_list[chan_index].users[f].powers + channel_list[chan_index].users[f].name);
//TODO find a way to make scroll bars go to zero
//channel_list[chan_index].NamesTextArea.ScrollBy(-40, 0);
end;
procedure UpdateNamesTextArea(chan_index: Integer);
var
t: TVariantArray;
begin
t:= [chan_index];
ThreadSafeCall('UnsafeUpdateNamesTextArea', t);
end;
procedure UnsafeSetTopicEditBoxText(chan_index: Integer; Topic: string);
begin
channel_list[chan_index].TopicEditBox.Text:= Topic;
end;
procedure SetTopicEditBoxText(chan_index: Integer; Topic: string);
var
t: TVariantArray;
begin
t:= [chan_index, Topic];
ThreadSafeCall('UnsafeSetTopicEditBoxText', t);
end;
function UnsafeGetCurrentChannelIndex: Integer;
begin
Result:= MainPageControl.ActivePageIndex - 2;
end;
function GetCurrentChannelIndex: Integer;
var
t: TVariantArray;
begin
t:= [];
Result:= ThreadSafeCall('UnsafeGetCurrentChannelIndex', t);
end;
procedure UnsafeAddToNetworkText(Line: string; Color: Integer);
begin
NetworkTextArea.SelAttributes.Color:= NetworkTextArea.Font.Color;
if(Color <> no_color)then
NetworkTextArea.SelAttributes.Color:= Color;
if(TimestampCheckBox.Checked)then
Line:= MakeTimestamp + ' ' + Line;
NetworkTextArea.Lines.Add(Line);
if(NetworkTab.Caption[1] <> '*')and(UnsafeGetCurrentChannelIndex <> -1)then
NetworkTab.Caption:= '*' + NetworkTab.Caption;
end;
procedure AddToNetworkText(Line: string; Color: Integer);
var
t: TVariantArray;
begin
t:= [Line, Color];
ThreadSafeCall('UnsafeAddToNetworkText', t);
end;
procedure UnsafeAddToChannelText(chan_index: Integer; Line: string; Color: Integer);
begin
channel_list[chan_index].TextArea.SelAttributes.Color:= NetworkTextArea.Font.Color;
if(Color <> no_color)then
channel_list[chan_index].TextArea.SelAttributes.Color:= Color;
if(TimestampCheckBox.Checked)then
Line:= MakeTimestamp + ' ' + Line;
channel_list[chan_index].TextArea.Lines.Add(Line);
if(channel_list[chan_index].Tab.Caption[1] <> '*')and(UnsafeGetCurrentChannelIndex <> chan_index)then
if(is_highlight)then
begin
channel_list[chan_index].Tab.Caption:= '+' + channel_list[chan_index].Tab.Caption;
is_highlight:= False;
end
else
channel_list[chan_index].Tab.Caption:= '*' + channel_list[chan_index].Tab.Caption;
end;
procedure AddToChannelText(chan_index: Integer; Line: string; Color: Integer);
var
t: TVariantArray;
begin
t:= [chan_index, Line, Color];
ThreadSafeCall('UnsafeAddToChannelText', t);
end;
//guarentees it will be added without error
//used for things like NOTICE
procedure AddToAnyText(chan_index: Integer; Line: string; Color: Integer);
begin
if(chan_index > High(channel_list))or(chan_index < 0)then
chan_index:= GetCurrentChannelIndex;
if(chan_index > High(channel_list))or(chan_index < 0)then
AddToNetworkText(line, Color)
else
AddToChannelText(chan_index, line, Color);
end;
//gui stuff above
//irc stuff below
var
prefix_modes, prefix_status: string; //ordered from least powerful to most
chan_mode_param, //channel mode always has a parameter
chan_mode_param_set, //only has a parameter when being set
chan_mode_no_param: string; //never has a parameter
var //needed for ctime()
days_of_week: array of string;
months_of_year: array of string;
function TimeToString(datetime: TDateTime): string;
var
year, month, day: word;
hour, min, sec, msec: word;
begin
DecodeDate(datetime, year, month, day);
DecodeTime(datetime, hour, min, sec, msec);
Result:= days_of_week[DayOfWeek(datetime) - 1] + ' ' + IntToStr(day)
+ ' ' + months_of_year[month - 1] + ' ' + IntToStr(year) + ' ' +
IntToStr(hour) + ':' + IntToStr(min) + ':' + IntToStr(sec);
end;
//almost equivalent of ctime() in <time.h> of the c standard library
function CTime(unixtime: LongInt): string;
begin //epic bug, doesnt change to local time, so its one hour more or less
Result:= TimeToString(UnixToDateTime(unixtime));
end;
function NextToken(var strtok: string; c: char): string;
var
f, strlen: Integer;
begin
strlen:= Length(strtok);
for f:= 1 to strlen do
if(strtok[f] = c)then
begin
Result:= Copy(strtok, 1, f-1);
strtok:= Copy(strtok, f + 1, strlen);
Exit;
end;
Result:= #0;
end;
//same as NextToken() but returns strtok if it doesnt contain c
//in other words, it never return #0
function NextTokenSafe(var strtok: string; c: char): string;
begin
Result:= strtok;
if(Pos(c, strtok) = 0)then
Exit;
Result:= NextToken(strtok, c);
end;
function IsNumber(s: string):boolean;
begin
try
StrToInt(s);
Result:= True;
except
Result:= False;
end
end;
function ReverseString(str: string): string;
var
i: Integer;
begin
Result:= '';
for i:= Length(str) downto 1 do
Result:= Result + str[i];
end;
//=0 if equal
//<0 if keyval < datum
//>0 if keyval > datum
function NameCompare(keyval, datum: string): Integer;
var
i, m, lk, ld: Integer;
begin
Result:= Pos(datum[1], prefix_status) - Pos(keyval[1], prefix_status);
if(Result <> 0)then //check for prefixes
Exit;
keyval:= Lowercase(keyval);
datum:= Lowercase(datum);
lk:= Length(keyval);
ld:= Length(datum);
m:= Min(lk, ld);
for i:= 1 to m do //compares ascii values to get alphabetical-ness
begin
Result:= Ord(keyval[i]) - Ord(datum[i]);
if(Result <> 0)then
Exit;
end;
//if we got to here, it means they both have the same first few letters
Result:= ld - lk; //shorter one goes first
//if that is zero, they have the same length and the same letters, in other words, equal
end;
function UserCompare(chan_index, keyval, datum: Integer): Integer;
begin
Result:= NameCompare(
channel_list[chan_index].users[keyval].powers + channel_list[chan_index].users[keyval].name,
channel_list[chan_index].users[datum].powers + channel_list[chan_index].users[datum].name);
end;
procedure QuickSortUsersArray(chan_index: Integer; iLo, iHi: Integer);
var //from wizzy plugin
Lo, Hi, Pivot: Integer;
T: User;
begin
Lo:= iLo;
Hi:= iHi;
Pivot:= (Lo + Hi) shr 1;
repeat
while(UserCompare(chan_index, Lo, Pivot) < 0)do Inc(Lo);
while(UserCompare(chan_index, Hi, Pivot) > 0)do Dec(Hi);
if(Lo <= Hi)then
begin
T:= channel_list[chan_index].users[Lo];
channel_list[chan_index].users[Lo]:= channel_list[chan_index].users[Hi];
channel_list[chan_index].users[Hi]:= T;
Inc(Lo);
Dec(Hi);
end;
until(Lo > Hi);
if(Hi > iLo)then QuickSortUsersArray(chan_index, iLo, Hi);
if(Lo < iHi)then QuickSortUsersArray(chan_index, Lo, iHi);
end;
procedure SortUsersArray(chan_index: Integer);
begin
QuickSortUsersArray(chan_index, 0, High(channel_list[chan_index].users));
end;
function UsersBinarySearch(key: string; chan_index, Lo, Hi: Integer): Integer;
var
middle, c: Integer;
midstr: string;
begin
while(Lo <= Hi)do
begin
middle:= (Lo + Hi) shr 1;
midstr:= channel_list[chan_index].users[middle].powers + channel_list[chan_index].users[middle].name;
c:= NameCompare(key, midstr);
if(c > 0)then Lo:= middle + 1 else
if(c < 0)then Hi:= middle - 1 else
begin Result:= middle; Exit; end;
end;
//didnt find key, return the negative of
//where it would go if you were to insert it
Result:= -Lo;
end;
//n.b. key has to be the powers concated with name eg. '@yakman_'
function BinarySearch(key: string; chan_index: Integer): Integer;
begin
Result:= UsersBinarySearch(key, chan_index, 0, High(channel_list[chan_index].users));
end;
procedure AddChannel(var newchan: Channel);
var
v: Integer;
begin
v:= GetArrayLength(channel_list);
SetArrayLength(channel_list, v + 1);
channel_list[v]:= newchan;
end;
procedure RemoveChannel(index: Integer);
var
i: Integer;
temp: array of Channel;
begin
SetArrayLength(temp, GetArrayLength(channel_list) - index - 1);
for i:= 0 to High(temp) do
temp[i]:= channel_list[i + index + 1];
SetArrayLength(channel_list, High(channel_list));
for i:= index to High(channel_list) do
channel_list[i]:= temp[i - index];
end;
function LookupChannel(name: string): Integer;
var
f: Integer;
begin
for f:=0 to High(channel_list) do
if(Lowercase(channel_list[f].name) = Lowercase(name))then
begin
Result:= f;
Exit;
end;
Result:= -1;
writeln('warning: failed to lookup channel name=''' + name + ''' [1]=' + IntToStr(Ord(name[1])));
end;
procedure AddUser(chan_index: Integer; var newuser: User);
var
v: Integer;
begin
v:= GetArrayLength(channel_list[chan_index].users);
SetArrayLength(channel_list[chan_index].users, v + 1);
channel_list[chan_index].users[v]:= newuser;
end;
procedure InsertUser(chan_index: Integer; var newuser: User);
var
v, i, l: Integer;
temp: array of User;
begin
v:= BinarySearch(newuser.powers + newuser.name, chan_index);
if(v >= 0)then writeln('warning: binarysearch returned positive');
v:= -v;
l:= GetArrayLength(channel_list[chan_index].users) - v;
SetArrayLength(temp, l);
if(l <> 0)then
for i:= 0 to High(temp) do
temp[i]:= channel_list[chan_index].users[i + v];
SetArrayLength(channel_list[chan_index].users, GetArrayLength(channel_list[chan_index].users) + 1);
channel_list[chan_index].users[v]:= newuser;
if(l <> 0)then
for i:= v+1 to High(channel_list[chan_index].users) do
channel_list[chan_index].users[i]:= temp[i - v - 1];
end;
procedure RemoveUser(chan_index: Integer; name: string);
var //have to use this linear search, because BinarySearch needs to know the users powers
f, i: Integer;
temp: array of User;
begin
for f:=0 to High(channel_list[chan_index].users) do
if(Lowercase(channel_list[chan_index].users[f].name) = Lowercase(name))then
begin
SetArrayLength(temp, GetArrayLength(channel_list[chan_index].users) - f - 1);
for i:=0 to High(temp) do
temp[i]:= channel_list[chan_index].users[i + f + 1];
SetArrayLength(channel_list[chan_index].users, High(channel_list[chan_index].users));
for i:=f to High(channel_list[chan_index].users) do
channel_list[chan_index].users[i]:= temp[i - f];
end;
end;
function LookupUser(chan_index: Integer; name: string): Integer;
var //have to use this linear search, because BinarySearch needs to know the users powers
f: Integer;
begin
for f:=0 to High(channel_list[chan_index].users) do
if(Lowercase(channel_list[chan_index].users[f].name) = Lowercase(name))then
begin
Result:= f;
Exit;
end;
Result:= -1;
writeln('warning: failed to lookup chanindex='
+ IntToStr(chan_index) + '=' + channel_list[chan_index].name + ' name=''' + name + '''');
end;
procedure CheckFirstColon(var str: string);
begin
if(str[1] = ':')then
Delete(str, 1, 1);
end;
procedure SendData(data: string);
begin
SendConnectionData(sock_fd, data + CRLF);
Writeln('=> ' + data);
end;
procedure HandleServerSupport(data: string);
var
datatok, token, key: string; //http://www.irc.org/tech_docs/005.html
begin //http://www.irc.org/tech_docs/draft-brocklesby-irc-isupport-03.txt
datatok:= data;
repeat
token:= NextToken(datatok, ' ');
if(token = #0)then break; //end of tokens
key:= NextToken(token, '='); //if this succeeds, it will be 'key=token' like 'CHANTYPES=#'
if(key = #0)then continue; //the parameter is present, but has no value, in this case, we'll just drop it
//some parameters are just not stored, things like CHANLIMIT, the server will enforce that for you
if(key = 'PREFIX')then
begin
//PREFIX=(ov)@+
Delete(token, 1, 1); //remove the first (
prefix_modes:= ReverseString(Copy(token, 1, Pos(')', token) - 1));
prefix_status:= ReverseString(Copy(token, Pos(')', token) + 1, Length(token)));
end else
if(key = 'CHANMODES')then
begin
//CHANMODES=bdeIq,k,lfJD,cgijLmnPQrRstz
chan_mode_param:= NextToken(token, ',') + NextToken(token, ',');
chan_mode_param_set:= NextToken(token, ',');
chan_mode_no_param:= token;
end else
if(key = 'NETWORK')then
begin
network_name:= token;
SetMainFormCaption(irc_nick + ' @ ' + network_name);
end;
until(False);
end;
//returns t if it should not be shown to the user
function HandleNumericCommand(nickuserhost, cmd, param, linetok: string): boolean;
var
channel, who, name, str1, str2: string;
i, c, p: Integer;
unixtime: Int64;
newuser: User;
begin //http://www.alien.net.au/irc/irc2numerics.html
Result:= False;
if(cmd = '005')then //RPL_ISUPPORT
begin
HandleServerSupport(linetok);
end else
if(cmd = '332')then //topic
begin
Result:= True;
channel:= NextToken(linetok, ' ');
CheckFirstColon(linetok);
c:= LookupChannel(channel);
str1:= 'Topic for ' + channel + ' is: ' + linetok;
if(param <> irc_nick)then
str1:= param + ' has changed topic for ' + channel + ' to: ' + linetok;
AddToChannelText(c, str1, clPurple);
SetTopicEditBoxText(c, linetok);
end else
if(cmd = '333')then //topic who time
begin
Result:= True;
channel:= NextToken(linetok, ' ');
who:= NextToken(linetok, ' ');
try
unixtime:= StrToInt64(linetok);
except
end
c:= LookupChannel(channel);
AddToChannelText(c, 'Topic for ' + channel + ' set by ' + who + ' at ' + CTime(unixtime), topic_color);
end else
if(cmd = '367')or(cmd = '348')or(cmd = '346')then //ban list, exception list, invite list
begin
Result:= True;
//:clarke.freenode.net 367 slurry_ #SRL *fap*!*@* Widget^!n=Administ@c-98-213-95-51.hsd1.il.comcast.net 1224309632
channel:= NextToken(linetok, ' ');
str1:= NextToken(linetok, ' '); //ban mask
str2:= NextToken(linetok, ' '); //setter
try
unixtime:= StrToInt64(linetok);
except
end
c:= LookupChannel(channel);
AddToChannelText(c, '* ' + channel + ': ' + CTime(unixtime) + ' ' + str1 + ' by ' + str2, banlist_color);
end else
if(cmd = '368')or(cmd = '349')or(cmd = '347')then //end of: ban list, exception list, invite list
begin
//:tolkien.freenode.net 368 yakman_ #SRL :End of Channel Ban List
channel:= NextToken(linetok, ' ');
CheckFirstColon(linetok);
c:= LookupChannel(channel);
AddToChannelText(c, '* ' + channel + ': ' + linetok, banlist_color);
end else
if(cmd = '353')then //names list
begin
Result:= True;
NextToken(linetok, ' '); //junk
channel:= NextToken(linetok, ' ');
c:= LookupChannel(channel);
CheckFirstColon(linetok);
repeat
name:= NextToken(linetok, ' ');
if(name = #0)then break;
str1:= ''; //the powers
for i:= 1 to Length(prefix_status) do
begin
p:= LastPos(prefix_status[i], name);
if(p > 0)then
begin
str1:= Copy(name, 1, p);
Delete(name, 1, p);
end
end;
newuser.name:= name;
newuser.powers:= str1;
AddUser(c, newuser);
until(False);
end else
if(cmd = '366')then //end of names list
begin
Result:= True;
channel:= NextToken(linetok, ' ');
c:= LookupChannel(channel);
unixtime:= GetTickCount;
SortUsersArray(c);
writeln('sorted in ' + inttostr(GetTickCount-unixtime) + 'msec');
UpdateNamesTextArea(c);
end
else
if(cmd = '328')then //channel url
begin
Result:= True;
channel:= NextToken(linetok, ' ');
c:= LookupChannel(channel);
CheckFirstColon(linetok);
AddToChannelText(c, '>' + channel + '< ' + linetok, no_color);
end else
if(cmd = '341')then //inviting
begin
//:heinlein.freenode.net 341 slurry_ yakman_ #slurry;
Result:= True;
who:= NextToken(linetok, ' ');
AddToAnyText(LookupChannel(linetok), '* Inviting ' + who + ' to ' + linetok, invite_color);
end
end;
function MakeVersionString: string;
begin
Result:= 'IScaRC' + Version + ' Scar' + IntToStr(GetSCARVersion);
end;
function CheckHighlight(line: string): boolean;
var
t: Integer;
str1: string;
begin
Result:= False;
for t:= -1 to highlight_list.Count-1 do
begin
if(t = -1)then
str1:= irc_nick
else
str1:= highlight_list.Strings[t];
if(Pos(str1, line) <> 0)then
begin
PlaySound(highlight_sound);
//if(not MainForm.Focused)then
FormHighlightingTimer.Enabled:= True;
is_highlight:= True;
Result:= True;
Exit;
end;
end;
end;
procedure HandleCTCP(nick, user, host, cmd, param, linetok: string);
var
request: string;
c: Integer;
begin
Delete(linetok, 1, 1);
request:= NextToken(linetok, #1);
if(StartsWith('ACTION', request))then
begin
c:= LookupChannel(param);
Delete(request, 1, 6);
AddToChannelText(c, '* ' + nick + request, slash_me_color);
Exit;
end
else
if(request = 'VERSION')then
SendData('NOTICE ' + nick + ' :' + #1 + 'VERSION ' + MakeVersionString + #1)
else
if(StartsWith('PING', request))then
SendData('NOTICE ' + nick + ' :' + #1 + request + #1)
else
if(request = 'TIME')then
SendData('NOTICE ' + nick + ' :' + #1 + 'TIME ' + TimeToString(now) + #1);
AddToAnyText(-1, '* Received CTCP ' + request + ' from ' + nick, ctcp_color);
end;
procedure ModeChanged(nick, user, host, chan: string; sign, mode: char; arg: string; has_arg, prefixed_mode: boolean);
var
m, c, u: Integer;
tt: integer;
temp: string;
begin
temp:= '* ' + nick + ' sets mode on ' + chan + ' ' + sign + mode;
if(has_arg)then
temp:= temp + ' ' + arg;
AddToAnyText(LookupChannel(chan), temp , mode_color);
if(prefixed_mode)then
begin
m:= Pos(mode, prefix_modes);
c:= LookupChannel(chan);
u:= LookupUser(c, arg); //arg is the nick that was opped
if(sign = '+')then
begin
tt:= pos(prefix_status[m], channel_list[c].users[u].powers);
if(tt <> 0)then
Exit; //already has it
temp:= channel_list[c].users[u].powers;
temp:= prefix_status[m] + temp;
channel_list[c].users[u].powers:= temp;
SortUsersArray(c);
UpdateNamesTextArea(c);
end
else
Delete(channel_list[c].users[u].powers, Pos(prefix_status[m], channel_list[c].users[u].powers), 1);
UpdateNamesTextArea(c);
end
end;
procedure HandleModeChange(nick, user, host, cmd, param, linetok: string);
var
modes, nextarg: string;
sign: char;
i: Integer;
begin
modes:= NextTokenSafe(linetok, ' ');
for i:= 1 to Length(modes) do
begin
if(modes[i] = '+')or(modes[i] = '-')then
begin
sign:= modes[i];
continue;
end;
if(Pos(modes[i], chan_mode_param) <> 0)then
begin
nextarg:= NextTokenSafe(linetok, ' ');
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, true, false);
continue;
end;
if(Pos(modes[i], chan_mode_param_set) <> 0)then
begin
nextarg:= #0
if(sign = '+')then
nextarg:= NextTokenSafe(linetok, ' ');
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, (nextarg <> #0), false);
continue;
end;
if(Pos(modes[i], chan_mode_no_param) <> 0)then
begin
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, false, false);
continue;
end;
if(Pos(modes[i], prefix_modes) <> 0)then
begin
nextarg:= NextTokenSafe(linetok, ' ');
ModeChanged(nick, user, host, param, sign, modes[i], nextarg, true, true);
continue;
end;
writeln('unknown mode ' + sign + modes[i]);
end
end;
procedure ParseIRCLine(line: string);
var
linetok: string;
nickuserhost, nuhtok: string;
nick, user, host: string;
cmd, param: string;
str1: string;
c: Integer;
newchan: Channel;
newuser: User;
t: integer;
begin
if(StartsWith('PING', line))then
begin
line[2] := 'O';
SendData(line);
Exit;
end;
linetok:= line;
nickuserhost:= NextToken(linetok, ' ');
if(nickuserhost[1] = ':')then
Delete(nickuserhost, 1, 1);
nuhtok:= nickuserhost;
nick:= NextToken(nuhtok, '!');
user:= NextToken(nuhtok, '@');
host:= nuhtok;
cmd:= NextToken(linetok, ' ');
param:= NextToken(linetok, ' ');
if(IsNumber(cmd))then
begin
if(HandleNumericCommand(nickuserhost, cmd, param, linetok))then
Exit; //dont show to user
CheckFirstColon(linetok);
//now add linetok to the network tab
AddToNetworkText(linetok, no_color);
end else
if(cmd = 'PRIVMSG')then
begin
CheckFirstColon(linetok);
if(linetok[1] = #1)then
begin
HandleCTCP(nick, user, host, cmd, param, linetok);
Exit;
end;
c:= LookupChannel(param);
if(CheckHighlight(linetok))then
AddToAnyText(c, '<' + nick + '> ' + linetok, highlight_color)
else
AddToAnyText(c, '<' + nick + '> ' + linetok, no_color);
//TODO have an /ignore feature
end else
if(Pos('NOTICE AUTH', line) <> 0)then
begin
NextToken(line, ':');
AddToNetworkText(line, no_color)
end else
if(cmd = 'NOTICE')then
begin
CheckFirstColon(linetok);
if(linetok[1] = #1)then
begin
if(StartsWith(#1 + 'PING', linetok))then
begin
Delete(linetok, 1, 6);
str1:= NextToken(linetok, #1);
AddToAnyText(-1, '* Ping reply from ' + nick + ': ' + FloatToStr((GetTickCount-StrToIntDef(str1, 0)) / 1000.0) + ' seconds[s]', ctcp_color);
Exit;
end
end;
if(param <> irc_nick)then
nick:= nick + '/' + param;
c:= no_color;
if(CheckHighlight(linetok))then
c:= highlight_color;
AddToAnyText(LookupChannel(param), '>' + nick + '< ' + linetok, c);
end else
if(cmd = 'NICK')then
begin
//:slurry_!n=username@93-97-94-194.zone5.bethere.co.uk NICK :hi-there
CheckFirstColon(linetok);
if(nick = irc_nick)then //we changed our nick
begin
irc_nick:= linetok;
str1:= '* You are now known at ' + irc_nick;
end
else
str1:= '* ' + nick + ' is now known as ' + linetok;
for c:= 0 to High(channel_list) do
begin
t:= LookupUser(c, nick);
if(t = -1)then
continue;
channel_list[c].users[t].name:= linetok;
AddToChannelText(c, str1, nick_color);
SortUsersArray(c);
UpdateNamesTextArea(c);
end
end else
if(cmd = 'JOIN')then
begin
//linetok is the joined channel
CheckFirstColon(linetok);
if(nick = irc_nick)then //we joined a chan
begin
newchan.name:= linetok;
AddChannel(newchan);
CreateChannelTab(High(channel_list));
Exit;
end;
//someone else joined the chan
c:= LookupChannel(linetok);
AddToChannelText(c, '* ' + nick + '!' + user + '@' + host + ' has joined ' + linetok, join_color);
newuser.name:= nick;
newuser.powers:= '';
InsertUser(c, newuser);
SortUsersArray(c);
UpdateNamesTextArea(c);
end else
if(cmd = 'PART')then
begin
//:Markus92!n=a@unaffiliated/markus92 PART #SRL :reason goes here
CheckFirstColon(linetok);
c:= LookupChannel(param);
if(nick = irc_nick)then //we parted a chan
begin
DisposeChannelTab(c);
RemoveChannel(c);
Exit;
end;
AddToChannelText(c, '* ' + nick + '!' + user + '@' + host + ' has parted ' + param + ' (' + linetok + ')', part_color);
RemoveUser(c, nick);
SortUsersArray(c);
UpdateNamesTextArea(c);
end else
if(cmd = 'KICK')then
begin
//:yakman_!n=user@93-97-94-194.zone5.bethere.co.uk KICK #srl yakman_ :reason goes here
str1:= NextToken(linetok, ' '); //kicked nick
CheckFirstColon(linetok);
if(str1 = irc_nick)then //we got kicked
begin
c:= LookupChannel(param);
DisposeChannelTab(c);
RemoveChannel(c);
AddToNetworkText('* You have been kicked from ' + param + ' by ' + nick + ' (' + linetok + ')', kick_color);
if(autorejoin)then
SendData('JOIN ' + param);
Exit;
end;
AddToChannelText(c, '* ' + nick + ' has kicked ' + str1 + ' from ' + param + ' (' + linetok + ')', kick_color);
c:= LookupChannel(param);
RemoveUser(c, str1);
SortUsersArray(c);
UpdateNamesTextArea(c);
end else
if(cmd = 'QUIT')then
begin
//:Mrkus872!n=Mrkus@82.176.13.70 QUIT :Remote closed the connection
CheckFirstColon(linetok);
for c:= 0 to High(channel_list) do
begin //TODO bug here, sends to channels even if not on
AddToChannelText(c, '* ' + nick + '!' + user + '@' + host + ' has quit (' + linetok + ')', quit_color);
RemoveUser(c, nick);
SortUsersArray(c);
end
end else
if(cmd = 'MODE')then
begin
if(nick <> #0)then
HandleModeChange(nick, user, host, cmd, param, linetok)
else
HandleModeChange(nickuserhost, '', '', cmd, param, linetok)
end else
if(cmd = 'INVITE')then
begin
//:yakman_!n=user@93-97-94-194.zone5.bethere.co.uk INVITE slurry_ :#srl
CheckFirstColon(linetok);
AddToAnyText(-1, '* You have been invited to ' + linetok + ' by ' + nick, invite_color);
end else
if(cmd = 'TOPIC')then
begin
HandleNumericCommand(nickuserhost, '332', nick, param + ' ' + linetok);
end else
//dont know what it is? just post
AddToNetworkText(line, no_color);
end;
procedure FillBuffer;
var
incoming: string;
begin
ReadConnectionData(sock_fd, incoming);
buffer:= Copy(buffer, buf_pos, buf_len) + incoming;
buf_pos:= 1;
buf_len:= Length(buffer);
end;
function ReadNextLine: string;
var
f, oldPos: Integer;
begin
repeat
oldPos:= buf_pos;
for f:= buf_pos to buf_len-1 do
if(buffer[f] = #13)or(buffer[f] = #10)then
begin
buf_pos:= f + 1;
if(buffer[buf_pos] = #13)or(buffer[buf_pos] = #10)then
buf_pos:= buf_pos + 1;
Result:= Copy(buffer, oldPos, f - oldPos);
Exit;
end;
//newline not found in buffer
FillBuffer;
until(False); //hopefully this wont be abused
end;
function StartupIRC(host: string; port: Integer): boolean;
begin
Result:= True;
sock_fd:= OpenConnection(host, port, 10000);
if(sock_fd < 0)then
begin
Result:= False;
Exit;
end;
//set defaults
prefix_modes:= default_prefix_modes;
prefix_status:= default_prefix_status;
chan_mode_param:= default_chan_mode_param;
chan_mode_param_set:= default_chan_mode_param_set;
chan_mode_no_param:= default_chan_mode_no_param;
highlight_list:= TStringList.Create;
SendData('USER ' + irc_username + ' * * :' + irc_realname);
SendData('NICK ' + irc_nick);
if(irc_nickserv <> '')then
SendData('PRIVMSG NickServ :identify ' + irc_nickserv);
FillBuffer;
end;
procedure Init;
begin
days_of_week:= ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'];
months_of_year:= ['Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
'Aug', 'Sep', 'Oct', 'Nov', 'Dec'];
sock_fd:= -1;
end;
procedure Main;
var
line: string;
begin
Init;
//TODO minimse the main scar window here, and restore it when you close the main irc form
CreateMainForm;
repeat
if(irc_server = '')then
begin //waiting for user to click connect
if(sock_fd <> -1)then
try
FreeConnection(sock_fd);
except
writeln('error in freeing fd = ' + inttostr(sock_fd));
end;
Continue;
end
else
begin //we can do socket
if(sock_fd = -1)then //need to connect
begin
network_name:= irc_server;
SetMainFormCaption(irc_nick + ' @ ' + network_name);
if(not StartupIRC(irc_server, irc_port))then
begin
writeln('failed to connect');
irc_server:= '';
continue;
end;
end;
line:= ReadNextLine;
writeln('<= ' + line + ';');
ParseIRCLine(line);
end;
//TODO when you close the form, and have a socket open
//it takes ages to unblock and close
Sleep(10);
until(not MainForm.Showing);
if(sock_fd <> -1)then
try
FreeConnection(sock_fd);
except
writeln('error in freeing');
end;
sock_fd:= -1;
FreeForm(MainForm);
end;
begin
Main;
end.