elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Curso de javascript por TickTack


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  [Delphi] IRC Manager 0.3
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Delphi] IRC Manager 0.3  (Leído 2,123 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Delphi] IRC Manager 0.3
« en: 20 Agosto 2016, 00:29 am »

Un simple cliente para chatear en el IRC.

Una imagen :



El codigo :

Código
  1. // IRC Manager 0.3
  2. // (C) Doddy Hackman 2016
  3.  
  4. unit irc;
  5.  
  6. interface
  7.  
  8. uses
  9.  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  10.  System.Classes, Vcl.Graphics,
  11.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Menus,
  12.  Vcl.Imaging.pngimage, Vcl.ExtCtrls, IdContext, IdBaseComponent, IdComponent,
  13.  IdTCPConnection, IdTCPClient, IdCmdTCPClient, IdIRC, PerlRegex, MMSystem,
  14.  Vcl.ImgList, Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
  15.  Vcl.Styles.Utils.SysStyleHook,
  16.  Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  17.  Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips;
  18.  
  19. type
  20.  TFormHome = class(TForm)
  21.    status: TStatusBar;
  22.    gbIRC_Config: TGroupBox;
  23.    lblHost: TLabel;
  24.    txtHost: TEdit;
  25.    lblPort: TLabel;
  26.    txtPort: TEdit;
  27.    lblChannel: TLabel;
  28.    txtChannel: TEdit;
  29.    lblNick: TLabel;
  30.    gbChat: TGroupBox;
  31.    gbNicks: TGroupBox;
  32.    lbNicks: TListBox;
  33.    txtNickname: TEdit;
  34.    btnConnect: TButton;
  35.    gbEnterText: TGroupBox;
  36.    txtText: TEdit;
  37.    btnSend: TButton;
  38.    logo: TImage;
  39.    mmChat: TRichEdit;
  40.    irc: TIdIRC;
  41.    ilIconos: TImageList;
  42.    procedure btnConnectClick(Sender: TObject);
  43.    procedure ircRaw(ASender: TIdContext; AIn: Boolean; const AMessage: string);
  44.    procedure btnSendClick(Sender: TObject);
  45.    procedure ircPrivateMessage(ASender: TIdContext;
  46.      const ANickname, AHost, ATarget, AMessage: string);
  47.    procedure ircNotice(ASender: TIdContext; const ANickname, AHost, ATarget,
  48.      ANotice: string);
  49.    procedure ircJoin(ASender: TIdContext;
  50.      const ANickname, AHost, AChannel: string);
  51.    procedure ircPart(ASender: TIdContext; const ANickname, AHost, AChannel,
  52.      APartMessage: string);
  53.    procedure ircQuit(ASender: TIdContext;
  54.      const ANickname, AHost, AReason: string);
  55.    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  56.    procedure FormCreate(Sender: TObject);
  57.  private
  58.    { Private declarations }
  59.  public
  60.    { Public declarations }
  61.    logs_messages: Boolean;
  62.  end;
  63.  
  64. var
  65.  FormHome: TFormHome;
  66.  
  67. implementation
  68.  
  69. {$R *.dfm}
  70.  
  71. procedure TFormHome.btnConnectClick(Sender: TObject);
  72. begin
  73.  if (btnConnect.Caption = 'Connect') then
  74.  begin
  75.  
  76.    irc.nickname := txtNickname.text;
  77.    irc.AltNickname := txtNickname.text + '123';
  78.    irc.Username := txtNickname.text;
  79.    irc.RealName := txtNickname.text;
  80.    irc.Password := '';
  81.    irc.host := txtHost.text;
  82.    irc.port := StrToInt(txtPort.text);
  83.  
  84.    mmChat.Lines.Clear;
  85.    lbNicks.Items.Clear;
  86.    logs_messages := False;
  87.  
  88.    try
  89.      begin
  90.        mmChat.Lines.Add('Connecting ...');
  91.        irc.connect;
  92.        irc.Join(txtChannel.text);
  93.        btnConnect.Caption := 'Disconnect';
  94.        status.Panels[0].text := '[+] Connected';
  95.        FormHome.status.Update;
  96.        mmChat.Lines.Add('Connected !');
  97.      end;
  98.    except
  99.      begin
  100.        status.Panels[0].text := '[-] Error connecting to server';
  101.        FormHome.status.Update;
  102.        mmChat.Lines.Add('Error connecting to server !');
  103.        MessageBox(0, 'Error connecting to server', 'IRC Manager 1.0',
  104.          MB_ICONERROR);
  105.      end;
  106.    end;
  107.  end
  108.  else
  109.  begin
  110.    if (btnConnect.Caption = 'Disconnect') then
  111.    begin
  112.      irc.Part('');
  113.      irc.Disconnect('');
  114.      btnConnect.Caption := 'Connect';
  115.      status.Panels[0].text := '[+] Disconnected';
  116.      FormHome.status.Update;
  117.      mmChat.Lines.Add('Disconnected !');
  118.    end;
  119.  end;
  120.  
  121. end;
  122.  
  123. procedure TFormHome.btnSendClick(Sender: TObject);
  124. begin
  125.  if not(txtText.text = '') then
  126.  begin
  127.    irc.Say(txtChannel.text, txtText.text);
  128.    mmChat.Lines.Add('<' + txtNickname.text + '> ' + txtText.text);
  129.    txtText.text := '';
  130.  end;
  131. end;
  132.  
  133. procedure TFormHome.FormClose(Sender: TObject; var Action: TCloseAction);
  134. begin
  135.  if mrYes = MessageDlg('Close program ?', mtwarning, [mbYes, mbNo], 0) then
  136.  begin
  137.    Exit;
  138.  end
  139.  else
  140.  begin
  141.    Action := caNone;
  142.  end;
  143. end;
  144.  
  145. procedure TFormHome.FormCreate(Sender: TObject);
  146. begin
  147.  UseLatestCommonDialogs := False;
  148. end;
  149.  
  150. procedure TFormHome.ircJoin(ASender: TIdContext;
  151.  const ANickname, AHost, AChannel: string);
  152. begin
  153.  lbNicks.Items.Add(ANickname);
  154.  mmChat.Lines.Add(ANickname + ' has joined');
  155. end;
  156.  
  157. procedure TFormHome.ircNotice(ASender: TIdContext;
  158.  const ANickname, AHost, ATarget, ANotice: string);
  159. begin
  160.  // chat.Lines.Add('<' + ANickname + '> ' + ANotice);
  161. end;
  162.  
  163. procedure TFormHome.ircPart(ASender: TIdContext;
  164.  const ANickname, AHost, AChannel, APartMessage: string);
  165. begin
  166.  lbNicks.Items.Delete(lbNicks.Items.IndexOf(ANickname));
  167.  mmChat.Lines.Add(ANickname + ' part');
  168. end;
  169.  
  170. procedure TFormHome.ircPrivateMessage(ASender: TIdContext;
  171.  const ANickname, AHost, ATarget, AMessage: string);
  172. var
  173.  check_regex: TPerlRegex;
  174. begin
  175.  
  176.  check_regex := TPerlRegex.Create();
  177.  
  178.  check_regex.regex := txtNickname.text;
  179.  check_regex.Subject := AMessage;
  180.  check_regex.Options := [preCaseLess];
  181.  
  182.  if check_regex.Match then
  183.  begin
  184.    mmChat.SelAttributes.Color := clRed;
  185.    mmChat.SelAttributes.Style := [fsBold];
  186.    mmChat.Lines.Add('* <' + ANickname + '> ' + AMessage);
  187.    sndPlaySound(Pchar(GetCurrentDir + '/Data/click.wav'), SND_NODEFAULT);
  188.  end
  189.  else
  190.  begin
  191.    mmChat.Lines.Add('<' + ANickname + '> ' + AMessage);
  192.  end;
  193.  
  194.  check_regex.Free;
  195.  
  196. end;
  197.  
  198. procedure TFormHome.ircQuit(ASender: TIdContext;
  199.  const ANickname, AHost, AReason: string);
  200. begin
  201.  lbNicks.Items.Delete(lbNicks.Items.IndexOf(ANickname));
  202.  mmChat.Lines.Add(ANickname + ' quit');
  203. end;
  204.  
  205. procedure TFormHome.ircRaw(ASender: TIdContext; AIn: Boolean;
  206.  const AMessage: string);
  207. var
  208.  i: integer;
  209.  code: string;
  210.  renicks: string;
  211.  listanow: TStringList;
  212.  regex: TPerlRegex;
  213.  otroregex: TPerlRegex;
  214.  nick: string;
  215.  texto: string;
  216. begin
  217.  
  218.  code := AMessage;
  219.  
  220.  if (logs_messages = True) then
  221.  begin
  222.    mmChat.Lines.Add(code);
  223.  end;
  224.  
  225.  regex := TPerlRegex.Create();
  226.  otroregex := TPerlRegex.Create();
  227.  
  228.  regex.regex := '353 (.*) = #(.*) :(.*)';
  229.  regex.Subject := code;
  230.  
  231.  if regex.Match then
  232.  begin
  233.  
  234.    lbNicks.Clear;
  235.  
  236.    renicks := regex.Groups[3];
  237.  
  238.    renicks := StringReplace(renicks, txtNickname.text, '', []);
  239.  
  240.    listanow := TStringList.Create;
  241.    listanow.Delimiter := ' ';
  242.    listanow.DelimitedText := renicks;
  243.  
  244.    for i := 0 to listanow.Count - 1 do
  245.    begin
  246.      if not(listanow[i] = '@') then
  247.      begin
  248.        lbNicks.Items.Add(listanow[i]);
  249.      end;
  250.    end;
  251.  
  252.    lbNicks.Items.Add(txtNickname.text);
  253.  
  254.    logs_messages := False;
  255.  
  256.  end;
  257.  
  258.  otroregex.regex := 'PRIVMSG (.*) :ACTION (.*)';
  259.  otroregex.Subject := code;
  260.  
  261.  if otroregex.Match then
  262.  begin
  263.    nick := otroregex.Groups[1];
  264.    texto := otroregex.Groups[2];
  265.    mmChat.Lines.Add('* ' + texto);
  266.  end;
  267.  
  268.  regex.Free;
  269.  otroregex.Free;
  270.  
  271. end;
  272.  
  273. end.
  274.  
  275. // The End ?
  276.  

Si quieren bajar el programa lo pueden hacer de aca.


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[Delphi] DH PasteBin Manager 0.2
Programación General
BigBear 0 2,260 Último mensaje 18 Octubre 2013, 18:00 pm
por BigBear
[Delphi] PirateBay Manager 0.8
Programación General
BigBear 3 2,657 Último mensaje 20 Febrero 2014, 21:48 pm
por cron0ar8R
[Delphi] DH Server Manager 0.3
Programación General
BigBear 0 1,850 Último mensaje 24 Abril 2015, 17:25 pm
por BigBear
[Delphi] FTP Manager 1.0
Programación General
BigBear 1 2,483 Último mensaje 7 Agosto 2016, 01:32 am
por + 1 Oculto(s)
[Delphi] DH Database Manager 0.8
Programación General
BigBear 0 2,259 Último mensaje 30 Enero 2017, 02:42 am
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines