Sagala Ada Blog: 2015

Selasa, 28 April 2015

CARA BUAT ANIMASI INJECTIONS DENGAN COMMPAS

LANGKAH YG PALING AWAL BIASA BUKA DELPHI SOBAT TERUS MENU;Y SBB

1. 2 vrShadowButton
2. 1 VrAnimared
3. 2 sLabel
4. 2 ShapeBlink
5. 1 Memo
6. 1 vrBlinkled

Itu bahan bahan yg di butuhkan untuk buat inject Animasi Play Stop menggunakan Compass Animasi,,
buat sobat pencinta Delphi sok kita saling berbagi dan belajar bersama, untuk yg tertarik sok ikuti
langkah2 yg sama seperti halayaknya buat inject biasa cuma ini hanya menambahkan variasi di
tampilan inject sobat, silahkan masukan SC'y yg ada di bawah ini :

PENAMPAKAN'Y SEPERTI INI KURANG LEBIH

unit uanimate;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VrControls, VrAnimate, StdCtrls, VrDeskTop, VrBorder, VrLabel,
VrCheckLed, VrButtons, ExtCtrls, sPanel, sSkinManager, sSkinProvider,
sLabel, WinSkinData, SkinCaption, IdBaseComponent, IdComponent,
IdTCPServer, IdMappedPortTCP, VrBlinkLed;

type
TForm1 = class(TForm)
    VrAnimate1: TVrAnimate;
    VrDeskTop1: TVrDeskTop;
    VrShadowButton1: TVrShadowButton;
    VrCheckLed1: TVrCheckLed;
    VrLabel1: TVrLabel;
    VrLabel2: TVrLabel;
    VrCheckLed2: TVrCheckLed;
    VrCheckLed3: TVrCheckLed;
    VrLabel3: TVrLabel;
    VrLabel4: TVrLabel;
    VrShadowButton2: TVrShadowButton;
    sPanel1: TsPanel;
    VrShadowButton3: TVrShadowButton;
    Memo1: TMemo;
    Shape1: TShape;
    Shape2: TShape;
    sPanel2: TsPanel;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    SkinCaption1: TSkinCaption;
    SkinData1: TSkinData;
    IdMappedPortTCP1: TIdMappedPortTCP;
    Timer1: TTimer;
    VrBlinkLed1: TVrBlinkLed;
    procedure Button1Click(Sender: TObject);
    procedure VrAnimate1Notify(Sender: TObject);
    procedure VrCheckLed1Change(Sender: TObject);
    procedure VrCheckLed2Change(Sender: TObject);
    procedure VrCheckLed3Change(Sender: TObject);
    procedure VrShadowButton2Click(Sender: TObject);
    procedure VrShadowButton3Click(Sender: TObject);
    procedure IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
    procedure IdMappedPortTCP1OutboundData(AThread: TIdMappedPortThread);
    procedure Timer1Timer(Sender: TObject);
private
Tombol:Boolean;
    { Private declarations }
public
    { Public declarations }
    Procedure LedBlinkUpload;
Procedure LedBlinkDownload;
end;

var
Form1: TForm1;
      Download : Integer;
    Upload : Integer;
implementation

{$R *.DFM}

INI UNTUK LED BLINK SHAPE DOWNLOAD & UPLOAD MASUKAN DI BAWAH {$R *.DFM}

procedure TForm1.LedBlinkUpload;
begin
shape1.Refresh;

if shape1.brush.color=clSilver then
begin
shape1.brush.color:=clBlue;
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:=clYellow;
end else
begin
shape2.brush.color:=clSilver;
end;
end;

INI MASUKAN DI BAWAH BUTTON DAN KLIK

procedure TForm1.Button1Click(Sender: TObject);
begin
VrShadowButton1.Enabled := false;
VrAnimate1.Active := True;
IdMappedPortTCP1.Bindings.Add.Ip:='127.0.0.1';
IdMappedPortTCP1.Bindings.Add.Port:=StrToInt('4617');
IdMappedPortTCP1.MappedHost:='10.1.89.130';
IdMappedPortTCP1.MappedPort:=StrToInt('8000');
IdMappedPortTCP1.Active:=True;
VrShadowButton1.Enabled:=False;
VrShadowButton2.Enabled:=True;
VrBlinkLed1.EnableBlinking:=True;
end;

INI MASUKAN DI VRANIMATED DIEVENT CARI ON NOTIFY KLIK 1 KALI

procedure TForm1.VrAnimate1Notify(Sender: TObject);
begin
VrShadowButton1.Enabled := True;
end;

INI MASUKAN DI BUTTON STOP

procedure TForm1.VrShadowButton3Click(Sender: TObject);
begin
   VrShadowButton1.Enabled := True;
VrAnimate1.Active := false;
IdMappedPortTCP1.Active:=False;
IdMappedPortTCP1.Bindings.Clear;
VrShadowButton1.Enabled:=True;
VrShadowButton2.Enabled:=False;
VrBlinkLed1.EnableBlinking:=False;
end;

INI MASUKAN DI TCP EXECUTE EVENT

procedure TForm1.IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
begin
var
Payload,header: string;
upload:= upload+Length(AThread.NetData);
LedBlinkUpload;
Memo1.Lines.Add(AThread.NetData);
if (pos('CONNECT',athread.NetData)<>0) or (pos('GET',athread.NetData)<>0) or (pos('POST',athread.NetData)<>0) then
Athread.NetData :=aThread.NetData+ 'GET http://CARI BUG SOBAT/ HTTP/1.1'+#10#13#10#13#10#13+'Connection: Keep-Alive'+#10#13+'Host : CARI BUG DI SINI'#10#13;
end;

