Solved

Socket Expert Needed On this one

Posted on 2001-06-16
5
188 Views
Last Modified: 2010-04-06
This is actually my entire unit one, which is pretty much me giving out the source to my project but oh well I need help. I'm creating a voice and text communication program (text only so far) I have a numeric system set up for handling commands etc. Bascially my problem is when a person disconnects form the server, exceptions are being raised on both clients and the server. PLEASE help me figure this out. and if you have any other suggestions that don't require me to re-write this entire thing I'm open to them. THis is really my first real experience working with tcp/ip so please be gentle. And now the code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls, ComCtrls, ToolWin, ImgList,
   Build, APNetscapeLabel, ScktComp, Token;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ListBox1: TListBox;
    APNetscapeLabel1: TAPNetscapeLabel;
    ProgressBar1: TProgressBar;
    APNetscapeLabel2: TAPNetscapeLabel;
    APNetscapeLabel3: TAPNetscapeLabel;
    ProgressBar2: TProgressBar;
    Button1: TButton;
    APNetscapeLabel4: TAPNetscapeLabel;
    Panel2: TPanel;
    Memo1: TMemo;
    Server: TServerSocket;
    Client: TClientSocket;
    ImageList1: TImageList;
    Edit1: TEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Session1: TMenuItem;
    Create1: TMenuItem;
    Join1: TMenuItem;
    N1: TMenuItem;
    Disconnect1: TMenuItem;
    Help1: TMenuItem;
    Contents1: TMenuItem;
    About1: TMenuItem;
    N2: TMenuItem;
    HomePage1: TMenuItem;
    N3: TMenuItem;
    Buffer1: TMenuItem;
    Clear1: TMenuItem;
    SaveAs1: TMenuItem;
    N4: TMenuItem;
    Logging1: TMenuItem;
    Copytoclipboard1: TMenuItem;
    PopupMenu1: TPopupMenu;
    IPAddress1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Create1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure dxBarButton1Click(Sender: TObject);
    procedure Join1Click(Sender: TObject);
    procedure Disconnect1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Clear1Click(Sender: TObject);
    procedure Copytoclipboard1Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure IPAddress1Click(Sender: TObject);
    procedure ServerClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
   Version: String;
   Connected: Boolean;
   Users: TStringList; {Kept Client Side}
   SerUsr: TStringList; {Kept Server Side}
   SerIPdb: TStringList; {Kept Server Side}
   IPdb: TStringList;{Kept Client Side}
   ServerAddress: String;
   MyNickName: String;
   {Creation Variables}
   ServerName: String;
   MaxUsers: Integer;
   WelcomeMessage: TStrings;
   ServerPort: Integer;
   ClDisc: Boolean; {Disconnecting Client Bool}
   {End Creation Variables}
   procedure Echo(Content: String);
   procedure BeginHost(Port: Integer);
   procedure JoinServer(Host: String; Port: Integer);
   procedure ParseCommand(Socket: TCustomWinSocket; Numeric: Integer; Content: String);
   procedure SendToServer(Numeric: Integer; Content: String; Socket: TCustomWinSocket);
   procedure SendToClient(Numeric: Integer; Content: String; Socket: TCustomWinSocket);
   procedure SendToAll(Numeric: Integer; Content: String; Socket: TCustomWinSocket);
   procedure LookupIP;
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Users.Free;
SerUsr.Free;
SerIPdb.Free;
IPdb.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Version := 'Loquacity - Version ' + Build.GetBuildInfoString;
Form1.Caption := Version;
Memo1.Lines.Add(Version + ' ready...');
end;

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
APNetscapeLabel4.Caption := 'Recording';
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
APNetscapeLabel4.Caption := 'Not Recording';
end;

procedure TForm1.Echo(Content: String);
begin
Memo1.Lines.Add(Content);
end;

procedure TForm1.Create1Click(Sender: TObject);
begin
Form2.ShowModal;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin

