BorlandTalk.com

handoyo · Guest

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.

Remy Lebeau (TeamB) · Guest

"handoyo" <handoyo (AT) excite (DOT) com> wrote in message
news:464fee1e$1 (AT) newsgroups (DOT) borland.com...