Cara membuat dial up dilengkapi ip hunter dengan delphi 7

Jumpa lagi di dunia coding delphi 7, kali ini saya akan mencoba berbagi cara membuat dial-up yang dilengkapi dengan fitur ip hunter, walau sebenarnya dalam fitur bawaan windows sendiri sudah ada fasilitas untuk membuat dial-up modem, tapi yang membedakan dengan aplikasi yang akan kita buat kali ini adalah fitur ip hunter, kalau anda sedang mencari artikel tentang cara membuat dial-up di windows 7, mungkin bisa terbantu dengan artikel saya terdahulu tentang 

Apa itu dial-up?

Dial-up adalah aplikasi atau alat untuk melakukan koneksi internet lewat modem, agar lebih mudah dalam melakukan koneksi, tanpa harus ribet membuka aplikasi bawaan modem.

Apa itu ip hunter?

Ip hunter adalah fitur yang memudahkan kita mencari ip tertentu yang kita inginkan, hal ini sangat erat kaitannya dengan dunia internet gratis, dimana para pengguna internet gratis terkadang harus mencari ip tertentu agar bisa konek ke server ssh dengan menggunakan injek, baiklah langsung saja pada project yang akan kita buat yaitu membuat dial-up yang dilengkapi fitur ip hunter dengan delphi 7.

Sebelum memulai membuat aplikasi dial-up ini, pastikan delphi 7 sobat sudah terintstal komponen ras, karena komponen ras lah yang akan melakukan perintah dial-up.

Komponen yang diperlukan untuk membuat dial-up

4 buah button = TButton
2 buah Timer = TTimer
1 buah XP Manifest = TXP Manifest
1 buah richedit = TRichEdit1
1 buah ComboBox = TComboBox
1 buah edit.text = Tedit1.text
1 buah statusbar = Tstatusbar
1 buah checkBox = Tcheckbox

Setelah semua komponen di siapkan, silahkan susun semenarik mungkin, agar para pengguna aplikasi dial-up buatan anda nanti merasa nyaman menggunakannya, lihat contoh penempatan komponen yang benar seperti gambar dibawah ini

 

Sekarang kita masuk ketahap pengcodingan, mohon diperhatikan agar tidak terjadi eror ketika project ini di compile.

Button1 kita beri label Dial, agar lebih terlihat profesional, untuk pengcodingan, dobel klik pada button1 lalu masukan coding berikut:

procedure TForm1.Button1Click(Sender: TObject);
var r: integer;
c: Array[0..100] of Char;
begin
if Button1.Caption='Dial' then begin
Button1.Caption:='Dialing...';
FillChar(dialparams, SizeOf(TRasDialParams), 0);
with dialparams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, ComboBox1.Items[ComboBox1.ItemIndex]);
end;
hRas := 0;
r := RasDial(nil,
nil,
dialparams,
0,
@RasCallback,
hRas);
Button4.Click;
if r <> 0 then begin
RasGetErrorString(r, c, 100);
StatusBar1.Panels[1].Text:= c;
end;
end else begin
if hRas = 0 then
exit;
if RasHangUp(hRas) <> 0 then
begin
MessageDlg('Error : Cannot hangup connection.', mtCustom,[mbOK] ,0);
end;
end;

end;

Langkah selanjutnya dobel klik pada button2 lalu masukan coding berikut:

procedure TForm1.Button2Click(Sender: TObject);
var bufsize: Longint;
numEntries: Longint;
entries: Array[1..12] of TRasEntryName;
x: Integer;
begin
entries[1].dwSize := SizeOf(TRasEntryName);
bufsize := SizeOf(TRasEntryName) * 12;
if RasEnumEntries(nil, nil, @entries[1], bufsize, numEntries) = 0 then
begin
if numEntries > 0 then
begin
for x := 1 to numEntries do
ComboBox1.Items.Add(entries[x].szEntryName);
ComboBox1.ItemIndex := 0;
end;
end
else
MessageDlg('Error : Cannot retrieve entry names', mtCustom,[mbOK] ,0);
end;

Selanjutnya dobel klik pada button3 lalu masukan coding berikut:

