Sisi Server
Berikut ini adalah source code selengkapnya:
unit uServer;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ExtCtrls;
type
TfServer = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
lblIP1: TLabel;
btnClose1: TButton;
lblStart1: TLabel;
lblStop1: TLabel;
btnReset1: TButton;
lblUser1: TLabel;
lblDurasi1: TLabel;
Label8: TLabel;
SS: TServerSocket;
Timer1: TTimer;
Label9: TLabel;
lblIP2: TLabel;
lblStart2: TLabel;
lblStop2: TLabel;
lblUser2: TLabel;
lblDurasi2: TLabel;
btnClose2: TButton;
btnReset2: TButton;
Timer2: TTimer;
Label15: TLabel;
lblIP3: TLabel;
lblStart3: TLabel;
lblStop3: TLabel;
lblUser3: TLabel;
lblDurasi3: TLabel;
btnClose3: TButton;
btnReset3: TButton;
Timer3: TTimer;
Label21: TLabel;
lblIP4: TLabel;
lblStart4: TLabel;
lblStop4: TLabel;
lblUser4: TLabel;
lblDurasi4: TLabel;
btnClose4: TButton;
btnReset4: TButton;
Timer4: TTimer;
Label27: TLabel;
lblIP5: TLabel;
lblStart5: TLabel;
lblStop5: TLabel;
lblUser5: TLabel;
lblDurasi5: TLabel;
btnClose5: TButton;
btnReset5: TButton;
Timer5: TTimer;
procedure SSClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure SSClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fServer: TfServer; à untuk mendeklarasikan variable fServer bertipe TfServer
implementation
uses StrUtils;
{$R *.dfm}
var
n : byte; à untuk mendeklarasikan variable n bertipe byte
vs,vm,vh,ip,NamaUser : array[1..20] of String; à untuk mendeklarasikan variable vs,vm,vh,ip,NamaUser bertipe array[1..20] of String
waktu,s,m,h : array[1..20] of Byte; à untuk mendeklarasikan variable waktu,s,m,h bertipe array[1..20] of Byte byte
procedure TfServer.SSClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
inc(n); à menaikkan variable n
if (n>5 ) then begin à jika n lebih dari 5 maka //kirimpesan("overloaded") karena 5 adalah batas tertinggi dari jumlah client
//kirimpesan("overloaded")
end;
ip[n] := Socket.RemoteAddress ;
if(n=1) then begin à jika n ke 1 ip nya tepat akan terkonecksi
lblIP1.Caption := ip[1] ; timer1.Enabled := true; à waktu akan berjalan
lblStart1.Caption := TimeToStr(time);
ss.Socket.Connections[0].SendText('OK');
end
else if(n=2) then begin lblIP2.Caption := ip[2] ; timer2.Enabled := true; end
à jika n ke 2 ip nya tepat akan terkonecksi dan waktu akan berjalan
else if(n=3) then begin lblIP3.Caption := ip[3] ; timer3.Enabled := true; end
à jika n ke 3 ip nya tepat akan terkonecksi dan waktu akan berjalan
else if(n=4) then begin lblIP4.Caption := ip[4] ; timer4.Enabled := true; end
à jika n ke 4 ip nya tepat akan terkonecksi dan waktu akan berjalan
else if(n=5) then begin lblIP5.Caption := ip[5] ; timer5.Enabled := true; end
à jika n ke 5 ip nya tepat akan terkonecksi dan waktu akan berjalan
end;
procedure TfServer.FormCreate(Sender: TObject);
var i : byte; à untuk mendeklarasikan variable i bertipe byte
begin
n := 0; à variable n diisi data nol
for i := 1 to 20 do begin ip[i] := '000.000.000.000';s[i] := 0;h[i] := 0; m[i] := 0; à untuk i diisi 1 sampai 20
à variable s[i] diisi data nol
à variable h[i] diisi data nol
à variable m[i] diisi data nol
end;
ss.Active :=true; à mengaktifkan ss
end;
procedure TfServer.SSClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var i : byte; à untuk mendeklarasikan variable i bertipe byte
begin
for i:= 1 to n do begin à untuk i diisi 1 sampai n
if Socket.RemoteAddress = ip[i] then
begin //ip[i] := '000.000.000.000'; NamaUser[i] := '';
lblStop1.Caption := TimeToStr(time);
timer1.Enabled := false;
end;
end;
lblIP1.Caption := ip[1] ;
lblUser1.Caption := NamaUser[1] ;
dec(n);
end;
procedure TfServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ss.Active := false; à menonaktifkan ss
end;
procedure TfServer.SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
var i : byte; à untuk mendeklarasikan variable i bertipe byte
sRec : String; à untuk mendeklarasikan variable sRec bertipe string
begin
for i:= 0 to ss.Socket.ActiveConnections - 1 do begin
sRec := Socket.ReceiveText;
if sRec <> '' then begin
if LeftStr(sRec,4)='User' then begin
NamaUser[i+1] := RightStr(sRec,length(sRec)-5);
end;
end;
end;
lblUser1.Caption := NamaUser[1];
end;
function fill(a:string;b:char;n:byte):string;
var
i : byte; à untuk mendeklarasikan variable i bertipe byte
s : string; à untuk mendeklarasikan variable s bertipe string
begin
s:=a; à variable s diiisi data a
for i:= 1 to n - length(a) do à untuk i diisi 1 sampai n
begin
s:=b+s; à variable s diiisi data b+s
end;
fill := s;
end;
procedure TfServer.Timer1Timer(Sender: TObject);
begin
inc(waktu[1]); à menaikkan waktu[1]
s[1] := waktu[1]; à variable s[1] diiisi data waktu[1]
if s[1] >59 then à jika variable a[1] diisi lebihdari 59 maka
begin
inc(m[1]); à menaikkan m[1]
s[1] := 0; à variable s[1] diiisi data 0
waktu[1] := 0; à variable waktu[1] diiisi data 0
end;
if m[1] >60 then à jika variable m1] diisi lebihdari 60 maka
begin
inc(h[1]); à menaikkan h[1]
m[1] := 0; à variable m[1] diiisi data 0
end;
vs[1] := fill(inttostr(s[1]),'0',2);
vm[1] := fill(inttostr(m[1]),'0',2);
vh[1] := fill(inttostr(h[1]),'0',2);
lblDurasi1.Caption := vh[1]+':'+vm[1]+':'+vs[1];
end;
end.
Sisi Client
Berikut ini adalah source code selengkapnya :
unit uClient;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ExtCtrls;
type
TfClient = class(TForm)
Label1: TLabel;
eUser: TEdit;
eServer: TEdit;
Label2: TLabel;
Button1: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CsConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure CsRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fClient: TfClient; à untuk mendeklarasikan variable fClient bertipe TfClient
implementation
var
vs,vm,vh,ip,NamaUser : array[1..20] of String; à untuk mendeklarasikan variable vs,vm,vh,ip,NamaUser bertipe array[1..20] of String
waktu,s,m,h : array[1..20] of Byte; à untuk mendeklarasikan variable waktu,s,m,h bertipe array[1..20] of Byte
{$R *.dfm}
procedure TfClient.Button1Click(Sender: TObject);
begin
if Button1.Caption ='Konek' then begin à jika client akan koneksi tombol/ tulisan Konek akan aktif
cs.Host := eServer.Text;
cs.Active := true;
Button1.Caption := 'Diskonek'; à setelah terkoneksi tombol Konek berganti tombol/muncul tulisan Diskonek
end
else begin à jika client tidak koneksi tombol/ tulisan Konek akan aktif kembali
cs.Active := false;
Button1.Caption := 'Konek';
end;
end;
procedure TfClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
cs.Active := false; à menonaktiflan cs
end;
procedure TfClient.CsConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
cs.Socket.SendText('User:'+eUser.Text);
end;
procedure TfClient.CsRead(Sender: TObject; Socket: TCustomWinSocket);
begin
if (cs.Socket.ReceiveText='OK') then timer1.enabled:=true; à jika terkoneksi maka waktu akan berjalan
end;
function fill(a:string;b:char;n:byte):string;
var
i : byte; à untuk mendeklarasikan variable i bertipe byte
s : string; à untuk mendeklarasikan variable s bertipe string
begin
s:=a; à variable s diisi a
for i:= 1 to n - length(a) do à untuk i diisi 1 sampai n
begin
s:=b+s; à variable s diisi b+s
end;
fill := s;
end;
procedure TfClient.Timer1Timer(Sender: TObject);
begin
inc(waktu[1]); à menaikkan waktu[1]
s[1] := waktu[1]; à variable s[1] diisi waktu[1]
if s[1] >59 then à jika variable s[1] lebihdari 59 maka
begin
inc(m[1]); à menaikkan m[1]
s[1] := 0; à variable s[1] diisi 0
waktu[1] := 0; à variable waktu[1] diisi 0
end;
if m[1] >60 then à jika variable m[1] lebihdari 60 maka
begin
inc(h[1]); à menaikkan h[1]
m[1] := 0; à variable m[1] diisi 0
end;
vs[1] := fill(inttostr(s[1]),'0',2);
vm[1] := fill(inttostr(m[1]),'0',2);
vh[1] := fill(inttostr(h[1]),'0',2);
fClient.Caption := vh[1]+':'+vm[1]+':'+vs[1];
end;
end.
Tidak ada komentar:
Posting Komentar