Delphi [Delphi] IRC Manager 0.3

[Doddy]

Un simple cliente para chatear en el IRC.

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 [HIDE-THANKS]

This link is hidden for visitors. Please Log in or register now.

[/HIDE-THANKS].