[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Simple chat program using sockets

Posted on 2007-10-03
32
Medium Priority
?
2,911 Views
Last Modified: 2013-11-23
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.
0
Comment
Question by:plinho
  • 17
  • 15
32 Comments
 
LVL 28

Expert Comment

by:2266180
ID: 20013481
it would be nice to also post the dfm.. makes life easier (same for your otehr question). I'd look manually over the code, but that will take forever. so post the dfm ;)
0
 

Author Comment

by:plinho
ID: 20013602
what do you mean post the dfm?? you mean the project so you can open with delphi??

Well, I'll post the code of the dfm here, but if you want i can send the whole project to ypur email so your can visualize it easier. Just post your email here ;)
0
 
LVL 28

Expert Comment

by:2266180
ID: 20014117
EE policy does not allow email communications :)

the dfm is a text file just as your pas file. so just post it here.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:plinho
ID: 20014536
object Form1: TForm1
  Left = 249
  Top = 120
  BorderStyle = bsToolWindow
  Caption = 'IBMEC CHAT v0.5'
  ClientHeight = 534
  ClientWidth = 746
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 746
    Height = 534
    ActivePage = TabSheet1
    Align = alClient
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = 'Messages'
      object Label3: TLabel
        Left = 8
        Top = 8
        Width = 62
        Height = 13
        Caption = 'MESSAGES:'
      end
      object Label2: TLabel
        Left = 657
        Top = 488
        Width = 62
        Height = 13
        Caption = 'made by Ace'
      end
      object Label4: TLabel
        Left = 520
        Top = 224
        Width = 93
        Height = 13
        Caption = 'Clients connecteds:'
      end
      object Label5: TLabel
        Left = 272
        Top = 0
        Width = 34
        Height = 24
        Caption = 'v0.5'
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -20
        Font.Name = 'MS Sans Serif'
        Font.Style = []
        ParentFont = False
        Visible = False
      end
      object Edit1: TEdit
        Left = 8
        Top = 440
        Width = 425
        Height = 21
        Enabled = False
        TabOrder = 0
        OnKeyDown = Edit1KeyDown
      end
      object Button1: TButton
        Left = 440
        Top = 440
        Width = 75
        Height = 25
        Caption = '&Send'
        Enabled = False
        TabOrder = 1
        OnClick = Button1Click
      end
      object GroupBox2: TGroupBox
        Left = 520
        Top = 24
        Width = 185
        Height = 153
        Caption = 'Font'
        TabOrder = 2
        object RadioButton1: TRadioButton
          Left = 8
          Top = 16
          Width = 113
          Height = 17
          Caption = 'It'#225'lico'
          TabOrder = 0
        end
        object RadioButton2: TRadioButton
          Left = 8
          Top = 40
          Width = 113
          Height = 17
          Caption = 'Negrito'
          TabOrder = 1
        end
        object RadioButton3: TRadioButton
          Left = 8
          Top = 64
          Width = 113
          Height = 17
          Caption = 'Sublinhado'
          TabOrder = 2
        end
        object RadioButton4: TRadioButton
          Left = 8
          Top = 88
          Width = 113
          Height = 17
          Caption = 'Sem formata'#231#227'o'
          TabOrder = 3
        end
      end
      object ComboBox1: TComboBox
        Left = 520
        Top = 184
        Width = 145
        Height = 21
        ItemHeight = 13
        TabOrder = 3
        Text = 'COR'
        Items.Strings = (
          'Preto'
          'Vermelho'
          'Azul'
          'Verde'
          'Roxo'
          'Amarelo')
      end
      object ListBox1: TListBox
        Left = 520
        Top = 248
        Width = 177
        Height = 177
        ItemHeight = 13
        TabOrder = 4
      end
      object RichEdit1: TRichEdit
        Left = 8
        Top = 24
        Width = 505
        Height = 409
        ReadOnly = True
        ScrollBars = ssVertical
        TabOrder = 5
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'Connection'
      ImageIndex = 1
      object GroupBox1: TGroupBox
        Left = 8
        Top = 8
        Width = 185
        Height = 113
        Caption = 'Connection Client'
        TabOrder = 0
        object Label1: TLabel
          Left = 8
          Top = 24
          Width = 79
          Height = 13
          Caption = 'USERNAME/IP:'
        end
        object Edit2: TEdit
          Left = 8
          Top = 40
          Width = 121
          Height = 21
          TabOrder = 0
          OnKeyDown = Edit2KeyDown
        end
        object Button2: TButton
          Left = 8
          Top = 72
          Width = 75
          Height = 25
          Caption = '&Connect'
          TabOrder = 1
          WordWrap = True
          OnClick = Button2Click
        end
        object Button3: TButton
          Left = 96
          Top = 72
          Width = 75
          Height = 25
          Caption = 'Disconnect'
          Enabled = False
          TabOrder = 2
          OnClick = Button3Click
        end
      end
      object GroupBox3: TGroupBox
        Left = 200
        Top = 8
        Width = 185
        Height = 113
        Caption = 'Connection Server'
        TabOrder = 1
        object Button4: TButton
          Left = 48
          Top = 32
          Width = 75
          Height = 25
          Caption = 'Open room'
          TabOrder = 0
          OnClick = Button4Click
        end
        object Button5: TButton
          Left = 48
          Top = 64
          Width = 75
          Height = 25
          Caption = 'Close room'
          TabOrder = 1
          OnClick = Button5Click
        end
      end
      object Memo1: TMemo
        Left = 8
        Top = 128
        Width = 265
        Height = 209
        TabOrder = 2
        Visible = False
      end
    end
  end
  object ClientSocket1: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Port = 8080
    OnConnect = ClientSocket1Connect
    OnDisconnect = ClientSocket1Disconnect
    OnRead = ClientSocket1Read
    Left = 48
    Top = 48
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 8080
    ServerType = stNonBlocking
    OnClientConnect = ServerSocket1ClientConnect
    OnClientDisconnect = ServerSocket1ClientDisconnect
    OnClientRead = ServerSocket1ClientRead
    Left = 80
    Top = 48
  end
  object MainMenu1: TMainMenu
    Left = 16
    Top = 48
    object ImpotanteLeiam1: TMenuItem
      Caption = '** Impotante **'
      OnClick = ImpotanteLeiam1Click
    end
  end
