Arsip: contoh sederhana source code Program untuk client server
by saysansay in Articles more 15 years ago 6460
Berikut adalah contoh aplikasi komunikasi client-server
Untuk Server:
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. |
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.
Random Articles
- SayNumber
- Safely Remove USB Mass Storage Device (Unplug/Eject USB)
- Verbal Expression, bikin mainan Regex dengan Pascal jadi gampang
- Validasi Angka Pada Edit
- Form yang selalu berdampingan kemanapun perginya
- Delphi Community Edition - Free
- Firebird - SourceForge December Project of the Month
- Minimize secondary-form ke taskbar
- virus restart pc jika ada kata2 tertentu, delphi bisa bgt
- Cek apakah program sudah berjalan?
Last Articles
- Project Group dalam Lazarus
- FastPlaz Database Explorer
- Release: FastPlaz Super Mom v0.12.22
- PascalClass #3: Web Development with Free Pascal
- Makna Pascal di Pascal Indonesia
- Kulgram : Instalasi Lazarus di Perangkat Berbasis ARM
- PascalClass #1: Analisa Database dan Machine Learning
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
- Mengenal OXYGENE – Pascal For .NET
- PascalTalk #5: UX: Research, Design and Engineer
Recent Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 3 months ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 3 months ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 4 months ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 4 months ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 4 months ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 4 months ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 1 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 8 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 8 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 8 years ago