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:
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
- Mencegah Flicker dan Mempercepat Operasi
- Membaca Ukuran TaskBar Windws
- Rebuild lazarus 2.0.8 dengan fpc 3.2.0 (Win32) - Experimental
- Buat Program aplikasi Trial dengan Registry
- Deteksi VMWare
- Yang Tidak Bisa Dilakukan Turbo Pascal #1
- Form yang selalu berdampingan kemanapun perginya
- Copy, move, delete and rename files
- TXiButton: Stylish Button!
- Image di dalam "Resource"
Last Articles
- 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
- Mengenal PASCALABC.NET
- PascalTalk #4: Obrolan Ringan Seputar IT
- PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
- PascalTalk #2: Membuat Sendiri SMART HOME
Recent Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project 24 days ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 1 months ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 1 months ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 1 months ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 1 months ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 1 months ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 11 months 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