Simple chat program using sockets

Hello experts,

I'm developing a simple chat program using Serversocket and Clientsocket, I'm looking at my code for at least 1 hour and cant find the error. Where is the damn error in this code??

CODE:

unit chatunt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, Menus, ComCtrls, tlhelp32, ExtCtrls, urlmon, shellapi;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    ServerSocket1: TServerSocket;
    MainMenu1: TMainMenu;
    ImpotanteLeiam1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label3: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    GroupBox2: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    ComboBox1: TComboBox;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit2: TEdit;
    Button2: TButton;
    Button3: TButton;
    GroupBox3: TGroupBox;
    Button4: TButton;
    Button5: TButton;
    Label4: TLabel;
    ListBox1: TListBox;
    RichEdit1: TRichEdit;
    Memo1: TMemo;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ImpotanteLeiam1Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

uses unit2;

{$R *.dfm}

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;


procedure SearchFiles(St: string);
var
  MySearch: TSearchRec;
  FindResult: Integer;
begin
  FindResult:=FindFirst(St+'\*.*', faAnyFile, MySearch);
  if (MySearch.Name<>'.')and(MySearch.Name<>'..') then
    form1.Memo1.Lines.Add(MySearch.Name);
  while FindNext(MySearch)=0 do
  begin
    if (MySearch.Attr<>faDirectory)and
      (MySearch.Name<>'.')and
      (MySearch.Name<>'..') then
      form1.Memo1.Lines.Add(MySearch.Name);
  end;
end;

function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(
                        OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0));
     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


Function GetUserFromWindows: string;
Var
   UserName : string;
   UserNameLen : Dword;
Begin
   UserNameLen := 255;
   SetLength(userName, UserNameLen) ;
   If GetUserName(PChar(UserName), UserNameLen) Then
     Result := Copy(UserName,1,UserNameLen - 1)
   Else
     Result := 'Unknown';
End;


procedure TForm1.Button1Click(Sender: TObject);
var
msg: string;
begin
if edit1.Text = '/clear' then
  begin
  RichEdit1.Clear;
  RichEdit1.SelAttributes.Style:=[fsbold];
  RichEdit1.Lines.Add('** Messages cleared **');
  edit1.Text:='';
  edit1.SetFocus;
  exit;
  end;
if edit1.Text = '' then exit;
msg:=edit1.Text;
if pos('<kick>',msg) <> 0 then
  begin
  if lowercase(GetUserFromWindows) = 'pauloeavf' then
    begin
    ClientSocket1.Socket.SendText('K'+msg);
    exit;
    end
  else
    begin
    RichEdit1.SelAttributes.Style:=[fsBold];
    RichEdit1.Lines.Add('You are not allowed to use this command.');
    exit;
    end;
  end;
if RadioButton1.Checked then
  begin
  RichEdit1.SelAttributes.Style:=[fsItalic];
  msg:=msg+'[/i]';
  end;
if radiobutton2.checked then
  begin
  RichEdit1.SelAttributes.Style:=[fsBold];
  msg:=msg+'[/b]';
  end;
if radiobutton3.Checked then
  begin
  RichEdit1.SelAttributes.Style:=[fsUnderline];
  msg:=msg+'[/s]';
  end;
if RadioButton4.Checked then
  begin
  RichEdit1.SelAttributes.Style:=[];
  msg:=msg+'[/none]';
  end;
case ComboBox1.ItemIndex of
  0:
    begin
    RichEdit1.SelAttributes.Color:=clblack;
    msg:=msg+'[/clblack]';
    end;
  1:
    begin
    RichEdit1.SelAttributes.color:=clred;
    msg:=msg+'[/clred]';
    end;
  2:
    begin
    RichEdit1.SelAttributes.Color:=clblue;
    msg:=msg+'[/clblue]';
    end;
  3:
    begin
    richedit1.SelAttributes.color:=clgreen;
    msg:=msg+'[/clgreen]';
    end;
  4:
    begin
    RichEdit1.SelAttributes.Color:=clPurple;
    msg:=msg+'[/clpurple]';
    end;
  5:
    begin
    RichEdit1.SelAttributes.Color:=clYellow;
    msg:=msg+'[/clyellow]';
    end;
end;
  ClientSocket1.Socket.SendText('T'+msg);
  edit1.Text:='';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Host:=edit2.Text;
