unit uMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, CICIdIRC, Forms, Controls,
  Graphics, Dialogs, StdCtrls, Registry, Windows, IdContext;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnConnect: TButton;
    btnChannelJoin: TButton;
    btnNickChange: TButton;
    btnDisconnect: TButton;
    Button1: TButton;
    btnPostMessage: TButton;
    edtTextToSend: TEdit;
    edtNick: TEdit;
    edtChannel: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    //IdIRC1: TCICIdIRC;
    lblInfo: TLabel;
    lbxUsers: TListBox;
    Memo1: TMemo;
    memChannelText: TMemo;
    procedure btnChannelJoinClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure btnNickChangeClick(Sender: TObject);
    procedure btnPostMessageClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure edtNickKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure edtTextToSendKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IdIRC1AdminInfoReceived(ASender: TIdContext;
      AAdminInfo: TStrings);
    procedure IdIRC1Disconnected(Sender: TObject);
    procedure IdIRC1JoinEvent(ASender: TIdContext; const ANickname, AHost, AChannel: String);
    procedure IdIRC1PartEvent(ASender: TIdContext; const ANickname, AHost, AChannel, APartMessage: String);
    procedure IdIRC1QuitEvent(ASender: TIdContext; const ANickname, AHost, AReason: String);
    procedure IdIRC1PrivateMessage(ASender: TIdContext; const ANickname, AHost,
      ATarget, AMessage: String);
    function IdIRC1CTCPQry(ASender: TIdContext; const ANickname, AHost,
      ATarget, ACommand, AParams: String): boolean;
    procedure IdIRC1Raw(ASender: TIdContext; AIn: Boolean;
      const AMessage: String);
  private
    { private declarations }
    IdIRC1: TCICIdIRC;
    procedure SaveUserDataToReg;
    procedure LoadUserDataFromReg;
    function  Connect2IRC: Boolean;
    function  Connect2IRCOne(strServer: String): Boolean;
    function GetVersion : string;
  public
    { Public declarations }
    strLastPrivateMessage: string;
    blnAutoUpdRan: boolean;
    blnFirstRun: boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

{*** Extracts the Delphi project version information ***}
function TForm1.GetVersion : string;
{ ---------------------------------------------------------
   Extracts the FileVersion element of the VERSIONINFO
   structure that Delphi maintains as part of a project's
   options.

   Results are returned as a standard string.  Failure
   is reported as "".

   Note that this implementation was derived from similar
   code used by Delphi to validate ComCtl32.dll.  For
   details, see COMCTRLS.PAS, line 3541.
  -------------------------------------------------------- }
const
   NOVIDATA = '';

var
  dwInfoSize,           // Size of VERSIONINFO structure
  dwVerSize,            // Size of Version Info Data
  dwWnd: DWORD;         // Handle for the size call.
  FI: PVSFixedFileInfo; // Delphi structure; see WINDOWS.PAS
  ptrVerBuf: Pointer;   // pointer to a version buffer
  strFileName,          // Name of the file to check
  strVersion : string;  // Holds parsed version number
begin

   strFileName := paramStr( 0 );
   dwInfoSize :=
      getFileVersionInfoSize( pChar( strFileName ), dwWnd);

   if ( dwInfoSize = 0 ) then
      result := NOVIDATA
   else
   begin

      getMem( ptrVerBuf, dwInfoSize );
      try

         if getFileVersionInfo( pChar( strFileName ),
            dwWnd, dwInfoSize, ptrVerBuf ) then

            if verQueryValue( ptrVerBuf, '\',
                              pointer(FI), dwVerSize ) then

            strVersion :=
               format( '%d.%d.%d.%d',
                       [ hiWord( FI^.dwFileVersionMS ),
                         loWord( FI^.dwFileVersionMS ),
                         hiWord( FI^.dwFileVersionLS ),
                         loWord( FI^.dwFileVersionLS ) ] );

      finally
        freeMem( ptrVerBuf );
      end;
    end;
  Result := strVersion;
end;
{*** end GetVersion ***}