end
0
 
LVL 28

Expert Comment

by:2266180
ID: 20015334
O have commented the line with form2.showmodal (obvioulsy :P )

but ... I cannot understand how to use the program. so best thing is to tell me exactly what steps to make in order for me to see the error you are getting.
0
 

Author Comment

by:plinho
ID: 20015525
Its like this, first someone has to host the serversocket, and then everybody that wants to enter the chat connects to this server... Serversocket1 just repass the text sent by one client to all the other clients and there are some functions on Client OnRead that interprets if someone connects, diconnects, if the server shuts down or if domeone sent a text to the chat... The problem is that i cant see the text sent in the richedit1 =\

Hope this helps you to understand how the program works...
0
 
LVL 28

Expert Comment

by:2266180
ID: 20015559
let's say I'm the stupid user :D

so, I start up one instance of the program. click on the open room.
then start anotehr instance of the program. what do I do next? because nothing I can think of works.
so give detailed example (what to input and where and what to click, select, whetever)
0
 

Author Comment

by:plinho
ID: 20015944
It's like this:
-One person open up the serversocket1 by clicking in "Open Room"(Button4) (it automatically connect the clientsocket to the serversocket in the same application and the person who open up the Room is like any other client);

-The other people who want to enter the chat have to connect to the serversocket of the person who created it, by putting the IP Address in edit2 and clicking the button "Connect" (Button2);

-When connected, the person can send the strings in Edit1, by clicking the button "Send"(Button1), this strings are sent to the server, and the server repass it to all clients connecteds with the following code:

        for i:= 0 to ServerSocket1.Socket.ActiveConnections-1 do
         begin
          ServerSocket1.Socket.Connections[i].SendText(msg+'<RH>'+remotehost);
         end;

-To see who is online in the Room (in Listbox1) when a client connects to the server (OnCLientConnect) the server sends the string 'T' + the name of the client who connected to all clients and on Client's OnRead there is a funtion that detects if the strings received by the server is Text, Connect, Disconnect, Shutting Down or Kick:

T: Text to the chat;
C: When a client connects;
D: When a client disconnects;
K: When a player is kicked;
S: When the server is shutting down;

For every string sent is put one of these letters above to detect which action of the client has occured.


By the way, this Form2.Showmodal is kind of irrelevant, its just a "How to use" form.


Hope that helps you to understand my very sick mind!! lol

0
 
LVL 28

Expert Comment

by:2266180
ID: 20016249
hm... I typed "test" (no quotes) and in both applications I got "RH>localhost> test<RH>localhost" (again, no quotes)
so the message is beeing sent but it's beeing output incorrectly.