end;
end;

INI MASUKAN DI TCP OUTBONDDATA

procedure TForm1.IdMappedPortTCP1OutboundData(
AThread: TIdMappedPortThread);
begin
download:= download+Length(AThread.NetData);
LedBlinkDownload;
Memo1.Lines.Add(AThread.NetData);
AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 402 Forbidden','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 402 Bad Request','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 402 Bad Request','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 402 Bad request','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.0 502 Gateway Timeout','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 502 Internal Server Error','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData,'HTTP/1.1 402 not authenticated','HTTP/1.1 200 OK', [rfReplaceAll]);
    AThread.NetData:=StringReplace(AThread.NetData, 'HTTP/1.1 100 Connection established', 'HTTP/1.0 200 Connection established',[rfReplaceAll])
    end;

INI UNTUK TRAFFIC DOWNLOD DAN UPLOAD, MASUKAN DI TIMER

procedure TForm1.Timer1Timer(Sender: TObject);
begin
sLabel1.Caption := FormatFloat('Dow: ##0. KB/s',download/1024);
sLabel2.Caption := FormatFloat('Upl: ##0. KB/s',upload/1024);
download:= 0;
upload:= 0;
end;

end.

OK SANGAT MUDAH KAN...
SILAHKAN YG MAU NYOBA BISA IKUTI LANGKAH2 DI ATAS YAKIN GA BAKALAN EROR, SEKIAN DULU TUT,Y SMOGA BERMANFAAT

KALO YG DAH JADI SOBAT TINGGAL CEX DI SINI ATAU DI SANA..
======================================================================================

Minggu, 26 April 2015

CARA MEMBUAT SSH MULTI LOG SERVER

Assalamuallaikum...sob..
Kali ini saya akan memberi SC untuk belajar membuat SSH Multi Log Server, Untuk yang mau nyoba silahkan
copy SC'y di bawah ga perlu download tinggal atur sediri da oprek, Penampilan'y kurang lebih seperti gambar di
bawah.

Ok silahkan copy SC'y dan kreasikan sendiri

1. Pertama masukan code ini di bawah {$r * dfm}

{$R *.dfm}
function
KillTask(ExeFileName: string):Integer;
const PROCESS_TERMINATE = $0001;
var ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess( OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;

1. Masukan di Button Login

procedure TForm1.Button1Click(Sender: TObject);
var
HostSSH,PortSSH,UserSSH,PassSSH,HostSSH1,PortSSH1,UserSSH1,PassSSH1,HostSSH2,PortSSH2,UserSSH2,PassSSH2,ProxySSH,lportSSH,loginSSH,loginSSH1,loginSSH2,ptype,Bitvise,akunSSH1,akunSSH2,akunSSH3,akunSSH4:String;
begin
UserSSH:= edit1.Text;
PassSSH:= edit2.Text;
HostSSH:= edit3.Text;
PortSSH:= edit4.Text;
HostSSH1:= edit10.Text;
PortSSH1:= edit11.Text;
UserSSH1:= edit8.Text;
PassSSH1:= edit9.Text;
ProxySSH:= edit5.Text;
lportSSH:= edit6.Text;
ptype := edit7.Text;
begin
edit1.Enabled := False;
edit2.Enabled := False;
edit3.Enabled := False;
edit4.Enabled := False;
edit8.Enabled := False;
edit9.Enabled := False;
edit10.Enabled := False;
edit11.Enabled := False;
if Checkbox1.Checked then
begin
Edit5.Enabled := False;
edit6.Enabled := False;
Edit7.Enabled := False;
loginSSH:=' -host='+HostSSH+' -port='+PortSSH+' -loginOnStartup'+ ' -username='+UserSSH+' -password='+PassSSH+' -proxy=y -proxyType='+ptype+' -ProxyServer='+ProxySSH+' -ProxyPort='+lportSSH+' -menu=small';
loginSSH1:=' -host='+HostSSH1+' -port='+PortSSH1+' -loginOnStartup'+ ' -username='+UserSSH1+' -password='+PassSSH1+' -proxy=y -proxyType='+ptype+' -ProxyServer='+ProxySSH+' -ProxyPort='+lportSSH+' -menu=small';
loginSSH2:=' -host='+HostSSH2+' -port='+PortSSH2+' -loginOnStartup'+ ' -username='+UserSSH2+' -password='+PassSSH2+' -proxy=y -proxyType='+ptype+' -ProxyServer='+ProxySSH+' -ProxyPort='+lportSSH+' -menu=small';
end;
if RadioButton1.Checked then begin
Bitvise:='Bitvise\BvSSh.exe';
akunSSH1:=' -profile=Bitvise\1080.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH1),nil,sw_hide);
end
else
if RadioButton2.Checked then begin
Bitvise:='Bitvise\BvSSh.exe';
akunSSH1:=' -profile=Bitvise\1080.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH1),nil,sw_hide);
akunSSH2:=' -profile=Bitvise\1081.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH2),nil,sw_hide);
end
else
if RadioButton3.Checked then begin
Bitvise:='Bitvise\BvSSh.exe';
akunSSH1:=' -profile=Bitvise\1080.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH1),nil,sw_hide);
akunSSH2:=' -profile=Bitvise\1081.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH2),nil,sw_hide);
akunSSH3:=' -profile=Bitvise\1082.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH2),nil,sw_hide);
end
else
if RadioButton4.Checked then begin
Bitvise:='Bitvise\BvSSh.exe';
akunSSH1:=' -profile=Bitvise\1080.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH1),nil,sw_hide);
akunSSH2:=' -profile=Bitvise\1081.bscp'+loginSSH;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH2),nil,sw_hide);
akunSSH3:=' -profile=Bitvise\1082.bscp'+loginSSH1;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH3),nil,sw_hide);
akunSSH4:=' -profile=Bitvise\1083.bscp'+loginSSH1;
shellexecute(handle,'open',pchar(Bitvise),pchar(akunSSH4),nil,sw_hide);
end
else
if RadioButton1.Checked then
begin
shellexecute(handle,'open',PChar('Proxifier\Proxifier.exe'),PChar(' Proxifier\Profiles\1Akun.ppx silent-load'),NIL,SW_HIDE);
end
else
if RadioButton2.Checked then
begin
shellexecute(handle,'open',PChar('Proxifier\Proxifier.exe'),PChar(' Proxifier\Profiles\2Akun.ppx silent-load'),NIL,SW_HIDE);
end
else
if RadioButton3.Checked then
begin
shellexecute(handle,'open',PChar('Proxifier\Proxifier.exe'),PChar(' Proxifier\Profiles\3Akun.ppx silent-load'),NIL,SW_HIDE);
end
else
if RadioButton4.Checked then
begin
shellexecute(handle,'open',PChar('Proxifier\Proxifier.exe'),PChar(' Proxifier\Profiles\4Akun.ppx silent-load'),NIL,SW_HIDE);
end;
end;

