Newsgroups : Borland : borland.public.delphi.internet.winsock : 2007 May : eidconnectionclosedgracefully.

www.cryer.info
Managed Newsgroup Archive

eidconnectionclosedgracefully.

Subject:eidconnectionclosedgracefully.
Posted by:"handoyo" (hando..@excite.com)
Date:19 May 2007 23:43:42

Hi everyone,I need help please . I’ve got problems in the codes . I got error codes when the client disconnect from the server that says connection closed gracefully.Can someone help me please.Here are the codes.Thanks a lot.

Server :

unit usrv;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdTCPServer, IdSocketHandle, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent,
  IdComponent, Buttons, ExtCtrls, Jpeg, ImgList, ComCtrls, ToolWin,
  IdAntiFreezeBase, IdAntiFreeze, IdStack, SyncObjs,Menus;


  type
    PClient   = ^TClient;
    TClient   = record
    PeerIP        : string[15];
    HostName      : String[40];
    pesan  : boolean;
    Connected,
    LastAction    : TDateTime;
    Thread        : Pointer;
  end;

  TfrmUtm = class(TForm)
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    edmsg: TEdit;
    btkirim: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    lbclt: TListBox;
    detail: TMemo;
    ToolBar1: TToolBar;
    Connect: TToolButton;
    dc: TToolButton;
    ToolButton3: TToolButton;
    ToolButton5: TToolButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Konfigurasi1: TMenuItem;
    RefreshClient1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Laporan1: TMenuItem;
    About1: TMenuItem;
    tmr: TTimer;
    ImageList1: TImageList;
    PopupMenu2: TPopupMenu;
    KirimPesan1: TMenuItem;
    PopupMenu1: TPopupMenu;
    Clear1: TMenuItem;
    srv: TIdTCPServer;
    StatusBar1: TStatusBar;
    IdAntiFreeze1: TIdAntiFreeze;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    procedure FormCreate(Sender: TObject);
    procedure lbcltClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure srvConnect(AThread: TIdPeerThread);
    procedure srvDisconnect(AThread: TIdPeerThread);
    procedure btkirimClick(Sender: TObject);
    procedure ConnectClick(Sender: TObject);
    procedure dcClick(Sender: TObject);
    procedure tmrTimer(Sender: TObject);
    procedure srvExecute(AThread: TIdPeerThread);
    procedure KirimPesan1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
        Clients : TThreadList;
  procedure RefreshListDisplay;
  end;

const
  DefaultServerIP = '127.0.0.1';
  DefaultServerPort = 7676;

var
  frmUtm: TfrmUtm;
  a,c,operator:String;
implementation

{$R *.dfm}

procedure TFrmUtm.RefreshListDisplay;
var
  AClient :PClient;
  i:integer;
begin
  lbClt.Clear;
  with Clients.LockList do
  try
    for i := 0 to Count-1 do
    begin
      AClient := Items[i];
      lbClt.AddItem(AClient.HostName,TObject(AClient));
    end;
  finally
    Clients.UnlockList;
  end;

end;

procedure TfrmUtm.FormCreate(Sender: TObject);
var
  Bindings: TIdSocketHandles;
begin
  Bindings := TIdSocketHandles.Create(srv);
  try
    with Bindings.Add do
    begin
      IP := DefaultServerIP;
      Port := DefaultServerPort;
    end;
    try
      srv.Bindings:=Bindings;
      srv.Active:=True;
      statusbar1.Panels[0].Text:='Server aktif';
    except on E:Exception do
      ShowMessage(E.Message);
    end;
  finally
    Bindings.Free;
  end;
  Clients := TThreadList.Create;
  Clients.Duplicates := dupAccept;
  RefreshListDisplay;

connect.Enabled:=false;
statusbar1.Panels[1].Text:='Klien yang tidak aktif : '+' '+ c;
tmr.Enabled:=true;
dc.Enabled:=true;
end;

procedure TfrmUtm.lbcltClick(Sender: TObject);
var
  SelClient : PClient;
begin
   if lbclt.ItemIndex <> -1 then
    begin
      try
        SelClient := PClient(Clients.LockList.Items[lbclt.ItemIndex]);
        with Detail do
        begin
          Lines.Add('IP : ' + SelClient.PeerIP);
          Lines.Add('Host name : ' + SelClient.HostName);
          Lines.Add('Connected : ' + DateTimeToStr(SelClient.Connected));
         end;
      finally
        Clients.UnlockList;
      end;
    end;
end;
procedure TfrmUtm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ClientsCount : integer;
begin
  try
    ClientsCount := Clients.LockList.Count;
  finally
    Clients.UnlockList;
  end;

  if (ClientsCount > 0) then
    begin
      Action := caNone;
      ShowMessage('Tidak bisa deactivate karna masih ada klien!');
    end
  else
  begin
    srv.Active := False;
    Clients.Free;
  end;
end;

procedure TfrmUtm.srvConnect(AThread: TIdPeerThread);
var
  NewClient: PClient;
begin
  GetMem(NewClient, SizeOf(TClient));

  NewClient.PeerIP      := AThread.Connection.Socket.Binding.PeerIP;
  NewClient.HostName    := GStack.WSGetHostByAddr(NewClient.PeerIP);
  NewClient.pesan       := False;
  NewClient.Connected   := Now;
  NewClient.LastAction  := NewClient.Connected;
  NewClient.Thread      := AThread;
  AThread.Data := TObject(NewClient);
  lbclt.Items.Add(Newclient.HostName);
  try
    Clients.LockList.Add(NewClient);
  finally
    Clients.UnlockList;
  end;
  RefreshListDisplay;