procedure TForm1.Button3Click(Sender: TObject);
var fp: LongBool;
r: Longint;
c: Array[0..100] of Char;
begin
if ComboBox1.itemindex=-1 then
exit;

FillChar(dialparams, SizeOf(TRasDialParams), 0);
with dialparams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, ComboBox1.Items[ComboBox1.ItemIndex]);
end;

r := RasGetEntryDialParams(nil, dialparams, fp);
if r = 0 then
with dialparams do
begin
if fp then
end
else
begin
RasGetErrorString(r, c, 100);
MessageDlg(('Error : ' + c), mtCustom,[mbOK] ,0);
end;
end;

Langkah selanjutnya dobel klik pada button4 lalu masukan coding berikut:

procedure TForm1.Button4Click(Sender: TObject);
begin
with dialparams do
begin
dwSize := Sizeof(TRasDialParams);
StrPCopy(szEntryName, ComboBox1.Items[ComboBox1.ItemIndex]);
StrPCopy(szpassword, '');
RasSetEntryDialParams(nil, dialparams, True);
end;
end;

Langkah selanjutnya dobel klik pada timer1 lalu masukan coding berikut:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (pos('Connected',StatusBar1.Panels[1].Text)<>0) or (pos('Not connected',StatusBar1.Panels[1].Text)<>0) then
begin
Button1.Click;
Timer1.Enabled:=False;
end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
Edit1.Enabled := True
else Edit1.Enabled := False;
end;

Langkah selanjutnya dobel klik pada timer2 lalu masukan coding berikut:

procedure TForm1.Timer2Timer(Sender: TObject);
var bufsize: Longint;
numEntries: Longint;
x: Integer;
entries: Array[1..100] of TRasConn;
stat: TRasConnStatus;
iphunt : String;
begin
iphunt := GetIPAddress;
entries[1].dwSize := SizeOf(TRasConn);
bufsize := SizeOf(TRasConn) * 100;
FillChar(stat, Sizeof(TRasConnStatus), 0);
stat.dwSize := Sizeof(TRasConnStatus);
if RasEnumConnections(@entries[1], bufsize, numEntries) = 0 then begin
if numEntries > 0 then begin
for x := 1 to numEntries do
with Form1, entries[x] do
begin
hras := hrasconn;
RasGetConnectStatus(hras, stat);

StatusBar1.Panels[1].Text := StatusString(stat.rasconnstate, stat.dwError) ;
Button1.Caption:='Hang up';
ComboBox1.Enabled:=False;
if CheckBox1.Checked = False then
begin
RichEdit1.Text := 'IP: '+iphunt;
end;
end;
end else begin
timer2.enabled:=false;
StatusBar1.Panels[1].Text :='Not connected';
Button1.Caption:='Dial';
ComboBox1.enabled:=true;
end;
end else
Messagedlg ('Error : Cannot retrieve connection details ', mtCustom,[mbOK] ,0);
end; 
Langkah selanjutnya dobel klik pada checkbox1 lalu masukan coding berikut:

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
Edit1.Enabled := True
else Edit1.Enabled := False;
end;

Langkah selanjutnya dobel klik pada form1 lalu masukan coding berikut:

procedure TForm1.FormCreate(Sender: TObject);
begin
hras:=0;
Button2.click;
Button3.click;
end;

Langkah selanjutnya dobel klik pada statusbar1 lalu bikin label seperti pada gambar dibawah ini

Langkah selanjutnya klik pada combobox1 tapi jangan dobel klik, lalu arahkan ke object inspector bagian events, cari tulisan onclick, kalau sudah ketemu rubah propertiesnya menjadi button3click, atau agar lebih jelas, silahkan perhatikan gambar berikut

Kalau semua langkah diatas sudah dilakukan, sekarang masuk ke tahap prosedor ras dial nya, copy paste coding berikut antara { Private declarations } dan   public

dialparams: TRasDialParams;
hras: THRasConn;
status : Boolean;

Atau agar lebih jelas silahkan perhatikan gambar berikut

