« Dua Form yang beriringan
Delphi Thread »

Delphi Client – Server dengan TServerSocket dan TClientSocket

November 21, 2007

Sebagai contoh, server diidentifikasikan oleh 4 byte IP address (misal 10.231.14.124) dengan port yang disediakan untuk melayani client (misal port 1234).
Ketika client (misal 10.231.12.12) melakukan koneksi ke server itu melalui client socket 983, server membuat socket baru yang unik (server client socket) yang meng-handle koneksi client itu misalnya 755. Dan koneksi yang ada adalah server 10.231.14.124 (755) – client 10.231.12.12 (983),

Bila ada client melakukan koneksi ke server port 1234 lagi (misal client 10.231.12.14 dengan socket 678) maka hal yang sama terjadi lagi, koneksi bertambah menjadi server 10.231.14.124 (755) – client 10.231.12.12 (983), server 10.231.14.124 (757) – client 10.231.12.14 (678), Bila ada client melakukan koneksi lagi menjadi
server 10.231.14.124 (755) – client 10.231.12.12 (983),
server 10.231.14.124 (757) – client 10.231.12.14 (678),
server 10.231.14.124 (761) – client 10.231.12.17 (378)

Yang dilakukan server dan client dalam proses ini adalah:
Untuk Server:

  • Socket membuat record dan menunjuk handle pada record ini
  • Melakukan proses bind yang menyiapkan alamat dari server untuk menerima permintaan data
  • Listen, siap menerima client
  • Ketika client datang, menerima dan membuat socket untuk client
  • Menerima dan mengirim data
  • Menutup (close) koneksi client

Untuk Client:

  • Socket membuat record dan menunjuk handle pada record ini
  • Melakukan koneksi ke server dan menunggu hingga server membuat socket baru
  • Menerima dan mengirim data
  • Menutup (close) koneksi client

Contoh berikut implementasi menggunakan TServerSocket untuk server dan TClientSocket untuk client. Prosesnya adalah, client meminta data tertentu dan server merespond dengan data string dengan panjang data 325 char.

