Arsip: contoh sederhana source code Program untuk client server


by saysansay in Articles more 14 years ago 6420
Berikut adalah contoh aplikasi komunikasi client-server
Untuk Server:
unit server2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, Menus, ComCtrls, ExtCtrls, TeEngine, Series, Grids,
TeeProcs, Chart, Buttons;
type
TForm1 = class(TForm)
ServerSocket: TServerSocket;
memo1: TMemo;
MainMenu1: TMainMenu;
File1: TMenuItem;
Listen1: TMenuItem;
Putus1: TMenuItem;
keluar: TMenuItem;
StatusBar: TStatusBar;
Panel3: TPanel;
Edit1: TEdit;
Edit2: TEdit;
Label2: TLabel;
Button1: TButton;
procedure Listen1Click(Sender: TObject);
procedure keluarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Putus1Click(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedureServerSocketClientConnect(Sender:TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source,
HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
server:string;
implementation
{$R .DFM}
procedure TForm1.Listen1Click(Sender: TObject);
begin
listen1.checked :=not listen1.checked;
serversocket.Active:=true;
statusbar.Panels[0].text:='Menunggu sambungan dari client ....'
end;
procedure TForm1.keluarClick(Sender: TObject);
begin
serversocket.Close;
close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
listen1click(nil);
memo1.Clear;
edit1.Clear;
edit2.Clear;
end;
procedure TForm1.Putus1Click(Sender: TObject);
begin
listen1click(nil);
end;
procedure TForm1.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
statusbar.Panels[0].Text:='nyambung ke:'+ socket.RemoteHost;
end;
procedure TForm1.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
begin
edit2.Text:=socket.ReceiveText;
end;
procedure TForm1.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
statusbar.Panels[0].Text:='nyambung ke'+socket.RemoteAddress;
end;
procedure TForm1.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Clear;
end;
procedure TForm1.ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
listen1click(nil);
end;
procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
serversocket.active:=false;
listen1.Checked:= not listen1.Checked;
listen1click(nil)
end;
procedure TForm1.ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source, HelpFile: string;
HelpContext: Integer; var CancelDisplay: Wordbool);
begin
ShowMessage(Description);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
serversocket.Socket.Connections[0].SendText(edit1.Text);
end;
end.


Untuk Client:
unit server2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, Menus, ComCtrls, ExtCtrls, TeEngine, Series, Grids,
TeeProcs, Chart, Buttons;
type
TForm1 = class(TForm)
ServerSocket: TServerSocket;
memo1: TMemo;
MainMenu1: TMainMenu;
File1: TMenuItem;
Listen1: TMenuItem;
Putus1: TMenuItem;
keluar: TMenuItem;
StatusBar: TStatusBar;
Panel3: TPanel;
Edit1: TEdit;
Edit2: TEdit;
Label2: TLabel;
Button1: TButton;
procedure Listen1Click(Sender: TObject);
procedure keluarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Putus1Click(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedureServerSocketClientConnect(Sender:TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source,
HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
server:string;
implementation
{$R  .DFM}
procedure TForm1.Listen1Click(Sender: TObject);
begin
listen1.checked :=not listen1.checked;
serversocket.Active:=true;
statusbar.Panels[0].text:='Menunggu sambungan dari client ....'
end;
procedure TForm1.keluarClick(Sender: TObject);
begin
serversocket.Close;
close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
listen1click(nil);
memo1.Clear;
edit1.Clear;
edit2.Clear;
end;
procedure TForm1.Putus1Click(Sender: TObject);
begin
listen1click(nil);
end;
procedure TForm1.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
statusbar.Panels[0].Text:='nyambung ke:'+ socket.RemoteHost;
end;
procedure TForm1.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
begin
edit2.Text:=socket.ReceiveText;
end;
procedure TForm1.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
statusbar.Panels[0].Text:='nyambung ke'+socket.RemoteAddress;
end;
procedure TForm1.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Clear;
end;
procedure TForm1.ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
listen1click(nil);
end;
procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
serversocket.active:=false;
listen1.Checked:= not listen1.Checked;
listen1click(nil)
end;
procedure TForm1.ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source, HelpFile: string;
HelpContext: Integer; var CancelDisplay: Wordbool);
begin
ShowMessage(Description);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
serversocket.Socket.Connections[0].SendText(edit1.Text);
end;
end.
Unit Untuk client
unit client2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, Menus, ComCtrls, ExtCtrls, Grids, TeEngine, Series,
TeeProcs;
type
TForm1 = class(TForm)
ClientSocket: TClientSocket;
MainMenu1: TMainMenu;
File1: TMenuItem;
nyambung1: TMenuItem;
Putus1: TMenuItem;
keluar: TMenuItem;
StatusBar: TStatusBar;
Label1: TLabel;
Panel2: TPanel;
Memo1: TMemo;
Panel1: TPanel;
Panel3: TPanel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
procedure nyambung1Click(Sender: TObject);
procedure keluarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Putus1Click(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source,
HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
server,col:string;
k:integer;
implementation
{$R *.DFM}
procedure TForm1.nyambung1Click(Sender: TObject);
begin
if clientsocket.Active then clientsocket.Active:=false;
if inputquery('Computer nyambung ke','alamatnya :',server) then
if length(server)>0 then with clientsocket do
begin
host:= server;
active:=true;
statusbar.Panels[0].Text:='Menunggu Jawaban dari ; '+ server;
end;
end;
procedure TForm1.keluarClick(Sender: TObject);
begin
clientsocket.close;
close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Clear;
end;
procedure TForm1.Putus1Click(Sender: TObject);
begin
clientsocket.Close;
statusbar.Panels[0].Text:='';
statusbar.Color:=clbtnface;
end;
procedure TForm1.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
statusbar.Panels[0].Text:='SUDAH NYAMBUNG KE :'+ socket.RemoteHost;
statusbar.Color:=cllime;
end;
procedure TForm1.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
edit2.Text:=socket.ReceiveText;
end;
Procedure TForm1.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Clear;
end;
procedure TForm1.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
memo1.Lines.Add('error nyambung :'+ server) ;
ErrorCode := 0;
end;
procedure TForm1.ServerSocketError(Sender: TObject; Number: Smallint;
var Description: string; Scode: Integer; const Source, HelpFile: string;
HelpContext: Integer; var CancelDisplay: Wordbool);
begin
ShowMessage(Description);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
clientsocket.Socket.SendText(edit1.Text);
end;
end.  

Penjelasan program
1. Kita harus menyamakan port yang akan digunakan (cth 1028), yang terletak pada object inspector masing-masing komponen internet
2. Onclient read dan onserver read, menunjukan ketika server dan client menerima masukan data (text, file)
3. Listening, menunjukan bahwa server dalam keadaan siap menerima client.
4. Onaccept, menunjukan ketika server berhasil menerima masukan dari client.
Nb : untuk yang Make delphi 7 keatas listing ini belum dicoba ..berhasil pada delphi5 dan delphi6...

selamat mencoba.

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com