Una imagen :
El codigo :
// IRC Manager 0.3
// (C) Doddy Hackman 2016
unit irc;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Menus,
Vcl.Imaging.pngimage, Vcl.ExtCtrls, IdContext, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdCmdTCPClient, IdIRC, PerlRegex, MMSystem,
Vcl.ImgList, Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
Vcl.Styles.Utils.SysStyleHook,
Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips;
type
TFormHome = class(TForm)
status: TStatusBar;
gbIRC_Config: TGroupBox;
lblHost: TLabel;
txtHost: TEdit;
lblPort: TLabel;
txtPort: TEdit;
lblChannel: TLabel;
txtChannel: TEdit;
lblNick: TLabel;
gbChat: TGroupBox;
gbNicks: TGroupBox;
lbNicks: TListBox;
txtNickname: TEdit;
btnConnect: TButton;
gbEnterText: TGroupBox;
txtText: TEdit;
btnSend: TButton;
logo: TImage;
mmChat: TRichEdit;
irc: TIdIRC;
ilIconos: TImageList;
procedure btnConnectClick(Sender: TObject);
procedure ircRaw(ASender: TIdContext; AIn: Boolean; const AMessage: string);
procedure btnSendClick(Sender: TObject);
procedure ircPrivateMessage(ASender: TIdContext;
const ANickname, AHost, ATarget, AMessage: string);
procedure ircNotice(ASender: TIdContext; const ANickname, AHost, ATarget,
ANotice: string);
procedure ircJoin(ASender: TIdContext;
const ANickname, AHost, AChannel: string);
procedure ircPart(ASender: TIdContext; const ANickname, AHost, AChannel,
APartMessage: string);
procedure ircQuit(ASender: TIdContext;
const ANickname, AHost, AReason: string);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
logs_messages: Boolean;
end;
var
FormHome: TFormHome;
implementation
{$R *.dfm}
procedure TFormHome.btnConnectClick(Sender: TObject);
begin
if (btnConnect.Caption = 'Connect') then
begin
irc.nickname := txtNickname.text;
irc.AltNickname := txtNickname.text + '123';
irc.Username := txtNickname.text;
irc.RealName := txtNickname.text;
irc.Password := '';
irc.host := txtHost.text;
irc.port := StrToInt(txtPort.text);
mmChat.Lines.Clear;
lbNicks.Items.Clear;
logs_messages := False;
try
begin
mmChat.Lines.Add('Connecting ...');
irc.connect;
irc.Join(txtChannel.text);
btnConnect.Caption := 'Disconnect';
status.Panels[0].text := '[+] Connected';
FormHome.status.Update;
mmChat.Lines.Add('Connected !');
end;
except
begin
status.Panels[0].text := '[-] Error connecting to server';
FormHome.status.Update;
mmChat.Lines.Add('Error connecting to server !');
MessageBox(0, 'Error connecting to server', 'IRC Manager 1.0',
MB_ICONERROR);
end;
end;
end
else
begin
if (btnConnect.Caption = 'Disconnect') then
begin
irc.Part('');
irc.Disconnect('');
btnConnect.Caption := 'Connect';
status.Panels[0].text := '[+] Disconnected';
FormHome.status.Update;
mmChat.Lines.Add('Disconnected !');
end;
end;
end;
procedure TFormHome.btnSendClick(Sender: TObject);
begin
if not(txtText.text = '') then
begin
irc.Say(txtChannel.text, txtText.text);
mmChat.Lines.Add('<' + txtNickname.text + '> ' + txtText.text);
txtText.text := '';
end;
end;
procedure TFormHome.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if mrYes = MessageDlg('Close program ?', mtwarning, [mbYes, mbNo], 0) then
begin
Exit;
end
else
begin
Action := caNone;
end;
end;
procedure TFormHome.FormCreate(Sender: TObject);
begin
UseLatestCommonDialogs := False;
end;
procedure TFormHome.ircJoin(ASender: TIdContext;
const ANickname, AHost, AChannel: string);
begin
lbNicks.Items.Add(ANickname);
mmChat.Lines.Add(ANickname + ' has joined');
end;
procedure TFormHome.ircNotice(ASender: TIdContext;
const ANickname, AHost, ATarget, ANotice: string);
begin
// chat.Lines.Add('<' + ANickname + '> ' + ANotice);
end;
procedure TFormHome.ircPart(ASender: TIdContext;
const ANickname, AHost, AChannel, APartMessage: string);
begin
lbNicks.Items.Delete(lbNicks.Items.IndexOf(ANickname));
mmChat.Lines.Add(ANickname + ' part');
end;
procedure TFormHome.ircPrivateMessage(ASender: TIdContext;
const ANickname, AHost, ATarget, AMessage: string);
var
check_regex: TPerlRegex;
begin
check_regex := TPerlRegex.Create();
check_regex.regex := txtNickname.text;
check_regex.Subject := AMessage;
check_regex.Options := [preCaseLess];
if check_regex.Match then
begin
mmChat.SelAttributes.Color := clRed;
mmChat.SelAttributes.Style := [fsBold];
mmChat.Lines.Add('* <' + ANickname + '> ' + AMessage);
sndPlaySound(Pchar(GetCurrentDir + '/Data/click.wav'), SND_NODEFAULT);
end
else
begin
mmChat.Lines.Add('<' + ANickname + '> ' + AMessage);
end;
check_regex.Free;
end;
procedure TFormHome.ircQuit(ASender: TIdContext;
const ANickname, AHost, AReason: string);
begin
lbNicks.Items.Delete(lbNicks.Items.IndexOf(ANickname));
mmChat.Lines.Add(ANickname + ' quit');
end;
procedure TFormHome.ircRaw(ASender: TIdContext; AIn: Boolean;
const AMessage: string);
var
i: integer;
code: string;
renicks: string;
listanow: TStringList;
regex: TPerlRegex;
otroregex: TPerlRegex;
nick: string;
texto: string;
begin
code := AMessage;
if (logs_messages = True) then
begin
mmChat.Lines.Add(code);
end;
regex := TPerlRegex.Create();
otroregex := TPerlRegex.Create();
regex.regex := '353 (.*) = #(.*) :(.*)';
regex.Subject := code;
if regex.Match then
begin
lbNicks.Clear;
renicks := regex.Groups[3];
renicks := StringReplace(renicks, txtNickname.text, '', []);
listanow := TStringList.Create;
listanow.Delimiter := ' ';
listanow.DelimitedText := renicks;
for i := 0 to listanow.Count - 1 do
begin
if not(listanow[i] = '@') then
begin
lbNicks.Items.Add(listanow[i]);
end;
end;
lbNicks.Items.Add(txtNickname.text);
logs_messages := False;
end;
otroregex.regex := 'PRIVMSG (.*) :ACTION (.*)';
otroregex.Subject := code;
if otroregex.Match then
begin
nick := otroregex.Groups[1];
texto := otroregex.Groups[2];
mmChat.Lines.Add('* ' + texto);
end;
regex.Free;
otroregex.Free;
end;
end.
// The End ?
Si quieren bajar el programa lo pueden hacer de [Enlace externo eliminado para invitados].