[Delphi] IRC Manager 0.3

[BigBear]

Un simple cliente para chatear en el IRC.

Una imagen :



El codigo :

Código (delphi) [Seleccionar] Expandir


// 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.