Lalu langkah selanjutnya copy paste coding berikut tepat dibawah
implementation
{$R *.DFM}

Function GetIPAddress():String;
type
pu_long = ^u_long;
var
varTWSAData : TWSAData;
varPHostEnt : PHostEnt;
varTInAddr : TInAddr;
namebuf : Array[0..255] of char;
begin
If WSAStartup($101,varTWSAData) <> 0 Then
Result := 'No. IP Address'
Else Begin
gethostname(namebuf,sizeof(namebuf));
varPHostEnt := gethostbyname(namebuf);
varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^);
Result := inet_ntoa(varTInAddr);
End;
WSACleanup;
end;

function StatusString(state: TRasConnState; error: Longint): String;
var
c: Array[0..100] of Char;
s: String;
begin
if error <> 0 then begin
RasGetErrorString(error, c, 100);
Result := c;

end else begin
s := '';
case State of
RASCS_OpenPort:
s := 'Opening port';
RASCS_PortOpened:
s := 'Port opened';
RASCS_ConnectDevice:
s := 'Connecting device';
RASCS_DeviceConnected:
s := 'Device connected';
RASCS_AllDevicesConnected:
s := 'All devices connected';
RASCS_Authenticate:
s := 'Authenticating';
RASCS_AuthNotify:
s := 'Authentication: notify';
RASCS_AuthRetry:
s := 'Authentication: retry';
RASCS_AuthCallback:
s := 'Authentication: callback';
RASCS_AuthChangePassword:
s := 'Authentication: change password';
RASCS_AuthProject:
s := 'Authentication: projecting';
RASCS_AuthLinkSpeed:
s := 'Authentication: link speed';
RASCS_AuthAck:
s := 'Authentication acknowledged';
RASCS_ReAuthenticate:
s := ' Reauthenticating';
RASCS_Authenticated:
s := 'Authenticated. Logging on network';
RASCS_PrepareForCallback:
s := 'Preparing for callback';
RASCS_WaitForModemReset:
s := 'Waiting for modem reset';
RASCS_WaitForCallback:
s := 'Waiting for callback';
RASCS_Projected:
s := 'Projected';
RASCS_StartAuthentication:
s := 'Authenticating';
RASCS_CallbackComplete:
s := 'Callback complete';
RASCS_LogonNetwork:
s := 'Logging on network';
RASCS_Interactive:
s := 'Interactive';
RASCS_RetryAuthentication:
s := 'Retry Authentication';
RASCS_CallbackSetByCaller:
s := 'Callback set by caller';
RASCS_PasswordExpired:
s := 'Password expired';
RASCS_Connected:
s := 'Connected';
RASCS_Disconnected:
s := 'Disconnected';
end;
Result := s;
end;
end;

procedure TForm1.IPHunter;
var ListIP : TStringList;
i : Integer;
curIP : string;
begin
curIP := GetIpAddress;
ListIP := TStringList.Create;
ListIP.Text := Edit1.Text;
ListIP.Text := StringReplace(ListIP.Text,';',#13#10,[rfReplaceAll]);

for i:=0 to ListIP.Count - 1 do begin
if Pos(ListIP[i],curIP) <> 0 then begin
status := True;
RichEdit1.Lines.Add('IP: '+curip+ ' (OK)');
Exit;
end;
end;

if not status then
RichEdit1.lines.Add('IP: '+curip);
Button1.Click;
Form1.Timer1.Enabled:=True;
end;

procedure RasCallback(msg: Integer; state: TRasConnState;
error: Longint); stdcall
begin
Form1.StatusBar1.Panels[1].Text := statusstring(state, error);
if strcomp(pchar(statusstring(state, error)), 'Connected')= 0 then begin
Form1.timer2.enabled:=true;
end;
if Pos('Connected',Form1.StatusBar1.Panels[1].Text)<> 0 then begin
if Form1.CheckBox1.Checked=True then begin
Sleep(1000);
Form1.IPhunter;
end
end;
end;

Perhatikan lagi semua langkah dari awal sampai akhir dengan seksama, kalau semua dirasa sudah benar, silahkan tekan F9 untuk mencoba menjalankannya.