procedure TForm1.FormActivate(Sender: TObject);
begin
  if idIRC1.Connected = False then
    btnConnect.Click;
end;

procedure TForm1.btnConnectClick(Sender: TObject);
begin
  btnConnect.Enabled := False;
  IdIRC1.Nickname := edtNick.Text;//insert your nickname here
  IdIRC1.Username:= LowerCase(edtNick.Text);
  //IdIRC1.RealName := LowerCase(edtNick.Text + ' HG Guest');
  IdIRC1.RealName := LowerCase(edtNick.Text + ' HG Guest HCIRC v.' + GetVersion());
//  IdIRC1.Password := '';
//  IdIRC1.AltNickname:=' HG Guest';

  lblInfo.Caption := 'Attempting IRC Server Connection...';
  Application.ProcessMessages;
  if Connect2IRC = True then
  begin
    // MessageDlg('Connected to ' + idIRC1.Host, mtInformation, [mbOK], 0);
    //Memo1.Lines.Add('Connected to ' + idIRC1.Host);
    lblInfo.Caption := '';
    lblInfo.Visible := False;
    Application.ProcessMessages;
    btnConnect.Enabled:=False;
  end
  else
  begin
    lblInfo.Caption := 'Could not connect to IRC Servers';
    Application.ProcessMessages;
    btnConnect.Enabled := True;
  end;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
  IdIRC1.Disconnect('HG IRC Chat Rocks!');
end;

procedure TForm1.btnNickChangeClick(Sender: TObject);
begin
  IdIRC1.Nickname := edtNick.Text;
end;

procedure TForm1.btnPostMessageClick(Sender: TObject);
begin
  idIRC1.Say(edtChannel.Text, edtTextToSend.Text);
  //Memo1.Lines.Add(IdIRC1.Nickname + ': '+ edtTextToSend.Text);
  memChannelText.Lines.Add(FormatDateTime('[hh:nn] ', NOW) + edtNick.Text + ': '
   + edtTextToSend.Text);
  edtTextToSend.Text := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdIRC1.ListChannelNicknames(edtChannel.Text, IdIRC1.Nickname);
end;

procedure TForm1.edtNickKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  if (Key = VK_RETURN) then
    btnNickChange.Click;
end;

procedure TForm1.edtTextToSendKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) then
    btnPostMessage.Click;
end;

