Una imagen :
El codigo :
Código
// 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 aca.