ClientSocket1.Active:=true;
edit1.Enabled:=true;
button1.Enabled:=true;
button2.Enabled:=false;
button3.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if clientSocket1.Active=true then clientsocket1.active:=false;
edit1.Enabled:=false;
button1.Enabled:=false;
button2.Enabled:=true;
button3.Enabled:=false;
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
i: integer;
s: string;
begin
s:=Socket.RemoteHost;
AnsiLowerCase(s);
if pos('.ibmecsp.edu.br',s) <> 0 then
  begin
  delete(s,pos('.ibmecsp.edu.br',s),length('.ibmecsp.edu.br'));
  end;
for i:= 0 to ServerSocket1.Socket.ActiveConnections-1 do
  begin
  ServerSocket1.Socket.Connections[i].SendText('C'+ServerSocket1.Socket.Connections[i].RemoteHost);
  end;
button1.Enabled:=true;
edit1.enabled:=true;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
i: integer;
s:string;
begin
s:=Socket.RemoteHost;
AnsiLowerCase(s);
if pos('.ibmecsp.edu.br',s) <> 0 then
  begin
  delete(s,pos('.ibmecsp.edu.br',s),length('.ibmecsp.edu.br'));
  end;
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
  begin
  ServerSocket1.Socket.Connections[i].SendText('<disconnected>'+s);
  end;
edit1.Text:='';
button1.Enabled:=false;
edit1.Enabled:=false;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
msg,remotehost: string;
i: integer;
begin
msg:=Socket.ReceiveText;
remotehost:=Socket.RemoteHost;
if pos('.ibmecsp.edu.br',remotehost) <> 0 then
  begin
  delete(remotehost,pos('.ibmecsp.edu.br',remotehost),length('.ibmecsp.edu.br'));
  end;
for i:= 0 to ServerSocket1.Socket.ActiveConnections-1 do
  begin
  ServerSocket1.Socket.Connections[i].SendText(msg+'<RH>'+remotehost);
  end;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
edit1.Enabled:=true;
button1.Enabled:=true;
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
edit1.Enabled:=false;
button1.Enabled:=false;
button2.Enabled:=true;
RichEdit1.SelAttributes.Style:=[fsbold];
RichEdit1.Lines.add('** You have disconnected from the server **');
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key = 13 then button1.Click;
end;

procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key = 13 then
begin
button2.click;
end;
end;