end;

procedure TfrmUtm.srvDisconnect(AThread: TIdPeerThread);
var
  Client: PClient;
begin
  Client := PClient(AThread.Data);
  try
    Clients.LockList.Remove(Client);
  finally
    Clients.UnlockList;
    showmessage('Client Successfull Logout');
  end;
  FreeMem(Client);
  AThread.Data := nil;
  RefreshListDisplay;
end;

procedure TfrmUtm.btkirimClick(Sender: TObject);
var
  SelClient : PClient;
begin
  if lbclt.ItemIndex = -1 then
  begin
    if Sender is TButton then ShowMessage('Please select a client from the list!');
    Exit;
  end;
  try
    SelClient := PClient(Clients.LockList.Items[lbclt.ItemIndex]);
    SelClient.pesan := True;
    showmessage('Message sent');
    edmsg.Text:='';
  finally
    Clients.UnLockList ;
  end;
end;

procedure TfrmUtm.ConnectClick(Sender: TObject);
begin
srv.Active:=true;
statusbar1.Panels[0].Text:='Server active';
connect.Enabled:=false;
dc.Enabled:=true;
end;

procedure TfrmUtm.dcClick(Sender: TObject);
begin
formcreate(sender);
srv.Active:=false;
statusbar1.Panels[0].Text:='Server not active';
connect.Enabled:=true;
dc.Enabled:=false;
end;

procedure TfrmUtm.tmrTimer(Sender: TObject);
begin
a:=TimeToStr(Now);
statusbar1.Panels[2].Text:='Operator : '+ ' ' + a;
end;

procedure TfrmUtm.srvExecute(AThread: TIdPeerThread);
var client: PClient;
    msg:string;
begin
  if not AThread.Terminated and AThread.Connection.Connected then
  begin
  Client := PClient(AThread.Data);
  Client.LastAction := Now;
  if Client.pesan = True then
      begin
        Client.pesan := False;
        msg:=trim(edmsg.Text);
        AThread.Connection.WriteLn(msg);
      end
      else
      exit;
    end;
end;

procedure TfrmUtm.KirimPesan1Click(Sender: TObject);

var
  SelClient : PClient;
begin
  if lbclt.ItemIndex = -1 then
  begin
    if Sender is TButton then ShowMessage('Please select a client from the list!');
    Exit;
  end;
  try
    SelClient := PClient(Clients.LockList.Items[lbclt.ItemIndex]);
    SelClient.pesan := True;
    showmessage('Pesan terkirim');
    edmsg.Text:='';
  finally
    Clients.UnLockList ;
  end;

end;

procedure TfrmUtm.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;

end.

Client :

unit uclt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, IdComponent, IdTCPConnection,
  IdTCPClient, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze, IdException;

type
  Tfrmutm = class(TForm)
    frmclient: TGroupBox;
    pers: TButton;
    dc: TButton;
    ext: TButton;
    Image1: TImage;
    procedure extClick(Sender: TObject);
    procedure persClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
//  DefaultServerIP = '192.168.0.1';
  DefaultServerIP = '127.0.0.1';
  DefaultServerPort = 7676;

var
  frmutm: Tfrmutm;

implementation

uses uBill;

{$R *.dfm}


procedure Tfrmutm.extClick(Sender: TObject);
begin
application.Terminate;
end;

procedure Tfrmutm.persClick(Sender: TObject);
begin
try
    begin
    frmbill.clt.Host := DefaultServerIP;
    frmbill.clt.Port := DefaultServerPort;
    frmbill.clt.Connect;
    frmbill.timer1.Enabled:=true;
    frmbill.Show;
    frmutm.Hide;
    end;
    except
    on E: Exception do MessageDlg ('Error while connecting to SERVER:'+#13+E.Message, mtError, [mbOk], 0);
    end;
end;

end.

Frmbill.pas :

unit uBill;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdAntiFreezeBase, IdAntiFreeze,IdException;

type
  Tfrmbill = class(TForm)
    Button1: TButton;
    msg: TMemo;
    Timer1: TTimer;
    clt: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
//  DefaultServerIP = '192.168.0.1';
  DefaultServerIP = '127.0.0.1';
  DefaultServerPort = 7676;

var
  frmbill: Tfrmbill;

implementation

uses uclt;

{$R *.dfm}

procedure Tfrmbill.Button1Click(Sender: TObject);
begin
  if clt.Connected then
  begin
  clt.Disconnect;
  showmessage('Logout Successfull!');
  frmbill.Close;
  frmutm.Show;
  timer1.Enabled:=false;
  end;
end;

procedure Tfrmbill.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if clt.Connected then
  begin
  clt.Disconnect;
  timer1.Enabled:=false;
  showmessage('Logout Successfull!');
  frmutm.Show;
  end;
end;

procedure Tfrmbill.Timer1Timer(Sender: TObject);
var
  sCommand : string;
begin
if not clt.Connected then Exit;
  sCommand := clt.ReadLn;
  msg.Lines.Add(sCommand);
end;

end.

Replies:

www.cryer.info
Managed Newsgroup Archive