3. Masukan di Button Logout Button2

procedure TForm1.Button2Click(Sender: TObject);
begin
Edit1.Enabled := True;
edit2.Enabled := True;
edit3.Enabled := True;
edit4.Enabled := True;
Edit8.Enabled := True;
edit9.Enabled := True;
edit10.Enabled := True;
edit11.Enabled := True;
if CheckBox1.Checked then
begin
Edit7.Enabled := True;
edit5.Enabled := True;
edit6.Enabled := True;
end;
killtask('BvSSH.exe');
killtask('Proxifier.exe');
end;

4. Klik form 1 kali masukan ini

procedure TForm1.S1Click(Sender: TObject);
var
MyIni: Tinifile;
namafile : string;
begin
with SaveDialog1 do begin
InitialDir:=ExtractFilePath(Application.ExeName);
Filter:='|*.ssh';
end;
if SaveDialog1.Execute then begin
namafile := SaveDialog1.FileName;
if Pos('.Config',namafile) = 0 then namafile := namafile + '.ssh';
myINI := TINIFile.Create(namafile);
Myini.WriteString('Configurations', 'Host', edit3.Text);
Myini.WriteString('Configurations', 'Port', edit4.Text);
myini.WriteString('Configurations', 'Username', edit1.Text);
myini.WriteString('Configurations', 'Password', edit2.Text);
myini.WriteString('Configurations', 'proxyport', edit6.Text);
myINI.Free;
end;
end;

procedure TForm1.S2Click(Sender: TObject);
var
MyIni: Tinifile;
namafile : string;
begin
with SaveDialog2 do begin
InitialDir:=ExtractFilePath(Application.ExeName);
Filter:='|*.ssh';
end;
if SaveDialog2.Execute then begin
namafile := SaveDialog2.FileName;
if Pos('.Config',namafile) = 0 then namafile := namafile + '.ssh';
myINI := TINIFile.Create(namafile);
Myini.WriteString('Configurations', 'Host', edit10.Text);
Myini.WriteString('Configurations', 'Port', edit11.Text);
myini.WriteString('Configurations', 'Username', edit8.Text);
myini.WriteString('Configurations', 'Password', edit9.Text);
myini.WriteString('Configurations', 'proxyport', edit6.Text);
myINI.Free;
end;
end;

procedure TForm1.L2Click(Sender: TObject);
var myINI : TINIFile;
namafile : string;
begin
with OpenDialog1 do begin
InitialDir:=ExtractFilePath(Application.ExeName);
Filter:='*|*.ssh';
end;
if OpenDialog1.Execute then begin
namafile := OpenDialog1.FileName;
myINI := TINIFile.Create(namafile);
edit3.Text:=Myini.ReadString('Configurations', 'Host', edit3.Text);
edit4.Text:=Myini.ReadString('Configurations', 'Port', edit4.Text);
edit1.Text:=myini.ReadString('Configurations', 'Username', edit1.Text);
edit2.Text:=myini.ReadString('Configurations', 'Password', edit2.Text);
edit6.Text:=myini.ReadString('Configurations', 'Proxyport', edit6.Text);
myINI.Free;
end;
end;

procedure TForm1.L3Click(Sender: TObject);
var myINI : TINIFile;
namafile : string;
begin
with OpenDialog2 do begin
InitialDir:=ExtractFilePath(Application.ExeName);
Filter:='*|*.ssh';
end;
if OpenDialog2.Execute then begin
namafile := OpenDialog2.FileName;
myINI := TINIFile.Create(namafile);
edit10.Text:=Myini.ReadString('Configurations', 'Host', edit10.Text);
edit11.Text:=Myini.ReadString('Configurations', 'Port', edit11.Text);
edit8.Text:=myini.ReadString('Configurations', 'Username', edit8.Text);
edit9.Text:=myini.ReadString('Configurations', 'Password', edit9.Text);
edit6.Text:=myini.ReadString('Configurations', 'Proxyport', edit6.Text);
myINI.Free;
end;
end;
end.