I ment to ask you this earlier: what delphi version are you using? (I tested this on delphi 7)
0
 

Author Comment

by:plinho
ID: 20016591
yeah, i use delphi 7...
'Oo, that's weird... When i type anything here it just happens nothing =\...
I thought for a moment hat it would have something to do with the intranet here in college... but i already tried another version of this chat and it worked....

What do you think it can be/??
0
 
LVL 28

Expert Comment

by:2266180
ID: 20016808
well, I started the application on my pc twice. first one as server second as second as another client.
I used localhost to connect since the ip is hardocded 127.0.0.1
and as I said, it works.
maybe you are not connecting to the right server?
0
 

Author Comment

by:plinho
ID: 20016896
Actually, to test it you dont need to open another instance of the .exe because when you click Open Room it automatically open the server and connects the client....

So, what is wrong with it, why it doesn't work with me??? Oo
0
 
LVL 28

Expert Comment

by:2266180
ID: 20017375
let's try this: here is the compiled version http://www.ciuly.com/delphi/124.zip
run it. does that work? if it doesn't work, then it's something wrong on your computer. the port is in use maybe? who knows. need some better error control there.
if it does work, then there might be some problems with your code. if you are not using the exact code you sent me, then recompile the code that is in the zip file and see if that is working or not. if it's working, then there is something wrong with your original code. if it doesn't work, then there is something wrong with your delphi environment in respect that you might be using some other units in the search path to compile the program. that is something you'll have to find your self by looking at the searchpaths and see if you find something there that shouldn't be.

if this is not working out for you, you might also want to consider moving to indy :D or ics. whichever you prefer. but since it's working for me, you should be able to find the problem one way or another.
0
 

Author Comment

by:plinho
ID: 20017664
Hmm, I have 2 questions:

-If i'm with IE open and try to use the port 80 or8080, will it work??

-How can I see ALL the ports that are open? PS: I'm in intranet in college, so idont have access to the router...
0
 
LVL 28

Expert Comment

by:2266180
ID: 20017702
- yes. IE is not acting as a server :) but if you have IIS installed or some other webbrowser or skype or other application that acts as a aserver and uses port 80 then it will not work
- use active ports: http://www.tucows.com/preview/213738
0
 

Author Comment

by:plinho
ID: 20018012
Well, this little code worked here:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ComCtrls;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    ServerSocket1: TServerSocket;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    RichEdit1: TRichEdit;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button3Click(Sender: TObject);
begin
ServerSocket1.Active:=true;
ClientSocket1.Host:='127.0.0.1';
ClientSocket1.Active:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText(edit1.Text);
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
i:integer;
begin
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
  begin
  ServerSocket1.Socket.Connections[i].SendText(Socket.ReceiveText);
  end;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
RichEdit1.Lines.add(Socket.ReceiveText);
end;

end.

With the port 8080, now i cant understand why doesn't the other code work.....
0
 
LVL 28

Expert Comment

by:2266180
ID: 20018086
and I was just shutting down :) (past midnight here)
tell you what: best thing when it comes to remote debugging, is a log file :)

here is some code:
unit failsafeLogging;

interface

var FailsafeLogFile:string='c:\temp\FailsafeLogfile.log';

procedure failsafeLog(s:string);

implementation

uses classes, sysutils;

procedure failsafeLog(s:string);
var m:integer;
begin
  if fileexists(FailsafeLogFile) then m:=fmOpenReadWrite
                                 else m:=fmCreate;
  with TFilestream.Create(FailsafeLogFile, m) do
  try
    Write(pansichar(s)^, length(s));
  finally
    free;
  end;
end;

initialization
  failsafelog('Failsafe logging up and running.');

end.

simple an dbasic (copy-paste from a bigger logging system). the idea behind the fail safe logging is that you are pointing it to a file and directory that exist 100% and are writeable by everyone 100%. and then you base your more complex logging system on this one, but that is another story.

for now, just modify, if needed thet log file to point to such a directory and file and place some logging calls. as many as you can in all the important palces (button click, before actiona dnafter action.etc etc etc.so we can trace the execution and see where is the faulty code.

then post the new code with the logging, so I can see where you put the log calls, and the contents of the log file here and I'll try and see (tomorrow, of course) what went wrong and where (I'll use the same code and compare the log results).

see you tomorow :)
0
 

Author Comment

by:plinho
ID: 20018134
Wow, i guess i found the error!!!

