Langsung aja buka Dhelphi sobat lalu masukan satu persatu SC'y di bawah:
Kurang lebih hasil.y seperti di bawah...
PENAMPAKAN KOEMAZIA v007 VrScoop
BAHAN BAHAN YG HARUS AGAN SEDIAKAN SBB ;
1. SLIDER
2. BUTOON
3.2 VR NUM
4. 1 VRSCOOP
5. 15 LABEL
6. 1 CHEX BOX
7. 5 TIMER
8. 1 MEMO
9. SKIN PROVIDER
10. SKIN MANAGER
11. TCP
12. IP
13. XP
14. 2 SHAPE LED
15. VR LED BLINK
16 6. PANEL
17. STATUS BAR
KURANG LEBIH SEPERTI ITU MENU MASAKAN'Y,
OK...YANG MAU BELAJAR SILAHKAN JANGAN PERNAH GENGSI KARNA ORANG LAIN
SUDAH BISA YG JELAS, TIDAK ADA KATA TERLAMBAT DAN TIDAK ADA YG TIDAK
MUNGKIN SELAMA KITA MAU DAN BERUSAHA INSYA ALLAH BISA ( ORA GENGSI2 MAS)
KITA SAMA SAMA BELAJAR, BERBAGI ITU INDAH SAMA ORANG YG NGERTI..
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, VrLcd, VrControls, VrScope, IdBaseComponent,
IdComponent, IdTCPServer, IdMappedPortTCP, sBevel, sButton, sRadioButton,
sLabel, VrBlinkLed, XPMan, VrScale, sSkinProvider, sSkinManager, sPanel,
acSlider, IdIPWatch, sEdit, ComCtrls, sStatusBar, VrMatrix;
type
TForm1 = class(TForm)
VrNum1: TVrNum;
VrNum2: TVrNum;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
TCP: TIdMappedPortTCP;
sButton1: TsButton;
Timer2: TTimer;
Timer3: TTimer;
XPManifest1: TXPManifest;
Timer4: TTimer;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
CheckBox1: TCheckBox;
Memo1: TMemo;
sSkinManager1: TsSkinManager;
sSkinProvider1: TsSkinProvider;
sPanel1: TsPanel;
IdIPWatch1: TIdIPWatch;
sStatusBar1: TsStatusBar;
Timer5: TTimer;
sPanel2: TsPanel;
VrScope1: TVrScope;
VrScale1: TVrScale;
sPanel3: TsPanel;
Label8: TLabel;
Label7: TLabel;
Label3: TLabel;
Label5: TLabel;
sPanel4: TsPanel;
Label6: TLabel;
sLabel2: TsLabel;
sLabel1: TsLabel;
sSlider1: TsSlider;
VrBlinkLed1: TVrBlinkLed;
sLabel3: TsLabel;
sLabel4: TsLabel;
Label4: TLabel;
Shape1: TShape;
Timer6: TTimer;
Shape2: TShape;
procedure Timer1Timer(Sender: TObject);
procedure TCPExecute(AThread: TIdMappedPortThread);
procedure TCPOutboundData(AThread: TIdMappedPortThread);
procedure sButton1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
private
Tombol:Boolean;
{ Private declarations }
public
{ Public declarations }
Procedure LedBlinkUpload;
Procedure LedBlinkDownload;
end;
var
Form1: TForm1;
Download : Integer;
Upload : Integer;
download2,upload2,download3,upload3:integer;
implementation
{$R *.dfm}
procedure TForm1.LedBlinkUpload;
begin
shape1.Refresh;
if shape1.brush.color=clSilver then
begin
shape1.brush.color:=$0007F513;
end else
begin
shape1.brush.color:=clSilver;
end;
end;
procedure TForm1.LedBlinkDownload;
begin
shape2.Refresh;
if shape2.brush.color=clSilver then
begin
shape2.brush.color:=$000404DD;
end else
begin
shape2.brush.color:=clSilver;
end;
end;
function BytesConvert(Value : DWord) : string;
const
NolKB=0;
OneKB = 1024;
OneMB = OneKB * 1024;
OneGB = OneMB * 1024;
begin
if Value < OneKB then
Result := FormatFloat('#,##0.0 B/s',Value)
else
if Value < OneMB then
Result := FormatFloat('#,##0.0 Kb/s', Value / OneKB)
else
if Value < OneGB then
Result := FormatFloat('#,##0.0 Mb/s', Value / OneMB)
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//Label1.Caption := FormatFloat('0',download/1024);
//Label2.Caption := FormatFloat('0',upload/1024);
//download:= 0;
//upload:= 0;
end;
function AddHeader(header, Newheader:string):string;
begin
header := StringReplace(header, #13#10 + #13#10, #13#10 + Newheader + #13#10 + #13#10, [rfReplaceAll]); Result := header;
end;
procedure TForm1.TCPExecute(AThread: TIdMappedPortThread);
var
Payload,header: string;
begin
LedBlinkUpload;
Memo1.Lines.Add(AThread.NetData);
upload3:=upload3+length(AThread.NetData);
upload2:=upload2+length(AThread.NetData);
upload:= upload+Length(AThread.NetData);
Memo1.Lines.Add(AThread.NetData);
end;
end;
procedure TForm1.TCPOutboundData(
AThread: TIdMappedPortThread);
begin
LedBlinkDownload;
Memo1.Lines.Add(AThread.NetData);
download3:=download3+length(AThread.NetData);
download2:=download2+length(AThread.NetData);
download:= download+Length(AThread.NetData);
AThread.NetData :=StringReplace(AThread.NetData, 'HTTP/1.1 200 Connection established', 'HTTP/1.0 200 Connection established',[rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 301 Moved Permanently','HTTP/1.1 200 OK', [rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 400 Bad Request','HTTP/1.1 200 OK', [rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 400 Bad Request','HTTP/1.1 200 OK', [rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 400 Bad request','HTTP/1.1 200 OK', [rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 504 Gateway Timeout','HTTP/1.1 200 OK', [rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 500 Internal Server Error','HTTP/1.1 200 OK', [rfReplaceAll]);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 403 Forbidden','HTTP/1.1 200 OK', [rfReplaceAll]);
if pos ('HTTP/1.1 200 OK', athread.NetData)<> 0 then begin
end;
end;
procedure TForm1.sButton1Click(Sender: TObject);
begin
if Tombol then
begin
TCP.Active := False;
TCP.Bindings.Clear;
Sleep(100);
sButton1.Caption := 'START';
Tombol := False;
VrBlinkLed1.EnableBlinking:=False;
end else
begin
sButton1.Caption := 'STOP';
TCP.Bindings.Add.IP := '127.0.0.1';
TCP.Bindings.Add.Port := StrToInt('6996');
TCP.MappedHost :='10.1.89.130';
TCP.MappedPort := StrToInt('8000');
TCP.Active := True;
Tombol := True;
VrBlinkLed1.EnableBlinking:=True;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if download2 < 1024 then
sLabel1.Caption := FormatFloat('Recv: ##0.## Bit',download2)
else if (download2 > 1024) and (download2 < 10485) then
sLabel1.Caption := FormatFloat('Recv: ##0.## Kb',download2/1024)
else if (download2 > 1048576) and (download2 < 1073741824) then
sLabel1.Caption := FormatFloat('Recv: ##0.## Mb',download2/1048576)
else if (download2 > 1073741824) and (download2 < 1099511627776) then
sLabel1.Caption := FormatFloat('Recv: ##0.## Gb',download2/1073741824);
if upload2 < 1024 then
sLabel2.Caption := FormatFloat('Send: ##0.## Bit',upload2)
else if (upload2 > 1024) and (upload2 < 1048576) then
sLabel2.Caption := FormatFloat('Send: ##0.## Kb', upload2/1024)
else if (upload2 > 1048576) and (upload2 < 1073741824) then
sLabel2.Caption := FormatFloat('Send: ##0.## Mb', upload2/1048576)
else if (upload2 > 10737418) and (upload2 < 1099511627776) then
sLabel2.Caption := FormatFloat('Send: ##0.## Gb', upload2/1073741824);
end;
procedure TForm1.Timer3Timer(Sender: TObject);
begin
label5.Caption:= BytesConvert(download3);
label3.Caption:= BytesConvert(Upload3);
download3:= 0;
upload3:= 0;
end;
procedure TForm1.Timer4Timer(Sender: TObject);
begin
vrscope1.SetData(0,strtoint(label1.Caption));
vrscope1.SetData(1,strtoint(label2.Caption));
if download3 < 1024 then begin
Label1.Caption := FormatFloat('0',download3);
label9.Caption:= 'bit/s';
vrscope1.MaxValue:= 1024;
end
else if (download3 > 1024) and (download3 < 1048576) then begin
Label1.Caption := FormatFloat('0000000',download3/1024);
label9.Caption:= 'kb/s';
vrscope1.MaxValue:= 1024;
end
else if (download3 > 1048576) and (download3 < 1073741824) then begin
Label1.Caption := FormatFloat('0000000',download3/1048576);
label9.Caption:= 'Mb/s';
vrscope1.MaxValue:= 1024;
end
else if (download3 > 173741824) and (download3 < 1099511627776) then
Label1.Caption := FormatFloat('0000000',download3/1073741824);
vrscope1.MaxValue:= 1024;
if upload3 < 1024 then begin
Label2.Caption := FormatFloat('0',upload3);
vrscope1.MaxValue:= 1024;
label10.Caption:= 'bit/s';
end
else if (upload3 > 1024) and (upload3 < 1048576) then begin
Label2.Caption := FormatFloat('0000000', upload3/1024);
vrscope1.MaxValue:= 1024;
label10.Caption:= 'Kb/s';
end
else if (upload3 > 1048576) and (upload3 < 1073741824) then begin
Label2.Caption := FormatFloat('0000000', upload3/1048576);
vrscope1.MaxValue:= 1024;
label10.Caption:= 'Mb/s';
end
else if (upload3 > 1073741824) and (upload3 < 1099511627776) then begin
Label2.Caption := FormatFloat('0000000', upload3/1073741824);
vrscope1.MaxValue:= 1024;
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked = true then
begin
timer2.Enabled:= true;
end
else if checkbox1.Checked = false then
begin
timer2.Enabled:= false;
end;
end;
procedure TForm1.Timer5Timer(Sender: TObject);
begin
sLabel3.Caption:=TimeToStr(Now);
end;
end;
OK SOB...SEALAMAT MENCOBA DAN SUKSES,...
======================================================================
======================================================================