Server :
unit Servunit;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ScktComp, StdCtrls, ComCtrls, Math;
type
TForm1 = class(TForm)
ServSock: TServerSocket;
Memo1: TMemo;
btnBroadcast: TButton;
CbEcho: TCheckBox;
Edit1: TEdit;
StaticText1: TStaticText;
Edit2: TEdit;
RichEdit1: TRichEdit;
StaticText2: TStaticText;
Edit3: TEdit;
procedure ServSockClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServSockClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServSockClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServSockListen(Sender: TObject; Socket:
TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnBroadcastClick(Sender: TObject);
procedure ServSockClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure fillMemo(data:string);
private
tekskirim:string;
{ Private declarations }
public
{ Public declarations }
end;

procedure SockRead( Socket: TCustomWinSocket;
var pMem: Pointer;
var SizeRead: integer);
var
Form1: TForm1;

Implementation

{$R *.DFM}

procedure SockRead( Socket : TCustomWinSocket;
var pMem : Pointer;
var SizeRead: integer);
var
Stream : TMemoryStream;
BlockSize : integer;
begin
if Socket.Receivelength > 0 then
begin
BlockSize := Socket.ReceiveLength;
Stream := TMemoryStream.Create;
pMem := AllocMem( BlockSize );
while BlockSize > 0 do
begin
Socket.ReceiveBuf( pMem^, BlockSize );
Stream.Write( pMem^, BlockSize );
BlockSize := Socket.ReceiveLength;
if BlockSize > 0 then
ReAllocMem(pMem, BlockSize)
end;
Stream.Position := 0;
ReAllocMem ( pMem, Stream.Size );
Stream.Read( pMem^, Stream.Size );
SizeRead := Stream.Size;
Stream.Free;
end
else begin
pMem := nil;
SizeRead := 0;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServSock.Port:=strtoint(Edit3.Text);
ServSock.Active := true;
end;

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

procedure TForm1.ServSockClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
with Socket do
Memo1.Lines.Add('connected with: <' + RemoteHost+'>
['+RemoteAddress+']');
Edit2.Text := IntToStr( ServSock.Socket.ActiveConnections );
end;

procedure TForm1.ServSockClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
with Socket do
memo1.lines.add('disconnect: <' + RemoteHost+'>
['+RemoteAddress+']');
Edit2.Text := IntToStr( ServSock.Socket.ActiveConnections );
end;

procedure TForm1.fillMemo(data:string);
var l_answer:string;
begin
if (pos('r1',data)<>0) then
l_answer:='m_number:1'+'*';
if (pos('r2',data)<>0) then
l_answer:='m_number:2'+'*';
if (pos('r3',data)<>0) then
l_answer:='m_number:3'+'*';
l_answer:=l_answer+'vart:'+
inttostr(randomrange(1000,10000))+'*';
l_answer:=l_answer+'batch_1:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'batch_2:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'batch_3:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'c_tote_1:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'c_tote_2:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'c_tote_3:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'l_tote_1:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'l_tote_2:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'l_tote_3:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'preset:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'comp:'+
inttostr(randomrange(1,9))+'*';
l_answer:=l_answer+'batch_no:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'n_flo:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'a_flo:'+
inttostr(randomrange(1000000,9000000))+'*';
l_answer:=l_answer+'temp:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'dens:'+
inttostr(randomrange(1000000,9000000))+'*';
if data='r1' then
begin
l_answer:=l_answer+'s_off:'+'f'+'*';
l_answer:=l_answer+'s_id:'+'f'+'*';
l_answer:=l_answer+'s_del1:'+'f'+'*';
l_answer:=l_answer+'s_del2:'+'f'+'*';
l_answer:=l_answer+'s_del3:'+'f'+'*';
l_answer:=l_answer+'s_stand:'+'t'+'*';
l_answer:=l_answer+'e_tx1:'+'t'+'*';
l_answer:=l_answer+'e_tx2:'+'t'+'*';
l_answer:=l_answer+'e_param:'+'t'+'*';
l_answer:=l_answer+'e_pres:'+'t'+'*';
l_answer:=l_answer+'e_tx:'+'t'+'*';
l_answer:=l_answer+'e_temp:'+'t'+'*';
l_answer:=l_answer+'e_syst:'+'t'+'*';
l_answer:=l_answer+'e_low2:'+'t'+'*';
l_answer:=l_answer+'c_type:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'c_data:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'ID:'+'123'+'*';
end;
if data='r2' then
begin
l_answer:=l_answer+'s_off:'+'t'+'*';
l_answer:=l_answer+'s_id:'+'t'+'*';
l_answer:=l_answer+'s_del1:'+'t'+'*';
l_answer:=l_answer+'s_del2:'+'t'+'*';
l_answer:=l_answer+'s_del3:'+'t'+'*';
l_answer:=l_answer+'s_stand:'+'f'+'*';
l_answer:=l_answer+'e_tx1:'+'f'+'*';
l_answer:=l_answer+'e_tx2:'+'f'+'*';
l_answer:=l_answer+'e_param:'+'f'+'*';
l_answer:=l_answer+'e_pres:'+'f'+'*';
l_answer:=l_answer+'e_tx:'+'t'+'*';
l_answer:=l_answer+'e_temp:'+'t'+'*';
l_answer:=l_answer+'e_sys:'+'t'+'*';
l_answer:=l_answer+'e_low2:'+'t'+'*';
l_answer:=l_answer+'c_type:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'c_data:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'id:'+'456'+'*';
end;
if data='r3' then
begin
l_answer:=l_answer+'s_off:'+'t'+'*';
l_answer:=l_answer+'s_id:'+'t'+'*';
l_answer:=l_answer+'s_del1:'+'t'+'*';
l_answer:=l_answer+'s_del2:'+'t'+'*';
l_answer:=l_answer+'s_del3:'+'t'+'*';
l_answer:=l_answer+'s_stand:'+'t'+'*';
l_answer:=l_answer+'e_tx1:'+'t'+'*';
l_answer:=l_answer+'e_tx2:'+'t'+'*';
l_answer:=l_answer+'e_param:'+'t'+'*';
l_answer:=l_answer+'e_pres:'+'t'+'*';
l_answer:=l_answer+'e_tx:'+'f'+'*';
l_answer:=l_answer+'e_temp:'+'f'+'*';
l_answer:=l_answer+'e_sys:'+'f'+'*';
l_answer:=l_answer+'e_low2:'+'f'+'*';
l_answer:=l_answer+'c_type:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'c_data:'+
inttostr(randomrange(10,90))+'*';
l_answer:=l_answer+'ID:'+'789'+'*';
end;
tekskirim:=l_answer;
end;

procedure TForm1.ServSockClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sBuf : string;
pData : pointer;
Size : integer;
begin
SockRead( Socket, pData, Size );
if Size > 0 then
begin
SetLength( sBuf, Size );
Move( pData^, sBuf[1], Size);
memo1.lines.add('received from ' +
Socket.remotehost+'('+inttostr(Socket.RemotePort)+
'-'+inttostr(Socket.SocketHandle)+')'+':'+sBuf);
FreeMem(pData);
RichEdit1.Lines.Clear;
if (pos('r1',sBuf)<>0) or (pos('r2',sBuf)<>0) or
(pos('r3',sBuf)<>0) then
begin
fillMemo(sBuf);
RichEdit1.Lines.Add(tekskirim+' **'+
inttostr(length(tekskirim))+' char');
end else
RichEdit1.Lines.Add('Echo from Server');
Socket.SendText(tekskirim);
end;
end;

procedure TForm1.ServSockListen(Sender: TObject; Socket: TCustomWinSocket);
begin
with Socket do
Memo1.Lines.Add( LocalHost + ' [' +LocalAddress +
'] listening on port ' + IntToStr(LocalPort) + '...');
end;

procedure TForm1.btnBroadcastClick(Sender: TObject);
var
i : integer;
begin
if ServSock.Socket.ActiveConnections > 0 then
for i:=0 to pred(ServSock.Socket.ActiveConnections) do
ServSock.Socket.Connections[i].SendText( Edit1.Text );
end;

procedure TForm1.ServSockClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0;
memo1.lines.add('IP-error:'+IntToStr(integer(ErrorEvent)));
end;

end.

// Author : Dirk Claessens

Client :
unit ClientUnit;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,ScktComp, StdCtrls;
type
TForm1 = class(TForm)
ClSock: TClientSocket;
Memo1: TMemo;
btnconnect: TButton;
btnDiscon: TButton;
Button1: TButton;
Edit1: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit;
Button2: TButton;
procedure btnconnectClick(Sender: TObject);
procedure ClSockConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure btnDisconClick(Sender: TObject);
procedure ClSockDisconnect(Sender: TObject; Socket:
TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure ClSockRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClSockError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure SockRead( Socket: TCustomWinSocket;
var pMem: Pointer;
var SizeRead: integer);
var
Form1: TForm1;

implementation
{$R *.DFM}
procedure SockRead( Socket : TCustomWinSocket;
var pMem : Pointer;
var SizeRead: integer);
var
Stream : TMemoryStream;
BlockSize : integer;
begin
if Socket.Receivelength > 0 then
begin
BlockSize := Socket.ReceiveLength;
Stream := TMemoryStream.Create;
pMem := AllocMem( BlockSize );
// loop until all read
while BlockSize > 0 do
begin
Socket.ReceiveBuf( pMem^, BlockSize );
Stream.Write( pMem^, BlockSize );
BlockSize := Socket.ReceiveLength;
if BlockSize > 0 then
ReAllocMem(pMem, BlockSize)
end;
Stream.Position := 0;
ReAllocMem ( pMem, Stream.Size );
Stream.Read( pMem^, Stream.Size );
SizeRead := Stream.Size;
Stream.Free;
end
else begin
pMem := nil;
SizeRead := 0;
end;
end;

procedure TForm1.btnconnectClick(Sender: TObject);
begin
clSock.Host := edit1.Text;
ClSock.Port:= StrToInt(Edit2.Text);
clSock.Active := true;
end;

procedure TForm1.ClSockConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
with Socket do
Memo1.Lines.Add('connected to <' + RemoteHost+'>
['+RemoteAddress+']');
button1.enabled := true;
end;

procedure TForm1.btnDisconClick(Sender: TObject);
begin
ClSock.Close;
button1.enabled := false;
end;

procedure TForm1.ClSockDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
with Socket do
Memo1.Lines.Add('disconnected from : <' + RemoteHost+'>
['+RemoteAddress+']');
button1.enabled := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if ClSock.Active then
ClSock.Socket.SendText( edit3.text + #13);
end;

procedure TForm1.ClSockRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sBuf : string;
pData : pointer;
Size : integer;
begin
SockRead( Socket, pData, Size );
if Size > 0 then
begin
SetLength( sBuf, Size );
Move( pData^, sBuf[1], Size);
memo1.lines.add(sBuf+' *** Size:'+
inttostr(length(sBuf))+' Char');
FreeMem(pData);
end;
end;

procedure TForm1.ClSockError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
memo1.lines.add( 'IP-error :' +
IntToStr(integer(ErrorEvent)));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Lines.Clear;
end;

end.

// Author : D. Claessens

This entry was posted on November 21, 2007 at 7:44 am and is filed under Pemrograman.

11 Responses to “Delphi Client – Server dengan TServerSocket dan TClientSocket”

  1. bejitalun Says:

    January 13, 2008 at 12:55 am

    mo minta bantuannya…
    ini pake idTCPServer dan idTCPClient g sih??
    kok jenisnya beda…
    disini TServerSocket, kalo aku pake TIdTCPServer.
    mohon bantuannya…
    ato bisa dikirim lewat email…
    makasih….

    Reply
  2. ctrlf9 Says:

    January 14, 2008 at 1:08 am

    ini pakai TServerSocket dan TClientSocket bukan Indy (TidTCPClient, TidTCPServer) nanti kalau filenya masih ada, saya coba emailkan

    Reply
  3. bejitalun Says:

    January 14, 2008 at 12:03 pm

    nah..itu letaknya dimana?
    aku cari kok g da?
    pa di Internet y?
    TCPServer(Socket)???tapi prosedur2nya kok da yg g da y??

    Reply
  4. ctrlf9 Says:

    January 18, 2008 at 12:56 am

    ya, di tab Internet, prosedurnya ada di event2 nya

    Reply
  5. bivs Says:

    June 2, 2008 at 3:10 pm

    mas saya juga minta TClientSocket ma TServerSocket yang lengkap tinggal ngisntall ja ya plzzzz saya butuh banget .thanks b4na tuh komponen di emailin ja

    Reply
  6. ctrlf9 Says:

    June 2, 2008 at 4:35 pm

    untuk TServerSocket dan TClientSocket udah ada, default bawaannya Delphi, ada di palette komponen tab internet

    Reply
  7. Retha Says:

    June 7, 2008 at 11:37 am

    mas boleh gak share filenya ke akunih…..

    Reply
  8. ctrlf9 Says:

    June 7, 2008 at 12:31 pm

    ok kalau filenya ketemu nanti saya emailkan, ada contoh bagus tentang TServerSocket dan TClientSocket disini : http://delphi.about.com/od/networking/l/aa112602a.htm mungkin bisa memperjelas

    Reply
  9. candra Says:

    June 11, 2008 at 1:41 pm

    mas source beserta component nya kirimin ke email ku dunk

    Reply
  10. ALAN Says:

    November 3, 2008 at 8:57 am

    Mas,aku lagi buat program billing nih…
    tapi aku gak tahu knapa setiap program server jalan dan pas sdah konek kable LAN kok server gak mau akses database tetapi ketika kable LAN dilepas server isa akses database…
    aku pake komponent IdTCPSERVER dan IDTCPCLIENT
    help me..mas..
    aku pake datasbenya mysql…….
    aku bingung kadang dnegan mysql nya…

    Reply
  11. Doel Says:

    November 4, 2008 at 12:25 am

    Saya seudah coba pake TServerSocket dan TClientSocket, ketika program dijalankan ada Pesan error ‘Assincronouse socket error 10061′. itu penebanya apa yah? Makasih

    Reply

Leave a Reply