Kurang lebih seperti itu selanjutnya selamt berkreasi da mencoba semoga sukses dan bermanfaat..
====================================================================================

Rabu, 22 April 2015

TUTORIAL BUAT INJECT DASAR

Yang paling awal buka Delphi sobat terus buka ke file new form seperti gambar di bawah

Terus kita kasih Button seperti gambar di bawah

Unruk merubah nama Button / Captions jadi 'STAR' lihat gambar di bawah

Untuk merubah nama Caption model text lihat gambar di bawah

Terus untuk memasukan TCP lihat gambar di bwah

Kita ke pemasangan code " START " lihat gambar di bawah

Untuk pemasangan TCPOutbonddata lohat gambar di bawah

Untuk pemasanganTraffic VrNum lihat gambar di bawah

Untuk kepemasangan skin lijat gambar di bawah ( menggunakan Alpha Skin yg ada )

Untuk pemasangan TCPexecute lihat gambar di bawah

Ok sobat Delphi kurang lebih seperti itu cara buat Inject sederhana ala " Koemazia v007 ", Untuk lebih
leren'y bisa kembangkan sendiri, yang mau SC'y bisa ambil di SONO

=========================SMOGA BERMANFA'AT============================

Pos Lain di dalam

1. Koemazia v007 Banjir T-Sel Jawa Barat
2. Koemazia v007 Khusus Jabar
3. T-Sel Update v007 2015
4. Up Dste Tree In One Cibanjaran
5. T-Sel Cibanjaran 4 Varian
6. Spiderman T-Sel
7. Cibanjaran Up Date T-Sel
8. Model Inject Tranfaran
9. Cara Buat Led Blink Inject
10. Cara masukan Gambar ke Form Dhelphi
11. Cara Buat Jam dan Tex Berjalan dengan Dhelphi
12. Bermain Dengan Desktop Ala Delphi
13. Aplikasi Sederhana Untuk Cek Nama dan IP Hardisk
14. Macam2 Inject Work X

CARA BUAT INJECT PEMULA

Get paid to share your links!

CARA BUAT INJECT DASAR

Oke buat sobat yang mau nyoba belajar buat inject bisa lihat langkah2'y di bawah

Untuk ramuan yg perlu di sediakan adalah sbb :

1. 2 Buah Button
2. 1 Panel ( Kalo Mau )
3. 2 Bevel ( Kalo Mau )
4. 2 Shape led
5. 2 Edit
6. 10 Label
7. 2 VrNum
8. 1 Timer
9. 1 IdMappedPortTCP2
10. 1 IdIPWatch1
11. 1 sSkinManager1
12. 1 sSkinProvider1

Mungkin itu yg di perlukan untuk sementara pembuatan yg sederhana'

UNTUK PENAMPAKAN'Y SEPERTI BERIKUT

MASUKAN DI BUTTON START
masukan code ini

procedure TForm1.Button1Click(Sender: TObject);
begin
    if Tombol then
begin
TCP.Active := False;
TCP.Bindings.Clear;
Sleep(100);
Button1.Caption := 'START';
Tombol := False;
end
else
begin
Button1.Caption := 'STOP';
TCP.Bindings.Add.IP := '127.0.0.1';
TCP.Bindings.Add.Port := StrToInt(Edit3.Text);
TCP.MappedHost :=Edit1.Text;
TCP.MappedPort := StrToInt(Edit2.Text);
TCP.Active := True;
Tombol := True;
end;
end;

MASUKAN DI TCP EXECUTE

procedure TForm1.TCPExecute(AThread: TIdMappedPortThread);
var temp:string;
begin

//payload 1
if (pos('CONNECT',athread.NetData)<>0) or (pos('GET',athread.NetData)<>0) or (pos('POST',athread.NetData)<>0) then
Athread.NetData :=aThread.NetData+ 'method http://bug.com/ HTTP/1.1'+#13#10+'Host: bug.com'#13#10#13#10#13#10;

// payload 2

if pos('CONNECT',athread.NetData)<>0 then
begin