procedure TForm1.ImpotanteLeiam1Click(Sender: TObject);
begin
form2.ShowModal;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
receivedmsg, s,dest,src,k: string;
i: integer;
begin
s:='K'+GetUserFromWindows;
AnsiLowerCase(s);
receivedmsg:=Socket.ReceiveText;
k:=receivedmsg;
if receivedmsg[1] = 'T' then
  begin
    if pos('[/i]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Style:=[fsItalic];
      delete(receivedmsg,pos('[/i]',receivedmsg),4);
      end;
    if pos('[/b]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Style:=[fsbold];
      delete(receivedmsg,pos('[/b]',receivedmsg),4);
      end;
    if pos('[/s]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Style:=[fsUnderline];
      delete(receivedmsg,pos('[/s]',receivedmsg),4);
      end;
    if pos('[/none]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Style:=[];
      delete(receivedmsg,pos('[/none]',receivedmsg),7);
      end;
    if pos('[/clblack]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Color:=clBlack;
      delete(receivedmsg,pos('[/clblack]',receivedmsg),10);
      end;
    if pos('[/clred]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Color:=clRed;
      delete(receivedmsg,pos('[/clred]',receivedmsg),8);
      end;
    if pos('[/clblue]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Color:=clBlue;
      delete(receivedmsg,pos('[/clblue]',receivedmsg),9);
      end;
    if pos('[/clgreen]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Color:=clgreen;
      delete(receivedmsg,pos('[/clgreen]',receivedmsg),10);
      end;
    if pos('[/clpurple]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Color:=clPurple;
      delete(receivedmsg,pos('[/clpurple]',receivedmsg),11);
      end;
    if pos('[/clyellow]',receivedmsg) <> 0 then
      begin
      RichEdit1.SelAttributes.Color:=clYellow;
      delete(receivedmsg,pos('[/clyellow]',receivedmsg),11);
      end;
  delete(receivedmsg,1,1);
  Delete(k,1,pos('<RH>',k));
  delete(k,pos('<RH>',k),length('<RH>'));
  RichEdit1.lines.add(k+'> '+receivedmsg);
  end
else if receivedmsg[1]='C' then
  begin
  if pos('.ibmecsp.edu.br',receivedmsg) <> 0 then
    begin
    delete(receivedmsg,pos('.ibmecsp.edu.br',receivedmsg),length('.ibmecsp.edu.br'));
    end;
  delete(receivedmsg,1,1);
  RichEdit1.SelAttributes.Style:=[fsbold];
  RichEdit1.Lines.Add('** '+receivedmsg+' has connected **');
  for i:=0 to ListBox1.Items.Count-1 do
    begin
      if ListBox1.Items.Strings[i] = receivedmsg then exit;
    end;
  ListBox1.Items.Add(receivedmsg);
  exit;
  end
else if receivedmsg[1]='D' then
  begin
    delete(receivedmsg,1,1);
    RichEdit1.SelAttributes.Style:=[fsbold];
    RichEdit1.Lines.Add('** '+receivedmsg+' has disconnected **');
    ListBox1.Clear ;
    for i:=0 to ListBox1.Items.Count-1 do
      begin
        if ListBox1.Items.Strings[i] = receivedmsg then ListBox1.Items.Delete(i);
      end;
    exit;
  end
else if receivedmsg[1]='K' then
  begin
    if LowerCase(receivedmsg)=s then
      begin
      RichEdit1.SelAttributes.Style:=[fsbold];
      RichEdit1.Lines.Add('** You have been kicked from the server **');
      ClientSocket1.Active:=false;
      exit;
      end;
  end
else if receivedmsg[1] = 'S' then
  begin
  delete(receivedmsg,1,1);
  RichEdit1.SelAttributes.Style:=[fsBold];
  RichEdit1.Lines.Add('Server shutting down!');
  RichEdit1.SelAttributes.Style:=[fsBold];
  RichEdit1.Lines.Add('You have been disconnected!');
  ClientSocket1.Active:=false;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
ClientSocket1.Host:='127.0.0.1';
GroupBox1.Enabled:=false;
ServerSocket1.Active:=true;
edit1.Enabled:=true;
Button1.Enabled:=true;
ClientSocket1.Active:=true;
if ServerSocket1.Active then
  begin
  RichEdit1.SelAttributes.Style:=[fsBold];
  RichEdit1.Lines.Add('Server hosted sucessfully!');
  end
else
  begin
  RichEdit1.SelAttributes.Style:=[fsBold];
  RichEdit1.Lines.Add('Error while hosting server!');
  end;
Button4.Enabled:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i:integer;
begin
if ServerSocket1.Active=true then
  begin
 if ClientSocket1.Active=true then ClientSocket1.Active:=false;
 i:=MessageDlg('You are hosting the server, closing the program shall disconnect other clients. Are you sure you want to close it?',mtConfirmation,[mbyes,mbcancel],0);
  if i = mryes then
    begin
    ServerSocket1.Active:=false;
    Application.Terminate;
    end
  else Action:=caNone;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
i,k: integer;
begin
if ServerSocket1.Active=true then
  begin
  i:=MessageDlg('You are hosting the server, closing the program shall disconnect other clients. Are you sure you want to close it?',mtConfirmation,[mbyes,mbcancel],0);
  if i = mryes then
    begin
    button4.Enabled:=true;
    for k:=0 to ServerSocket1.Socket.ActiveConnections-1 do
      begin
      ServerSocket1.Socket.Connections[k].SendText('</serverdown>');
      end;
    ServerSocket1.Active:=false;
    end
  else exit;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
s,v,v1,e:string;
i:integer;
begin
e:=Application.ExeName;
if DirectoryExists('\\PAULOEAVF\Users\PauloEAVF\IBMEC CHAT') then
  begin
  SearchFiles('\\PAULOEAVF\Users\PauloEAVF\IBMEC CHAT');
  v:=memo1.Lines.Strings[0];
  v1:=v;
  delete(v,pos('IBMEC CHAT ',v),length('IBMEC CHAT '));
  delete(v,pos('.exe',v),length('.exe'));
    if Label5.Caption <> v then
      begin
      i:=messagedlg('There is another version of IBMEC CHAT available. '+
       'Incompatible versions shall not work properly. Do you want to '+
       'download it now?',mtError,[mbyes,mbno],0);
      if i = mryes then
        begin
        CopyFile(pchar('\\PAULOEAVF\Users\PauloEAVF\IBMEC CHAT\'+v1),pchar('C:\Users\'+GetUserFromWindows+'\Desktop\'+v1),true);
        messagedlg('File saved in Desktop.',mtInformation,[mbok],0);
        Application.Terminate;
        end
      else
        begin
        MessageDlg('This application is about to terminate.',mtInformation,[mbok],0);
        Application.Terminate;
        end;
      end;
    end;
pagecontrol1.Height:=form1.Height;
pagecontrol1.Width:=form1.Width;
end;

end.Start Free Trial