it's on the letters that i put before the text sent!! if the first string sent in the chat is 'C'+someting then all the others letters ('T','K', etc) wont work, i tried to put only 'T' (for the chat itself) and it worked perfectly...

how can i fix this??
0
 
LVL 28

Expert Comment

by:2266180
ID: 20020027
weird, that also works for me
"Server hosted sucessfully!
** localhost has connected **
RH>localhost> Cbb<RH>localhost
RH>localhost> sd<RH>localhost
RH>localhost> Cyui<RH>localhost
RH>localhost> Tbb<RH>localhost
"
but I'm probably not using it right :D

well, I was meaning to talk to you abuot this. you need a protocol. like http, ftp, etc.
in your case, I can think of a simple one like. you send command, back and forth of the form: (some BNF notation)
<command> ::= <tag> [SPACE <text>] CRLF (anything between [ - ] is optional)
<tag> ::= 1*<alpachar> (this means at least 1 alphachar followed by 0 or more alphachars
<alphachar> ::= A | B | ... | Z | a | b | ... | z ( the vertical bar means OR)
SPACE ::= #32 (one space character)
<text> ::= *<char>
<char> ::= any character except CR and LF
CRLF ::= CR LF
CR :: = #13
LF ::= #10

so, you will have at least 2 tags: "message" and "control"
message will send a message and control will take care of the controls: kick, ban, etc

also, since you are sending out formatiing, you must make sure that the protocol supports it liek for example the message command iwll be of the form

message SPACE [ <list of colors> ] [ <list of styles> ] <test> CRLF

example:
"message [clred][]blabla#13#10" (without the quotes) which is a red text with no style.

so this will allow the user to write something like
"message [clred][]blabla[/clred]#13#10"
and it won't be interpreted as a command :)

also, I se eyou are using
if pos('<kick>',msg) <> 0 then and if pos('[/i]',receivedmsg) <> 0 then and etc
which is also wrong since you are not allowing the user to write <kick> in the chat. totaly wrong. you must make the protocol in such way that the use can input ANYTHING and the program will work without problems.
anyway, if you implement a correct protocol, everything will be fone from this point of view.
0
 

Author Comment

by:plinho
ID: 20020566
Well, it is working, i just changed this : instead of when you click  "send" send 'T'+msg i put on server's OnRead:
for i:=0 to activeconnections-1 do
begin
serversocket1.socket.connections[i].sendtext('T'+msg+'<RH>'+remotehost);
end;

When i test with myselfit works great but when i test with my friends it just doesn't work... =\
0
 
LVL 28

Expert Comment

by:2266180
ID: 20020586
you're not listening to me: you need a correct protocol. your protocol is INCORRECT. I could start and try and fix your protocol, but I believe it's jsut a waste of time. you must do a correct protocol so that such problems will not happen. making small hacks jsut to see it work now, is not a good idea, because that hack might not work in some other configuration.
do a correctprotocol correctly and you will see it will work.

you really want me to fix your protocol for this specific case/scenario? I can do that, but in a few days you wil open up another question because there is some other scenario that doesn't work. and this will jstu keep on getting messier and uglier. make it right and you'll be fine.
0
 

Author Comment

by:plinho
ID: 20021057
let me see if i understand you explanation of the tags... The string sent to the Serversocket should be divided in 3 parts:

-<tags>;
-<alpachar>;
-CRFL;

<tags> should be the length of the <alpachar>?

<alpachar> should be the message itself, which will be put in RichEdit1?? If yes, i didn't understand how am i going tu specify the color and format of the strings... would it be inside <alpachar> or outside it?

CR i see its ENTER, but what about LF ??

And the last part of my list of questions: How am i going to know which '[]' are <alpachar> and which are <tags> and which are for the string style and color in Client's OnRead??


Sorry if this question are noobs, but i just cant understand this logic completely...
0
 
LVL 28

Expert Comment

by:2266180
ID: 20021207
you never heard of BNF, have you? :) see this: http://en.wikipedia.org/wiki/Backus-Naur_form (just as info, since it takes a while to understand it)
the BNF notaion is used to diagram soemthing. it is very used in showing a protocol syntax (but I guess you never read a protocol RFC (Request For Comment) either). so ...

a small explanation:
"::=" means that the left part IS DEFINED as the right part. (i'm not yelling. just underlining (no underline in EE or bold so ...)
everything between < and > is considered a "variable"
the character | means OR. like A |B |C |D means the character A or the character B or C or D etc.

so, one command is formed from one tag, optionally followed by (one space and maybe some characters) AND a CR LF. now, ENTER = CR + LF :) yes. both. when you do writeln(string) then the "string" is appeneded with both CR and LF and then written.