temp :='Method http://bug.com/ HTTP/1.1'#13#10#13#10#13#10#13#10;
athread.OutboundClient.Write( 'method http://bug.com/ HTTP/1.1'#13#10);
athread.OutboundClient.Write('Host: bug.com'#13#10);
athread.OutboundClient.Write('Proxy-Connection: Keep-Alive'#13#10#13#10);
athread.OutboundClient.Write(#13);
athread.OutboundClient.Write(#10);
athread.OutboundClient.Write(#13);
athread.OutboundClient.Write(#10);
athread.OutboundClient.Write(#13);
athread.OutboundClient.Write(#10);
athread.netdata := athread.NetData+#13#10#13#10 ;
end;

// payload 3
if Pos ('CONNECT', AThread.NetData) <>0 then begin
Athread.NetData :='MOVE http://bug.com/ HTTP/1.1'#13#10'Host : bug.com'#13#10#13#10;
end;

// Payload 4
if Pos ('CONNECT', AThread.NetData) <>0 then begin
     AThread.NetData := StringReplace(AThread.NetData,'443','443@tri.co.id@',[rfReplaceAll]);
end;

end;

MASUKAN DI TCP OUTBOUNDDATA

procedure TForm1.TCPOutboundData(
AThread: TIdMappedPortThread);
begin
download:= download+Length(AThread.NetData);
AThread.NetData := stringreplace(AThread.NetData,' 403 Forbidden',' 200 OK',[rfReplaceAll]);
AThread.NetData := StringReplace(AThread.NetData,'HTTP/1.1 302 Found','HTTP/1.1 200 Ok',[rfReplaceAll, rfIgnoreCase]); //

if Pos (' 403 Forbidden', AThread.NetData) <>0 then begin
AThread.NetData :='HTTP/1.0 200 OK';
AThread.NetData := StringReplace(AThread.NetData,' 403 Forbidden',' 200 OK',[rfReplaceAll]);
end;

end;

MASUKAN DI TIMER

procedure TForm1.Timer1Timer(Sender: TObject);
begin

label1.Caption := FormatFloat('Down: ##0.## KB/s',download/1024);
label2.Caption := FormatFloat('Up: ##0.## KB/s',upload/1024);
download:= 0;
upload:= 0;
end;
end.

TERUS MASUKAN DI VRNUM
SAMA PAKE LABEL SEPERTI DI TIMER DI ATAS

sLabel3.Caption := FormatFloat('0',download/1024);
sLabel4.Caption := FormatFloat('0',upload/1024);
VrNum1.Value := StrToInt (sLabel1.Caption);
VrNum2.Value := StrToInt (sLabel2.Caption);
download:= 0;
upload:= 0;

UNTUK LED BLINK MASUKAN CODE INI DI BAWAH
var
Form1: TForm1;

implementation

{$R *.dfm}

buat procedure pada project

Code:
procedure TForm1.LedBlinkUpload;
begin
shape1.Refresh;

if shape1.brush.color=clSilver then
begin
shape1.brush.color:=clLime;
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:=clAqua;
end else
begin
shape2.brush.color:=clSilver;
end;
end;

LALU MASUKAN CODE JADI SERTI INI DI BAWAH

private
    { Private declarations }
public
    { Public declarations }
end;

Procedure LedBlinkUpload;
Procedure LedBlinkDownload;

DI EXECUTE MASUKAN INI DI BAWAH BEGIN

LedBlinkUpload;

DI OUTBOUNDDATA MASUKAN INI

LedBlinkDownload;

Get paid to share your links!

Nah kalo ga salah kurang lebih seperti itu kalo ada yg salah mohon maaf, buat sobat yg mao belajar sok tinggal
ikuti langkah2 di atas insyaallah bisa dan sukses, kalo dah bisa kan minimal buat di pake sendiri dan ga perlu
kesana kemari untuk cari Inject yg trial dan ga maksimal, kalo bisa sendiri kita kan bisa buat yg lebih wuzz..
dan bisa cari bug sendiri yg masih virgin di jamin bakalan waz wiz wuz...hehehe..
Ok sob mungkin hanya itu yg bisa saya share dalam membuat Inject sederhana ala Koemazia v007, yg terakhir saya doakn
semoga sukses
=========================================================================
Untuk Tutorial Gambar.y lihat di sini

Get paid to share your links!

CARA BUAT JAM DIGIT TANPA SC

KURANG LEBIH SEPERTI INI TAMPILAN'Y

Get paid to share your links!

Untuk Pembuatan cukup

1. VrLedClock ada di TMS IWS 5
2. VrScanner sda si TMS IWS 1
Tinggal Rubah dari Properties dari False Ke True.
Itu aja cara'y untuk tampilan silahkan kreasikan sendiri di Alva skin atau VLC skin.
terimakasih s'lamat mencoba dan bermanfaat.

untuk yang sudah jadi bisa DOWNLOAD di SINI Black Digit dan di SONO Wod Digit
=========================================================================

Get paid to share your links!

Pos Lain di dalam

1. Koemazia v007 Banjir T-Sel Jawa Barat
2. Koemazia v007 Khusus Jabar
3. T-Sel Update v007 2015
4. Up Dste Tree In One Cibanjaran
5. T-Sel Cibanjaran 4 Varian
6. Spiderman T-Sel
7. Cibanjaran Up Date T-Sel
8. Model Inject Tranfaran
9. Cara Buat Led Blink Inject
10. Cara masukan Gambar ke Form Dhelphi
11. Cara Buat Jam dan Tex Berjalan dengan Dhelphi
12. Bermain Dengan Desktop Ala Delphi
13. Aplikasi Sederhana Untuk Cek Nama dan IP Hardisk
14. Macam2 Inject Work X

Selasa, 21 April 2015

CARA BUAT MP3 PLAYER SEDERHANA DENGAN DELPHI 7

Silahkan SC'y di bawah tinggal copy aja. Untuk MP3 Sederhana Koemazia v007 Penampakan di bawah

Player Mp3 Sederhana Koemazia v007

Untuk bahan2 silahkan atur aendiri kalo2 ingin alat2 yg lebih keren kembangkan sendiri, ini SC'y :

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, MPlayer, Menus, MMSystem, Buttons;

const
// Untuk set volume
MCI_SETAUDIO = $0873;
MCI_DGV_SETAUDIO_VOLUME = $4002;
MCI_DGV_SETAUDIO_ITEM = $00800000;
MCI_DGV_SETAUDIO_VALUE = $01000000;
MCI_DGV_STATUS_VOLUME = $4019;

type
// Untuk set volume
MCI_DGV_SETAUDIO_PARMS = record
    dwCallback: DWORD;
    dwItem: DWORD;
    dwValue: DWORD;
    dwOver: DWORD;
    lpstrAlgorithm: PChar;
    lpstrQuality: PChar;
end;
MCI_STATUS_PARMS = record
    dwCallback: DWORD;
    dwReturn: DWORD;
    dwItem: DWORD;
    dwTrack: DWORD;
end;
// -----------------------------

TForm1 = class(TForm)
    pnJudul: TPanel;
    btPlay: TButton;
    ScrollBar1: TScrollBar;
    btStop: TButton;
    btOpen: TButton;
    btNext: TButton;
    btPrev: TButton;
    lbJudul: TLabel;
    Panel2: TPanel;
    barVolume: TTrackBar;
    cekRepeat: TCheckBox;
    lvPlaylist: TListView;
    pnWaktu: TPanel;
    OpenDialog1: TOpenDialog;
    mplayer: TMediaPlayer;
    tmJudul: TTimer;
    tmProgress: TTimer;
    PopupMenu1: TPopupMenu;
    ambahFile1: TMenuItem;
    Hapus1: TMenuItem;
    N1: TMenuItem;
    SimpanPlaylist1: TMenuItem;
    LoadPlaylist1: TMenuItem;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    btLoadpls: TButton;
    btSimpanpls: TButton;

    // procedure/function tambahan
    function FormatWaktu(milidetik: integer): string;
    function TambahListLagu(namafile: string): boolean;
    procedure AturIndexLagu;
    function MainkanLagu: boolean;
    procedure LaguBerikut;
    procedure LaguSebelum;
    procedure SimpanPlaylist(namafile: string);
    procedure LoadPlaylist(namafile: string);
    // ------------------------------------------------

    procedure btOpenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btPlayClick(Sender: TObject);
    procedure lvPlaylistDblClick(Sender: TObject);
    procedure tmJudulTimer(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure tmProgressTimer(Sender: TObject);
    procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure btNextClick(Sender: TObject);
    procedure Hapus1Click(Sender: TObject);
    procedure ambahFile1Click(Sender: TObject);
    procedure barVolumeChange(Sender: TObject);
    procedure btPrevClick(Sender: TObject);
    procedure mplayerNotify(Sender: TObject);
    procedure lvPlaylistDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lvPlaylistDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure SimpanPlaylist1Click(Sender: TObject);
    procedure LoadPlaylist1Click(Sender: TObject);
    procedure btSimpanplsClick(Sender: TObject);
    procedure btLoadplsClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lvPlaylistAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure mplayerClick(Sender: TObject; Button: TMPBtnType;
      var DoDefault: Boolean);
    procedure lbJudulClick(Sender: TObject);
    procedure pnWaktuClick(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
protected
    // Drag & drop file from explorer
    procedure WMDROPFILES(var msg : TWMDropFiles); message WM_DROPFILES;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    // -----------------------------------------------------------------
public
    { Public declarations }
end;

var
Form1: TForm1;
idxLagu: integer;

implementation

{$R *.dfm}

uses ShellApi;

{ Set Volume, range 0 - 1000
sumber: http://delphi.about.com/od/adptips2006/qt/mediaplayer_vol.htm }
procedure MPSetVolume(MP: TMediaPlayer; Volume: Integer) ;
var
p: MCI_DGV_SETAUDIO_PARMS;
begin
p.dwCallback := 0;
p.dwItem := MCI_DGV_SETAUDIO_VOLUME;
p.dwValue := Volume;
p.dwOver := 0;
p.lpstrAlgorithm := nil;
p.lpstrQuality := nil;
mciSendCommand(MP.DeviceID, MCI_SETAUDIO, MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p)) ;
end;

function MPGetVolume(MP: TMediaPlayer): Integer;
var
p: MCI_STATUS_PARMS;
begin
p.dwCallback := 0;
p.dwItem := MCI_DGV_STATUS_VOLUME;
mciSendCommand(MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p)) ;
Result := p.dwReturn;
end;
// -----------------------------------------------------------------------------

// Drag & drop file from explorer
procedure TForm1.WMDROPFILES(var msg: TWMDropFiles);
var
i, fileCount: integer;
namafile: array[0..MAX_PATH] of char;
begin
fileCount:=DragQueryFile(msg.Drop, $FFFFFFFF, namafile, MAX_PATH);
for i := 0 to fileCount - 1 do begin
    DragQueryFile(msg.Drop, i, namafile, MAX_PATH);
    TambahListLagu(namafile);
end;
DragFinish(msg.Drop);
end;

procedure TForm1.CreateWnd;
begin
inherited;
DragAcceptFiles(Handle, True);
end;

procedure TForm1.DestroyWnd;
begin
DragAcceptFiles(WindowHandle, false);
inherited;
end;
// -----------------------------------------------------------------------------

function TForm1.FormatWaktu(milidetik: integer): string;
var
menit, detik: integer;
begin
detik := milidetik div 1000;
menit := detik div 60;
detik := detik - (menit*60);
Result := IntToStr(menit) + ':' + IntToStr(detik);
Result := Format('%.*d:%.*d', [2, menit, 2, detik]);
end;

function TForm1.TambahListLagu(namafile: string): boolean;
var
i: integer;
begin
Result := True;

// Jika extensi file bukan .mp3, jangan tambahkan
if ExtractFileExt(namafile) <> '.mp3' then Exit;

// Cek apakah file sudah ada di list
for i:=0 to lvPlaylist.Items.Count-1 do begin
    if lvPlaylist.Items[i].Caption = namafile then begin
      lvPlaylist.ClearSelection;
      lvPlaylist.Items[i].Selected := True;
      Exit;
    end;
end;

// Jika lagu sedang aktif, stop dulu
if (mplayer.Mode = mpPaused) or (mplayer.Mode = mpPlaying) then btStop.Click;

mplayer.Close;
mplayer.FileName := namafile;
try
    mplayer.Open;
    with lvPlaylist.Items.Add do begin
      Caption := namafile;
      SubItems.Add(FormatWaktu(mplayer.Length));
      SubItems.Add( ChangeFileExt( ExtractFileName(namafile), '' ) );
    end;
except
    Result := False;
end;
end;

// perbaiki index lagu saat ada item yg dihapus atau diubah urutan }
procedure TForm1.AturIndexLagu;
var
i: integer;
begin
if (mplayer.FileName <> '') and (lvPlaylist.Items.Count > 0) then begin
    for i:=0 to lvPlaylist.Items.Count-1 do begin
      if lvPlaylist.Items[i].Caption = mplayer.FileName then begin
        idxLagu := i;
        Exit;
      end;
    end;
    idxLagu := 0;
end;
end;

function TForm1.MainkanLagu: boolean;
begin
Result := False;
if lvPlaylist.Items.Count < 1 then Exit;
lbJudul.Caption := lvPlaylist.Items[idxLagu].SubItems[1];
pnWaktu.Caption := lvPlaylist.Items[idxLagu].SubItems[0];
mplayer.Close;
mplayer.FileName := lvPlaylist.Items[idxLagu].Caption;
lvPlaylist.ClearSelection;
lvPlaylist.Items[idxLagu].Selected := True;
try
    mplayer.Open;
    lvPlaylist.Refresh;
    lbJudul.Left := pnJudul.Left + pnJudul.Width;
    ScrollBar1.Max := mplayer.Length;
    tmJudul.Enabled := True;
    tmProgress.Enabled := True;
    Sleep(500);
    mplayer.Play;
    btPlay.Caption := 'Pause';
    Result := True
except
    Sleep(1000);
    btNext.Click;
end;
end;
procedure TForm1.LaguBerikut;
begin
if idxLagu < lvPlaylist.Items.Count-1 then
    idxLagu := idxLagu + 1
else
    idxLagu := 0;
MainkanLagu;
end;

procedure TForm1.SimpanPlaylist(namafile: string);
var
f: textfile;
i: integer;
begin
AssignFile(f, namafile);
Rewrite(f);
for i:=0 to lvPlaylist.Items.Count-1 do
    Writeln(f, lvPlaylist.Items[i].Caption);
CloseFile(f);
end;

procedure TForm1.LoadPlaylist(namafile: string);
var
f: textfile;
txt: string;
begin
if not FileExists(namafile) then Exit;
lvPlaylist.Items.Clear;
AssignFile(f, namafile);
Reset(f);
while not EOF(f) do begin
    Readln(f, txt);
    TambahListLagu(txt);
end;
CloseFile(f);
end;

procedure TForm1.LaguSebelum;
begin
if idxLagu <= 0 then
    idxLagu := lvPlaylist.Items.Count-1
else
    idxLagu := idxLagu - 1;
MainkanLagu;
end;

MASUKAN DI BUTTON 1

procedure TForm1.btOpenClick(Sender: TObject);

i: integer;
namafile, errorMsg: string;
jumError: integer;
begin
OpenDialog1.Title := 'Tambahkan lagu';
OpenDialog1.Filter := 'Mp3 Files|*.mp3';
OpenDialog1.DefaultExt := '.mp3';
if OpenDialog1.Execute then begin
    errorMsg := '';
    jumError := 0;
    for i:=0 to OpenDialog1.Files.Count-1 do begin
      namafile := OpenDialog1.Files[i];
      if not TambahListLagu(namafile) then begin
        Inc(jumError);
        errorMsg := errorMsg + #13 + namafile;
      end;
    end;
    if jumError > 0 then begin
      errorMsg := IntToStr(jumError)+ ' file tidak bisa ditambahkan :' +errorMsg;
      MessageDlg(errorMsg, mtError, [mbOk], 0);
    end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Set property default saat aplikasi dijalankan
with lvPlaylist do begin
    DragMode := dmAutomatic;
    RowSelect := True;
    MultiSelect := True;
    ViewStyle := vsReport;
end;
with mplayer do begin
    TimeFormat := tfMilliseconds;
    Notify := True;
end;
with barVolume do begin
    Min := 0;
    Max := 1000;
    Position := MPGetVolume(mplayer);
end;
lbJudul.Caption := '';
tmJudul.Enabled := False;
pnWaktu.Caption := '00:00';
tmProgress.Enabled := False;
idxLagu := 0;

// Load list lagu sebelumnya jika ada
LoadPlaylist(ExtractFilePath(Application.ExeName) + 'listLagu.lst');
end;

MASUKAN DI BUTON 2

procedure TForm1.btPlayClick(Sender: TObject);
begin
if btPlay.Caption = 'Play' then begin
    if mplayer.Mode = mpPaused then begin
      mplayer.Pause;
    end else
      MainkanLagu;
    btPlay.Caption := 'Pause';
end else begin
    mplayer.Pause;
    lbJudul.Font.Color := clRed;
    lbJudul.Caption := lbJudul.Caption + ' (Paused)';
    pnWaktu.Enabled := False;
    btPlay.Caption := 'Play';
end;
end;

procedure TForm1.lvPlaylistDblClick(Sender: TObject);
begin
if lvPlaylist.Items.Count < 1 then Exit;
idxLagu := lvPlaylist.Selected.Index;
MainkanLagu;
end;

LETAKAN DI TIMER1

procedure TForm1.tmJudulTimer(Sender: TObject);
begin
if (lbJudul.Left + lbJudul.Width) <= 0 then
    lbJudul.Left := pnJudul.Left + pnJudul.Width else
    lbJudul.Left := lbJudul.Left - 1;
end;

MASUKAN DI BUTON STOP

procedure TForm1.btStopClick(Sender: TObject);
begin
mplayer.Stop;
tmProgress.Enabled := False;
tmJudul.Enabled := False;
pnWaktu.Caption := FormatWaktu(mplayer.Length);
ScrollBar1.Position := 0;
lbJudul.Left := 8;
btPlay.Caption := 'Play';
end;

LETAKAN DI TIMER2

procedure TForm1.tmProgressTimer(Sender: TObject);
begin
if mplayer.Error <> 0 then Exit;
if mplayer.Position < mplayer.Length then begin
    ScrollBar1.Position := mplayer.Position;
    pnWaktu.Caption := FormatWaktu(mplayer.Length - mplayer.Position);
end else begin
    if (idxLagu = lvPlaylist.Items.Count - 1) and
    // jika sudah di list terakhir dan checkbox "kembali ke awal" tidak dipilih, stop
      (cekRepeat.Checked = False) then btStop.Click
    else
      LaguBerikut;
end;
end;

MASUKAN DI ON SCROOLL BAR EVENT

procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
begin
mplayer.Position := ScrollBar1.Position;
mplayer.Play;
btPlay.Caption := 'Pause';
end;

MASUKAN DI BUTTON NEXT

procedure TForm1.btNextClick(Sender: TObject);
begin
LaguBerikut;
end;

TAMBAHKAN DI FILE MENU HAPUS

procedure TForm1.Hapus1Click(Sender: TObject);
begin
lvPlaylist.DeleteSelected;
AturIndexLagu;
end;

MASUKAN DI FILE TAMBAH CTRL+O

procedure TForm1.ambahFile1Click(Sender: TObject);
begin
btOpen.Click;
end;

procedure TForm1.barVolumeChange(Sender: TObject);
begin
MPSetVolume(mplayer, barVolume.Position) ;
end;

MASUKAN DI BUTTON PREV

procedure TForm1.btPrevClick(Sender: TObject);
begin
LaguSebelum;
end;

procedure TForm1.mplayerNotify(Sender: TObject);
begin
if mplayer.Mode = mpPlaying then begin
    lbJudul.Caption := StringReplace(lbJudul.Caption, ' (Paused)', '', [rfIgnoreCase]);
    lbJudul.Font.Color := clLime;
end;
mplayer.Notify := True;
end;
{ Mengurutkan item listview
sumber: http://delphi.about.com/od/vclusing/a/arrangelistview.htm }
procedure TForm1.lvPlaylistDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
currentItem, nextItem, dragItem, dropItem : TListItem;
begin
if Sender = Source then
begin
    with TListView(Sender) do
    begin
      dropItem := GetItemAt(X, Y) ;
      currentItem := Selected;
      while currentItem <> nil do
      begin
        nextItem := GetNextItem(currentItem, SdAll, [IsSelected]) ;
        if Assigned(dropItem) then
          dragItem := Items.Insert(dropItem.Index)
        else
          dragItem := Items.Add;
        dragItem.Assign(currentItem) ;
        currentItem.Free;
        currentItem := nextItem;
      end;
    end;
    AturIndexLagu;
end;
end;

procedure TForm1.lvPlaylistDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := Sender = lvPlaylist;
end;
//
-----------------------------------------------------------------------------
TAMBAHKAN DI SIMPAN PLAYLIST

procedure TForm1.SimpanPlaylist1Click(Sender: TObject);
begin
btSimpanpls.Click;
end;

TAMBAHKAN DI LOAD PLAY;IST

procedure TForm1.LoadPlaylist1Click(Sender: TObject);
begin
btLoadpls.Click;
end;

MASUKAN DI SIMPAN PLY LIST

procedure TForm1.btSimpanplsClick(Sender: TObject);
begin
if lvPlaylist.Items.Count < 1 then begin
    MessageDlg('Playlist masih kosong!', mtInformation, [mbOk], 0);
    Exit;
end;
SaveDialog1.Title := 'Simpan playlist';
SaveDialog1.Filter := 'Playlist Files|*.lst';
SaveDialog1.DefaultExt := '.lst';
if SaveDialog1.Execute then
    SimpanPlaylist(SaveDialog1.FileName);
end;

MASUKAN DI LOAD BUTTON

procedure TForm1.btLoadplsClick(Sender: TObject);
begin
OpenDialog1.Title := 'Load playlist';
OpenDialog1.Filter := 'Playlist Files|*.lst';
OpenDialog1.DefaultExt := '.lst';
if OpenDialog1.Execute then
    LoadPlaylist(OpenDialog1.FileName);
end;

      MASUKAN DI FORM EVENT DESTORY

procedure TForm1.FormDestroy(Sender: TObject);
begin
// Simpan list lagu untuk di-load kembali saat app dijalankan
SimpanPlaylist( ExtractFilePath(Application.ExeName) + 'listLagu.lst' );
end;

procedure TForm1.lvPlaylistAdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
begin
// lagu yg sedang aktif, font tebal
if Item.Index = idxLagu then
    Sender.Canvas.Font.Style := [fsBold] else
    Sender.Canvas.Font.Style := [];
end;

MASUKAN DI BUTTON 4

procedure TForm1.mplayerClick(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
begin

end;

end.

OK Sob slamat berjuang dan berkreasi sendiri, smoga sukses,
=============================berbagi itu indah================================

CARA PASANG VRSCOOP DI INJECT

Get paid to share your links!

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;

Get paid to share your links!

OK SOB...SEALAMAT MENCOBA DAN SUKSES,...
======================================================================