procedure TForm1.btnChannelJoinClick(Sender: TObject);
begin
  IdIRC1.Join(edtChannel.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  strNick: String;
begin
  Form1.Caption := Form1.Caption + ' v.' + GetVersion;

  IdIRC1 := TCICIdIrc.Create(Form1);
  IdIRC1.OnRaw := @IdIRC1Raw;
  IdIRC1.OnPrivateMessage := @IdIRC1PrivateMessage;
  IdIRC1.OnCTCPQuery:= @IdIRC1CTCPQry;
  IdIRC1.OnAdminInfoReceived := @IdIRC1AdminInfoReceived;
  IdIRC1.OnJoin := @IdIRC1JoinEvent;
  IdIRC1.OnPart := @IdIRC1PartEvent;
  IdIRC1.OnQuit := @IdIRC1QuitEvent;
  IdIRC1.OnDisconnected := @IdIRC1Disconnected;

  Randomize;

  LoadUserDataFromReg;

  if (Pos('HGGues', edtNick.Text) = 1) then
  begin
    strNick := 'HGGuest' + IntToStr(Random(999));
    edtNick.Text := strNick;
  end;
  IdIRC1.AltNickname := 'HGGuest' + IntToStr(Random(999));
end;

{*** Saves form state, choices to registry ***}
procedure TForm1.SaveUserDataToReg;
var
  RegSave : TRegistry;
begin
  RegSave:=TRegistry.Create; // Create registry instance
  RegSave.RootKey:=HKEY_CURRENT_USER;

  If RegSave.OpenKey('\SOFTWARE\HarpGamer\HGIRCChat',True) then
  begin
    // Allow web update?
    //RegSave.WriteBool('WebUpdateEnabled', chkAutoUpd.Checked);

    // NickName
    RegSave.WriteString('NickName', edtNick.Text);

    // IRC Server Name
    RegSave.WriteString('Server', 'irc.stratsims.com');

    // Record that we've run the program before
    RegSave.WriteBool('FirstRunDone', True);

    // Close registry instance
    RegSave.CloseKey;
  end;
  RegSave.Free; // Free the resources
end;
{*** End user data save to registry ***}

{*** Loads form state, choices from registry ***}
procedure TForm1.LoadUserDataFromReg;
var
  RegLoad : TRegistry;
begin
  RegLoad:=TRegistry.Create; // Create registry instance
  RegLoad.RootKey:=HKEY_CURRENT_USER;

  // if the keys exist, load the data, otherwise make it up
  If RegLoad.OpenKey('\SOFTWARE\HarpGamer\HGIRCChat',False) then
  begin
    //chkAutoUpd.Checked := RegLoad.ReadBool('WebUpdateEnabled');

    edtNick.Text := RegLoad.ReadString('NickName');

    IdIRC1.Host := RegLoad.ReadString('Server');

    blnFirstRun := NOT RegLoad.ReadBool('FirstRunDone');

    // Close registry instance
    RegLoad.CloseKey;
  end
  else
  begin
    //chkAutoUpd.Checked := False;

    edtNick.Text := 'HGGuest';
    IdIRC1.Host := 'irc.stratsims.com';
    blnFirstRun := True;
  end;

  RegLoad.Free; // Free the resources
end;
{*** End user data load from registry ***}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SaveUserDataToReg;
end;

procedure TForm1.IdIRC1Disconnected(Sender: TObject);
begin
  MessageDlg('You have been Disconnected, restart the program to connect again', mtInformation, [mbOK], 0);
  Application.Terminate;
end;

procedure TForm1.IdIRC1AdminInfoReceived(ASender: TIdContext;
  AAdminInfo: TStrings);
var
  i:integer;
begin
  for i:= 0 to AAdminInfo.Count-1 do begin
    memo1.lines.add(AAdminInfo.Strings[i]);
  end;
end;

procedure TForm1.IdIRC1PrivateMessage(ASender: TIdContext; const ANickname,
  AHost, ATarget, AMessage: String);
var
  strNickFrom: string;
begin
  if (Pos(':', ANickname) = 1) then
    strNickFrom := Copy(ANickname, 2, Length(ANickname))
  else
    strNickFrom := ANickname;
  //memo1.Lines.Add('' +Anickname+' The host'+Ahost+' To name:'+ATarget
  // +' The message '+AMessage);
  if (Pos(ATarget, edtChannel.Text) = 1) then
  begin
    memChannelText.Lines.Add(FormatDateTime('[hh:nn] ', NOW)
     + strNickFrom + ': ' + strLastPrivateMessage);
    SysUtils.Beep;
  end;
end;

function TForm1.IdIRC1CTCPQry(ASender: TIdContext; const ANickname, AHost, ATarget, ACommand, AParams: String): boolean;
begin
  result := False;
  if (ACommand = 'ACTION') then
  begin
    memChannelText.Lines.Add(FormatDateTime('[hh:nn] ', NOW)
     + ANickname + ' ' + ACommand + ' ' + AParams);
    SysUtils.Beep;
    result := True;
  end;
end;

procedure TForm1.IdIRC1Raw(ASender: TIdContext; AIn: Boolean;
  const AMessage: String);
var
  intC: Integer;
  strTmp: String;
  stlTmp: TStringList;
begin
  stlTmp := TStringList.Create;
  memo1.Lines.Add('RAW ' + Amessage);
  if (Pos('PRIVMSG ' + edtNick.Text + ' :
VERSION', AMessage) > 0) then
  begin // now we can join channel
    btnChannelJoin.Click;
  end;
  if (Pos('001 ' + edtNick.Text + ' :Welcome to the freenode Internet Relay Chat Network', AMessage) > 0) then
  begin
    btnChannelJoin.Click;
  end;

  if (Pos('353', AMessage) = 1) then
  begin // received nicknames in channel
    strTmp := Copy(AMessage, Pos(':', AMessage)+1,Length(AMessage));
    stlTmp.Clear;
    stlTmp.Delimiter := ' ';
    stlTmp.DelimitedText := strTmp;
    lbxUsers.Clear;
    //lbxUsers.Sorted := True;
    for intC := 0 to stlTmp.Count - 1 do
    begin
      lbxUsers.Items.Add(stlTmp[intC]);
    end;
  end;
  if (Pos('PRIVMSG ' + edtChannel.Text + ' :', AMessage) = 1) then
  begin // message to channel received
    // handled in IdIRC1.OnPrivateMessage
    // ALE 20130222 FreeNode does /me text here, we should deal with that...
    //  PRIVMSG #harpgamer :
ACTION testing 1.2.3
    {if (Pos('PRIVMSG ' + edtChannel.Text + ' :' +#1+ 'ACTION ', AMessage) = 1) then
    begin
      memChannelText.Lines.Add(FormatDateTime('[hh:nn] ', NOW)
       + AMessage);
    end
    else
    begin
      memChannelText.Lines.Add(FormatDateTime('[hh:nn] ', NOW)
       + AMessage);
    end;
    }
    strLastPrivateMessage := Copy(AMessage, Pos(':', AMessage)+1, Length(AMessage));
  end;

  stlTmp.Clear;
  stlTmp.Free;

end;

procedure TForm1.IdIRC1JoinEvent(ASender: TIdContext; const ANickname, AHost, AChannel: String);
begin
  if (AChannel = edtChannel.Text) then
    lbxUsers.Items.Add(ANickname);
end;

procedure TForm1.IdIRC1PartEvent(ASender: TIdContext; const ANickname, AHost, AChannel, APartMessage: String);
begin
  if (AChannel = edtChannel.Text) then
    if (lbxUsers.Items.IndexOf(ANickName) <> -1) then
      lbxUsers.Items.Delete(lbxUsers.Items.IndexOf(ANickName));
end;

procedure TForm1.IdIRC1QuitEvent(ASender: TIdContext; const ANickname, AHost, AReason: String);
begin
  if (lbxUsers.Items.IndexOf(ANickName) <> -1) then
    lbxUsers.Items.Delete(lbxUsers.Items.IndexOf(ANickName));
end;

function TForm1.Connect2IRC: Boolean;
var
  blnSuccess: Boolean;
begin
  Application.ProcessMessages;
  blnSuccess := False;
  Application.ProcessMessages;
  IdIRC1.Host := 'irc.stratsims.com';
  IdIRC1.Port := 6667;
  lblInfo.Caption := 'Connecting to ' + IdIRC1.Host + ':6667';
  Application.ProcessMessages;
  if (blnSuccess = False) then
  begin
    blnSuccess := Connect2IRCOne(IdIRC1.Host);
  end;

  Application.ProcessMessages;
  IdIRC1.Host := 'irc.stratsims.com';
  IdIRC1.Port := 8067;
  lblInfo.Caption := 'Connecting to ' + IdIRC1.Host + ':8067';
  Application.ProcessMessages;
  if (blnSuccess = False) then
  begin
    blnSuccess := Connect2IRCOne(IdIRC1.Host);
  end;

  Application.ProcessMessages;
  result := blnSuccess;
end;

function TForm1.Connect2IRCOne(strServer: String): Boolean;
begin
  idIRC1.Host := strServer;
  try
    idIRC1.Connect;
  except
    if not idIRC1.Connected then
    begin
      //result := False;
      //MessageDlg('Error connecting to ' + idIRC1.Host, mtError, [mbOK], 0);
      //Exit;
    end;
  end;
  if idIRC1.Connected = True then
  begin
    Memo1.Lines.Add('Connected to: ' + strServer);
    result := True;
  end
  else
  begin
    Memo1.Lines.Add('Connection failed to: ' + strServer);
    result := False;
  end;

end;

end.