now, the "message" command (or tag. don't think of the word tag as a blog-like tag or seomthing. it's just that: a tag. a name. a short description.)
the format of the message command is
message SPACE OPEN_STRAIGHT_BRACKET list of colors here CLOSED_STRAIGHT_BRACKET SPACE OPEN_STRAIGHT_BRACKET (yes, no space. no need for space) list of styles CLOSED_STRAIGHT_BRACKET any number of characters here that form the message CRLF

so, if I want to send a red message, bolded, saying:"hello world" you would send over the socket:
s:='message [clred][fsbold]hello world';
as you can see, there is one space after the tag (this suggests that there is something more to come. if there is nothing more to come, then there is no space. that's the idea with the optional space after the tag)/ and there is no space between the brakets and no space between the bracket and the text itself.

so the way you read this in the program is (pseudo example, not using your existing code):

s:=readln;// this read up until CRLF ;) (of course, it depends on the socket component you are using. for now, in your case, you remain on receivetext)
i:=pos(#32, s);
if i>0 then
begin// we have something
  if sametext(copy(s,1,i-1),'message') then
  // it's a message, now we know that we have 2 sets of brackets and then the text
    processMessageCommand(copy(s,i+1, length(s))
  else if blabla for every tag/command we have
end;

procedure processMessageCommand(s:string);
var i:integer;
      t:string;
begin
  assert(s[1]='[');// make sure we have correct stuff
  delete(s,1,1);
  i:=pos(']',s);
  t:=copy(s,1,i-1);
  processColors(t);
  delete(t,1,i+1);// this also delets the next open braket
  i:=pos(']',s);
  t:=copy(s,1,i-1);
  processStyles(t);
  delete(s,1,i);
  messages.add(s);// now add the message to the chat windows
end;

you see how clean it is?

AND, just to be clear, you can make it easier for you.
- you will only have 1 color. right? later on you can improve the protocol, but I think we both agree that for now you only have one color
- you only have one style (you are using a radio group)

so, you can make the protocol easier by using something like this:

<message command> ::= "message" SPACE <color> SPACE <style> SPACE <text> CRLF
<color> ::= integer number
<style> ::= integer number
<text> ::= any number of characters

and the parsing this will be even easier then above AND, processig will be only a matter of converting teh string to an integer and casting it to TColor in case of colors and TFontStyle in case of style. and viceversa, when sending the message you will do somethingn like

s:='message '+inttostr(integer(clred))+' '+inttostr(integer(bsbold))+' '+the_message;
see? no more tons of IF's as in your code. only one line to write the colors and style and maybe 4-5 to read the color and style. and now, instead of the cololr combobox, you can use a colorpicker and jsut use the color property of it and you can have any color you want in the chat ;)

phew ... long post. hope that explains things a little more clearly.
0
 

Author Comment

by:plinho
ID: 20022100
ciuly, that was a LOT more clarifying, you should get at least 1000 points ;)

but i cant see yet how i can apply this to my program T_T... Can you make a VERY simple chat app with delphi using this method? Just so i can actually SEE how to use it... If you want you can post some links to some chat programs with source code included that uses this...
0
 
LVL 28

Expert Comment

by:2266180
ID: 20027097
sorry. for some reason I didn't receive a notification from EE. not for the first time. That's why I keep the tabs open and sometimes check them.

I'll try to make a simple chat aplication using indy tcp components. I like them better :P But I will make it in such way that the actual protocol is tcp component-independent :)

back in a few hours
0
 
LVL 28

Expert Comment

by:2266180
ID: 20027308
here is the demo http://www.ciuly.com/delphi/indy/IndyTcpSingleExeChatDemo.zip

you should be able to see the protocl stuff.

also, I have changed a little the message protocol to allow multiple styles :)
0
 

Author Comment

by:plinho
ID: 20027718
Whow,this code is infinitely more complicated than mine!! ahhahhahahh

But it's genius!!! xD
Can you just post here how i should implement the commands? kick for example...
0
 
LVL 28

Expert Comment

by:2266180
ID: 20027915
same as any other.
command syntax is:
kick SPACE username CRLF

you send from client
clientSendCommand(CKick+' '+username);
and in server in processServerCommand you add
    else if sametext(c, CKick) then
      processServerKickCommand(s)
in which you find the thread of the username with u.find(username)
and having the thread you call the disconnect on the connection property (maybe sending a message to the client liek "you were kicked by x" before closing the connection

if you also want ban, then you need to add another list in which you keep the banned usernames and in the processServerConnectCommand you also see if the username is there and if it is, you can again send a message that "you are banned" and close the connection (somehting like the stuff I've done for already connected username)

possibilities are endless even with this "primitive" protocol.

0
 

Author Comment

by:plinho
ID: 20029208
Hmm, one last question: How do i do so the messages comes with the nick of the person who wrote it?? for example: plinho> blablabalbalabl
0
 
LVL 28

Accepted Solution

by:
2266180 earned 2000 total points
ID: 20029656
jsut like you do for any other extra information: you change the message format sent to the client to include the username. imagine that your initial proto9col of the message was
"message SPACE text". you want to add color. what happened? the color was added in such a away that is 100% it can be retrieved correctly. you want to add style. what happened? same thing.
you want to add username? well, you add username.how? well, it depends what characters you accept as username.
if you don't accept SPACE as a valid username character, then you can make a validation routine in the login and before checking if username exist, you check if it contains a space.
then you send message to clients like
"message SPACE username SPACE color SPACE [list of styles] SPACE text"
it's really not so hard. I choosed the simplest protocol definition I could think of. try to understand the concept because programming in general is a hell lot more complicated than this protocol.
this is not something that MUST be dne like that. I choosed to do it like that because it is sufficient. you can replace those [] with {} or () an dit wills till work. hell, you can even replace them with .. or /\ or %% or *# or whatever. it doesn't matter. you can also replace SPACE with CRLF or LFCR or #1 or #2 or #0 or #255 or whatever na dit will still work. try to understand. don't just learn it like poetry. this is science not literature.
you have a protocol that you are using. like when you talk. the protocol of language says that you must use sentences. and a sentance ends with a dot, question mark, etc. and then in some situations you must use commas. and a sentence begins with a capital letter. etc etc etc. THAT is the protocol. In arabic the protoco say that you must write from right to left. teh protocl for english language says that you can use ONLY a few characters. the protocol for japanese says that you must use otehr characters. etc/
If they don't folow protocol, the 2 ends communicating will not understand each other. why did english choose to depict the animal lion with the word "lion"? I don't know but that's the protocl. I can make a protocol saying that the animal lion is written "jkdfshalk". and the verb roars is written "7894231895". if you send me "jkdfshalk 7894231895" I will read: "lion roars" because I use that protocol. But if you send that text to somebody not using the above entioned protocol they will see garbage.

THAT is protocol. you have full control over it. but you must make sure that your protocl is not ambigous. because if you say that "fish" is "ab" and "lion" is "bc" and "animal" is "abc". I'm asking you: what is when I say "abc"? is it animal? is it "fish" followed by a c? is it lion preceded by an a? it's ambigous.
so you can use anything you want but you must make sure that the protocol is correct and complete and non-ambigous.

key word: UNDERSTAND.
I know that not everybody has the "power" of comming up with a good communication protocol, but everybody should understand a protocol when they see one. it's like learning a new language. anybody can do it, if they want to.
yes. you can look at the communication protocol of 2 programs as the language they use to speak to each other.

I hope you will eventually understand the concept and be able to write your own protocol, or extend the one I gave you :)
experiment. it's the easiest way to learn when it comes to computer science. your computer will not beat you up if you say the wrong thing ;)
0
 

Author Comment

by:plinho
ID: 20030501
Whow, i guess i didnt even had understood the concept of protocol before this post!! This make things a lot easier =]

I will take a look i this code and try to understand it!! Since you already answered my question i guess i'll accept the post i think it was more clarifying to me ;)


thanks ciuly, ur genious!!
0
 
LVL 28

Expert Comment

by:2266180
ID: 20032820
you're welcome :)
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In our object-oriented world the class is a minimal unit, a brick for constructing our applications. It is an abstraction and we know well how to use it. In well-designed software we are not usually interested in knowing how objects look in memory. …
Programmer's Notepad is, one of the best free text editing tools available, simply because the developers appear to have second-guessed every weird problem or issue a programmer is likely to run into. One of these problems is selecting and deleti…
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
The viewer will learn how to use NetBeans IDE 8.0 for Windows to connect to a MySQL database. Open Services Panel: Create a new connection using New Connection Wizard: Create a test database called eetutorial: Create a new test tabel called ee…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question