if key = #13 then
 begin
  key := #0; {Ditch the beep}
  if not Connected then
   begin
    Echo('*Not Connected');
   end;
 {We're Connected, Send the command:}
  SendToServer(106, MynickName + ' ' + Edit1.Text, Client.Socket);
  Edit1.Clear;
  Edit1.SetFocus;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Users := TStringList.Create;
SerUsr := TStringList.Create;
SerIPdb := TStringList.Create;
IPdb := TStringList.Create;
end;

procedure TForm1.JoinServer(Host: String; Port: Integer);
begin
{Here's where we connect}
Client.Port := Port;
Client.Host := Host;
Client.Active := True;
end;

procedure TForm1.BeginHost(Port: Integer);
begin
{Let's start the server}
Server.Port := Port;
Server.Active := True;
Application.ProcessMessages;
{We need to join our own server now}
JoinServer('localhost', ServerPort);
end;

procedure TForm1.ServerClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Echo('*Connection request: ' + Socket.RemoteAddress + ':' + IntToStr(Socket.LocalPort) + ' requesting authentication.');
SerIPdb.Add(Socket.RemoteAddress) {Add this client to our ip database}
end;

procedure TForm1.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Connected := True; {We're Connected to the server}
Echo('*Connected to server: ' + Socket.RemoteAddress + ':' + IntToStr(Socket.RemotePort) + ' sending authentication.');
SendToServer(100, MyNickName, Socket);
end;

procedure TForm1.ServerClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
    Line: string;
    I: Integer;
    FReceiveBuffer: String;
begin
 FReceiveBuffer:=FReceiveBuffer+Socket.ReceiveText;
 I:=Pos(#182,FReceiveBuffer);
 while I>0 do begin
  Line:=Copy(FReceiveBuffer,1,I-1);
  Delete(FReceiveBuffer,1,I);
  Line:=StringReplace(StringReplace(Line,'\n',#182,[rfReplaceAll]),'\\','\',[rfReplaceAll]);
  I:=Pos(' ',Line);
  ParseCommand(Socket, StrToInt(Copy(Line,1,I-1)), Copy(Line, I+1, Length(Line)));
  I:=Pos(#182,FReceiveBuffer);
 end;

end;

procedure TForm1.ParseCommand(Socket: TCustomWinSocket; Numeric: Integer; Content: String);
var
I: Integer;
begin

 case Numeric of
  100: {A client has sent us their nickname}
   begin
   SerUsr.Add(Content);
   SendToAll(101, Content, Socket);
   end;
  101: {The server is telling us who joined}
   begin
    Echo('*' + Content + ' has joined the conversation.');
    {Request updated user list from server}
    SendToServer(102, '', Socket); {No String Required}
   end;
  102: {CLIREQ: Users/Ip's}
   begin
    SendToClient(103, SerUsr.CommaText, Socket); {Send Users}
    SendTOClient(108, SerIPdb.CommaText, Socket); {Send IP's}
   end;
  103: {Recieved user list from server}
   begin
    ListBox1.Clear;
    Users.CommaText := Content;
     for I := 0 to Users.Count-1 do
      begin
       ListBox1.Items.Add(Users.Strings[I]);
      end;
   end;
  104: {Client Sent Disconnect Notice}
   begin
    ClDisc := True;
    SerUsr.Delete(SerUsr.IndexOf(Content)); {Delete the user from the master list}
    SendToAll(105, Content, Socket); {Content=User that left - SendTOAllB=only for this}
    SerIPdb.Delete(SerIPdb.IndexOf(Content)); {Remove this client's ip from the list}
   end;
  105: {Server says someone disconnected!}
   begin
    Echo('*' + Content + ' has left the conversation.');
    Users.Delete(SerUsr.IndexOf(Content));
   {Request updated user list from server}
    SendToServer(102, '', Socket); {No String Required}
   end;
  106: {Client is talking}
   begin
    SendToAll(107, Content, Socket);
   end;
  107: {Server says client is talking}
   begin
   Echo('<' + Token.GetFirstToken(Content) + '> ' + Token.GetRemainingTokens);
   end;
  108: {Server has sent us the list of ip addresses}
   begin
    IPdb.CommaText := Content;
   end;

 end; {Case}

end; {Proc}

procedure TForm1.SendToServer(Numeric: Integer; Content: String; Socket: TCustomWinSocket);
begin
Socket.SendText(Format('%d %s'#182,[Numeric,StringReplace(StringReplace(Content,'\','\\',[rfReplaceAll]),#182,'\n',[rfReplaceAll])]));
end;

procedure TForm1.SendToClient(Numeric: Integer; Content: String; Socket: TCustomWinSocket);
begin
Socket.SendText(Format('%d %s'#182,[Numeric,StringReplace(StringReplace(Content,'\','\\',[rfReplaceAll]),#182,'\n',[rfReplaceAll])]));
end;

procedure TForm1.SendToAll(Numeric: Integer; Content: String; Socket: TCustomWinSocket);
var
 iCount : LONGINT;
begin
 for iCount := 0 to (Server.Socket.ActiveConnections - 1)
  do
   begin
    Server.Socket.Connections[iCount].SendText(Format('%d %s'#182,[Numeric,StringReplace(StringReplace(Content,'\','\\',[rfReplaceAll]),#182,'\n',[rfReplaceAll])]));
   end;
end;

procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
    Line: string;
    I: Integer;
    FReceiveBuffer: String;
begin
 FReceiveBuffer:=FReceiveBuffer+Socket.ReceiveText;
 I:=Pos(#182,FReceiveBuffer);
 while I>0 do begin
  Line:=Copy(FReceiveBuffer,1,I-1);
  Delete(FReceiveBuffer,1,I);
  Line:=StringReplace(StringReplace(Line,'\n',#182,[rfReplaceAll]),'\\','\',[rfReplaceAll]);
  I:=Pos(' ',Line);
  ParseCommand(Socket, StrToInt(Copy(Line,1,I-1)), Copy(Line, I+1, Length(Line)));
  I:=Pos(#182,FReceiveBuffer);
 end;
end;

procedure TForm1.dxBarButton1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Join1Click(Sender: TObject);
begin
Form3.ShowModal;
end;

procedure TForm1.Disconnect1Click(Sender: TObject);
begin
if Server.Active then
 begin
  Server.Active := False;
 end else
  begin
   Echo('*Server wasn''t active.');
  end;

if Client.Active then
 begin
  SendToServer(104, MyNickName, Client.Socket); {Tell the server we're leaving}
  Client.Active := False;
 end else
  begin
   Echo('*No client connection.');
  end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin

if Client.Active then
 begin
  SendToServer(104, MyNickName, Client.Socket); {Tell the server we're leaving}
  Client.Active := False;
 end;
end;

procedure TForm1.Clear1Click(Sender: TObject);
begin
Memo1.Clear;
end;

procedure TForm1.Copytoclipboard1Click(Sender: TObject);
begin
Memo1.SelectAll;
Memo1.CopyToClipboard;
Memo1.SelStart := 0;
end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
Edit1.SetFocus;
end;

procedure TForm1.LookupIP;
begin
Echo('*' + Listbox1.Items[Listbox1.ItemIndex] + '''s' + ' IP Address is ' + IPdb.Strings[ListBox1.ItemIndex] + '.');

end;

procedure TForm1.IPAddress1Click(Sender: TObject);
begin
LookupIP;
end;

procedure TForm1.ServerClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Application.ProcessMessages;
end;

end.


I apologize in advance for my novice coding skills. I hope an expert can make sense of this. and find the problem. :(


I'm going to offer 139 points for this which is all I have right now. Sorry. I feel so cheap.

Thanks in advance,
Psylord
0
Comment
Question by:Psylord
5 Comments
 
LVL 14

Accepted Solution

by:
AvonWyss earned 139 total points
ID: 6197863
The Exceptions you're getting are raised in SendText and ReceiveText, right? At least that's where they would be expected. Anyways, I'd use a TRY...EXCEPT block to detect send/receive errors and handle them correctly.

This could work like this:

try
        S:=Socket.ReceiveText;
except
        on ESocketError do begin
                Socket.Free;
                //maybe exit the loop or procedure here
        end else
                raise; // no socket exception? -> raise to next level
end;

Since the Exception is eliminated when a socket error happens, it will allow your program to continue working as if nothing had happened.

You may also consider switching the sockets to Async mode (if not already done) and to process the disconnect events.
0
 
LVL 1

Expert Comment

by:jadefire98
ID: 6199169
Also there is a problem with the fastnet control that you are using they have taken out of Delphi 6 and replaced with the an componet called Indy... You can download it now for free...

The componet offers NBIO and BIO style networking... YOu should have an understanding of threads to use it though...

The comment above should help with the problem with the Exception being thrown... Does this happen when you send only... other wise you will have to put the exception handling some where else...

Gregg
0
 

Expert Comment

by:TomazB
ID: 6199715
Listening....
0
 

Author Comment

by:Psylord
ID: 6200165
No, actually. I can easily reproduce the error over and over just by hosting a server, and then having someone join it. When they disconnect, it will go KERPOOF! All the rest of the times there are no errors (whilst chatting etc).

About the fastnet controls... I'm not using that. I'm using Delphi 6. ;) As for Indy, never could seem to start to like it hehe.


-Psylord
0
 

Author Comment

by:Psylord
ID: 7293881
No longer working on this.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…
Delivering innovative fully-managed cloud services for mission-critical applications requires expertise in multiple areas plus vision and commitment. Meet a few of the people behind the quality services of Concerto.

930 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now