DUN ( Dial Up Networking )
adalah sebuah fasilitas di dalam windows yang berfungsi untuk
mengkoneksi ke jaringan internet. Nah didalam program Visual Basic 6
kita bisa membuat sendiri fasilitas ini, tanpa mencampuri system windows
yang ada.
Saat kita memakai DUN ( Dial Up
Networking ) kita akan memanggil dan menjalankan file windows. Proses
inilah yang akan kita jalankan agar program mau bekerja menjalankan
proses koneksi dan diskonek dari file tersebut
Untuk bisa menjalankan proses koneksi dan diskonek internet menggunakan DUN silakan ikuti panduan berikut :
1. Buka visual basic 6 sobat. Buat sebuah project baru.
2. Tambahkan 2 buah Command Button pada project.
3. Buat sebuah modul. Lalu masukkan coding berikut pada modul tersebut
Option Explicit
'________________________________________________CONSTANTS UNTUK KONEKSI YG ADA__
Const ERROR_SUCCESS = 0&
Const APINULL = 0&
Const HKEY_LOCAL_MACHINE = &H80000002
Dim ReturnCode As Long
'________________________________________________CONSTANTS UNTUK KONEKSI BARU_______
Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
'________________________________________________CONSTANTS UNTUK PUTUS KONEKSI________
Const RAS_MAXDEVICETYPE = 16
Const RAS_MAXDEVICENAME = 128
Const RAS_RASCONNSIZE = 412
Const RAS_MAXENTRYNAME = 256
'________________________________________________JENIS KONEKSI___________
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) As Byte
End Type
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
'________________________________________________JENIS PUTUS KONEKSI____________
Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
'________________________________________________API's UNTUK KONEKSI YANG ADA______
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
'________________________________________________API's UNTUK KONEKSI BARU___________
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" _
(Destination As Any, ByVal Length As Long)
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" _
(ByVal lprasdialextensions As Long, ByVal lpcstr As String, _
ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, _
ByRef lphrasconn As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" _
(ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, _
lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
(ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, _
ByRef lpbool As Long) As Long
'________________________________________________API's UNTUK PUTUS KONEKSI____________
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" _
(lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" _
(ByVal hRasConn As Long) As Long
'________________________________________________FUNCTIONS: KONEKSI AKTIF_____
Public Function ActiveConnection() As Boolean
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
ActiveConnection = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _
phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
If lpData = 0 Then
ActiveConnection = False
Else
ActiveConnection = True
End If
End If
RegCloseKey (hKey)
End If
End Function
Public Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
Dim rp As RASDIALPARAMS, h As Long, resp As Long
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber
ChangeBytes "*", rp.szCallbackNumber
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h)
Dial = (resp = 0)
End Function
Private Function ChangeToStringUni(Bytes() As Byte) As String
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function
Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
Dim lenBs As Long
Dim lenStr As Long
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs
ChangeBytes = True
End If
End Function
Public Sub ListConnectionNames(Lst As ListBox)
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
Lst.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If Lst.ListCount > 0 Then
Lst.ListIndex = 0
End If
End Sub
Public Sub DisplayConnectionInfo(ConName As String, Txt1 As TextBox, Txt2 As TextBox)
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes ConName, rdp.szEntryName
t = RasGetEntryDialParams(ConName, rdp, 0)
If t = 0 Then
Txt1 = ChangeToStringUni(rdp.szUserName)
Txt2 = ChangeToStringUni(rdp.szPassword)
End If
End Sub
Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
Dim gstrIspName As String
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
Next i
End If
End Sub
'________________________________________________CONSTANTS UNTUK KONEKSI YG ADA__
Const ERROR_SUCCESS = 0&
Const APINULL = 0&
Const HKEY_LOCAL_MACHINE = &H80000002
Dim ReturnCode As Long
'________________________________________________CONSTANTS UNTUK KONEKSI BARU_______
Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
'________________________________________________CONSTANTS UNTUK PUTUS KONEKSI________
Const RAS_MAXDEVICETYPE = 16
Const RAS_MAXDEVICENAME = 128
Const RAS_RASCONNSIZE = 412
Const RAS_MAXENTRYNAME = 256
'________________________________________________JENIS KONEKSI___________
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) As Byte
End Type
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
'________________________________________________JENIS PUTUS KONEKSI____________
Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
'________________________________________________API's UNTUK KONEKSI YANG ADA______
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
'________________________________________________API's UNTUK KONEKSI BARU___________
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" _
(Destination As Any, ByVal Length As Long)
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" _
(ByVal lprasdialextensions As Long, ByVal lpcstr As String, _
ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, _
ByRef lphrasconn As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" _
(ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, _
lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
(ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, _
ByRef lpbool As Long) As Long
'________________________________________________API's UNTUK PUTUS KONEKSI____________
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" _
(lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" _
(ByVal hRasConn As Long) As Long
'________________________________________________FUNCTIONS: KONEKSI AKTIF_____
Public Function ActiveConnection() As Boolean
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
ActiveConnection = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _
phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
If lpData = 0 Then
ActiveConnection = False
Else
ActiveConnection = True
End If
End If
RegCloseKey (hKey)
End If
End Function
Public Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
Dim rp As RASDIALPARAMS, h As Long, resp As Long
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber
ChangeBytes "*", rp.szCallbackNumber
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h)
Dial = (resp = 0)
End Function
Private Function ChangeToStringUni(Bytes() As Byte) As String
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function
Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
Dim lenBs As Long
Dim lenStr As Long
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs
ChangeBytes = True
End If
End Function
Public Sub ListConnectionNames(Lst As ListBox)
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
Lst.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If Lst.ListCount > 0 Then
Lst.ListIndex = 0
End If
End Sub
Public Sub DisplayConnectionInfo(ConName As String, Txt1 As TextBox, Txt2 As TextBox)
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes ConName, rdp.szEntryName
t = RasGetEntryDialParams(ConName, rdp, 0)
If t = 0 Then
Txt1 = ChangeToStringUni(rdp.szUserName)
Txt2 = ChangeToStringUni(rdp.szPassword)
End If
End Sub
Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
Dim gstrIspName As String
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
Next i
End If
End Sub
4. Nah untuk melakukan koneksi internet, pada salah satu Command Button tinggal masukkan coding berikut
Private Sub Command1_Click()
Dial
End Sub
5. Untuk memutuskan koneksi internet tinggal masukkan coding berikut pada Command Button lainnya
Private Sub Command2_Click()
Hangup
End Sub
6. Simpan project dan silakan dicoba
