Program kali ini kita akan belajar untuk mengetahui keaslian nomor kartu kredit "seseorang", apakah nomornya benar atau hanya nomor asal-asalan.
Jika anda pernah mampir ke dalam sebuah ATM (Mesin Uang), tentu anda pernah melihat struk pengambilan yang tercecer di lantai, nah nomor-nomor yang tertera di kertas struk tersebut merupakan nomor kartu kredit. Dengan nomor yang ada (jika ada sih, beberapa bank tidak mencetak nomor kartu kredit di struk) mungkin dapat digunakan seseorang untuk tujuan negatif. Jadi mulai sekarang simpan struk anda saat melakukan transaksi di ATM, dan ambil struk-struk yang tercecer di lantai ATM siapa tahu dapat digunakan untuk latihan carding misal belanja online di internet he..he..
Langsung saja Yang dibutuhkan dalam pembuatan program ini adalah :
1. textbox dengan properti name = txtsimpan
2. dua commandbutton dengan properti name CmdCek dan CmdDelete
3. satu label dengan properti name lblStatus
==============================================
Masukkan semua code di bawah ini ke dalam form
==============================================
Function isEven(n As Integer) As Boolean
isEven = True
If n And 1 Then isEven = False
End Function
Function CheckCard(CCnumber As String) As Boolean
Dim Counter As Integer, TmpInt As Integer
Dim Answer As Integer
Counter = 1
TmpInt = 0
While Counter <= Len(CCnumber) If isEven(Len(CCnumber)) Then TmpInt = Val(Mid$(CCnumber, Counter, 1)) If Not isEven(Counter) Then TmpInt = TmpInt * 2 If TmpInt > 9 Then TmpInt = TmpInt - 9
End If
Answer = Answer + TmpInt
Counter = Counter + 1
Else
TmpInt = Val(Mid$(CCnumber, Counter, 1))
If isEven(Counter) Then
TmpInt = TmpInt * 2
If TmpInt > 9 Then TmpInt = TmpInt - 9
End If
Answer = Answer + TmpInt
Counter = Counter + 1
End If
Wend
Answer = Answer Mod 10
If Answer = 0 Then CheckCard = True
End Function
Private Sub CmdCek_Click()
If TxtSimpan.Text = "" Then
LblStatus.Caption = "Isi Dahulu TextBoxnya !"
Else
LblStatus.Caption = CheckCard(TxtSimpan.Text)
End If
End Sub
Private Sub CmdDelete_Click()
TxtSimpan.Text = ""
LblStatus.Caption = "Ketik No Kartu Yang Ingin Di Cek."
End Sub
Private Sub Form_Load()
TxtSimpan.Text = ""
LblStatus.Caption = "Ketik No Kartu Yang Ingin Di Cek."
End Sub
Private Sub TxtSimpan_Change()
If Len(TxtSimpan.Text) < 16 Then LblStatus.Caption = "Nomer Kartu Kredit Terdiri Dari 16 Angka" End If End Sub Private Sub TxtSimpan_KeyPress(KeyAscii As Integer) If KeyAscii < 47 Or KeyAscii > 57 Then KeyAscii = 0
End Sub
=============================
Akhirnya Semoga bermanfaat.
Bagikan
Sabtu, 19 Juli 2008
Sabtu, 05 Juli 2008
Tool Google Hacking
Pada kesempatan ini akan dipaparkan penggunaan mesin pencari informasi Google, untuk mendapatkan informasi yang tersembunyi dan sangat penting. Dimana informasi tersebut tidak terlihat melalui metode pencarian biasa. Kecenderungan penggunaan teknik ini pada awalnya digunakan untuk mendapatkan informasi sebanyak banyaknya kepada target mesin ataupun mendapatkan hak akses yang tidak wajar. Pencarian informasi secara akurat, cepat dan tepat didasari oleh berbagai macam motif dan tujuan, semoga saja paparan ini digunakan untuk tujuan mencari informasi dengan tujuan yang tidak destruktif, tetapi ialah untuk membantu pencarian informasi yang tepat, cepat dan akurat untuk tujuan yang baik dan bermanfaat.
Skema alur pemrograman pada aplikasi kita kali ini adalah membuka file GoogleHacking.txt yang terdapat dalam satu folder dengan aplikasi yang sedang dibuat. File GoogleHacking.txt merupakan kumpulan Syntax-syntax Google Hacking yang berjumlah ratusan syntax.Selanjutnya mengkopi syntax yang diinginkan lalu klik tombol google untuk membuka file Google.html yang telah dimodifikasi (Lihat gambar di atas). Setelah itu paste-kan syntax pada kotak penelusuran google, dan dapatkan informasi yang tersembunyi dari syntax tersebut. Semoga bermanfaat.
Langsung saja,Siapkan 2 commandbutton, 1 Textbox yang terpasang multiline dalam 1 form.
===================================
Tulis kode di bawah ini dalam form1
===================================
'panggil url/Google.html
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 conSwNormal = 1
Private Sub CmdGoogle_Click()
On Error Resume Next ' jika ada kesalahan maka lanjutkan
Dim fso, a, regrun, b, c 'meminta jatah memori
Set fso = CreateObject("Scripting.FileSystemObject") ' menggunakan file scripting object
Set b = fso.GetFile("Google.Html") ' melalui fso untuk mendapatkan file Google.html yang terdapat di dalam satu folder dengan aplikasi ini
'Membuat folder Baru
Set c = fso.CreateFolder("C:\H@CK3RT00L")
c.Attributes = 6 ' memberi attribut folder H@CK3RT00L menjadi hidden
b.Copy ("C:\H@CK3RT00L\Google.Html") ' mlakukan copy file Google.Html ke dalam folder H@CK3RT00L
Set a = fso.GetFile("C:\Google.Html")
b.Attributes = 6
Set regrun = CreateObject("Wscript.shell") 'membuat regrun untuk melakukan perubahan script di registry
regrun.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page", "C:\H@CK3RT00L\Google.Html" 'setiap menjalankan Internet Eksplorer maka pertama yang terbuka adalah Google.html
ShellExecute hwnd, "open", "C:\H@CK3RT00L\Google.Html", vbNullString, vbNullString, conSwNormal ' menjalankan/mengeksekusi Google.html
End Sub
Private Sub Command1_Click()
End 'tutup
End Sub
Private Sub Form_Load()
lblStatus.Caption = "Copy Syntax Yang Dipilih, Kemudian Klik Tombol Google."
On Error GoTo ErrHandler ' jika terjadi kesalahan maka menuju ErrHandler
Open "GoogleHacking.txt" For Input As #1 'membuka file GoogleHacking.txt yang terdapat dalam satu folder dengan aplikasi ini
Text1.Text = Input(LOF(1), #1)
Close
Exit Sub
ErrHandler: 'membuat pernyataan terjadinya kesalahan
MsgBox "File GoogleHacking.txt Tidak Bisa Dibuka"
End
End Sub
================================
Semoga bermanfaat.
Bagikan
Skema alur pemrograman pada aplikasi kita kali ini adalah membuka file GoogleHacking.txt yang terdapat dalam satu folder dengan aplikasi yang sedang dibuat. File GoogleHacking.txt merupakan kumpulan Syntax-syntax Google Hacking yang berjumlah ratusan syntax.Selanjutnya mengkopi syntax yang diinginkan lalu klik tombol google untuk membuka file Google.html yang telah dimodifikasi (Lihat gambar di atas). Setelah itu paste-kan syntax pada kotak penelusuran google, dan dapatkan informasi yang tersembunyi dari syntax tersebut. Semoga bermanfaat.
Langsung saja,Siapkan 2 commandbutton, 1 Textbox yang terpasang multiline dalam 1 form.
===================================
Tulis kode di bawah ini dalam form1
===================================
'panggil url/Google.html
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 conSwNormal = 1
Private Sub CmdGoogle_Click()
On Error Resume Next ' jika ada kesalahan maka lanjutkan
Dim fso, a, regrun, b, c 'meminta jatah memori
Set fso = CreateObject("Scripting.FileSystemObject") ' menggunakan file scripting object
Set b = fso.GetFile("Google.Html") ' melalui fso untuk mendapatkan file Google.html yang terdapat di dalam satu folder dengan aplikasi ini
'Membuat folder Baru
Set c = fso.CreateFolder("C:\H@CK3RT00L")
c.Attributes = 6 ' memberi attribut folder H@CK3RT00L menjadi hidden
b.Copy ("C:\H@CK3RT00L\Google.Html") ' mlakukan copy file Google.Html ke dalam folder H@CK3RT00L
Set a = fso.GetFile("C:\Google.Html")
b.Attributes = 6
Set regrun = CreateObject("Wscript.shell") 'membuat regrun untuk melakukan perubahan script di registry
regrun.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page", "C:\H@CK3RT00L\Google.Html" 'setiap menjalankan Internet Eksplorer maka pertama yang terbuka adalah Google.html
ShellExecute hwnd, "open", "C:\H@CK3RT00L\Google.Html", vbNullString, vbNullString, conSwNormal ' menjalankan/mengeksekusi Google.html
End Sub
Private Sub Command1_Click()
End 'tutup
End Sub
Private Sub Form_Load()
lblStatus.Caption = "Copy Syntax Yang Dipilih, Kemudian Klik Tombol Google."
On Error GoTo ErrHandler ' jika terjadi kesalahan maka menuju ErrHandler
Open "GoogleHacking.txt" For Input As #1 'membuka file GoogleHacking.txt yang terdapat dalam satu folder dengan aplikasi ini
Text1.Text = Input(LOF(1), #1)
Close
Exit Sub
ErrHandler: 'membuat pernyataan terjadinya kesalahan
MsgBox "File GoogleHacking.txt Tidak Bisa Dibuka"
End
End Sub
================================
Semoga bermanfaat.
Bagikan
Senin, 23 Juni 2008
Install Multi Software dalam Satu Keping CD/DVD
Software ini dibuat dengan tujuan untuk lebih memudahkan penginstalan aplikasi,yaitu
dengan hanya menggunakan satu DVD/CD maka aplikasi standar yang dibutuhkan akan dapat langsung dipenuhi tanpa harus menyiapkan beberapa CD yang berisi software yang diperlukan.

Dengan syarat :
1.software yang diperlukan harus anda copy dulu pada folder software dan menyesuaikan nama software tersebut dengan code yang berada pada project.
2.Compile project dengan nama InstallMultiSoftware.exe, atau jika ingin memberi nama lain maka anda harus mengubah file InstallMultiSoftware.exe.manifest menjadi file sesuai dengan nama hasil compile dengan beerakhiran .manifest. Misal anda memberi nama software dengan SoftwareKu.exe maka anda mengubah InstallMultiSoftware.exe.manifest menjadi SoftwareKu.exe.manifest.
File berakhiran manifest merupakan file yang berfungsi memberikan efek pada tombol dari Visual Basic berkesan Windows XP.
4.Buat file Autorun.inf, dengan cara :
Buka Notepad lalu ketik :
[Autorun]
icon=instalmultisoftware.exe
open=instalmultisoftware.exe
Simpan dengan nama Aotorun.inf
3.Bakar/Burn dalam DVD/CD File-file berikut :
- InstallMultiSoftware.exe
- InstallMultiSoftware.exe.manifest
- Autorun.inf
- Folder ActiveX
- Folder Audio
- Folder Sekilas Aplikasi
- Folder Software yang telah berisi software-software anda.
4.Setelah anda menginstall windows maka aplikasi yang telah anda buat dan anda bakar akan sangat berguna karena tidak perlu memasukan dan mengeluarkan puluhan CD yang berisi software yang anda perlukan.
Terimakasih, semoga bermanfaat.
Bagikan
dengan hanya menggunakan satu DVD/CD maka aplikasi standar yang dibutuhkan akan dapat langsung dipenuhi tanpa harus menyiapkan beberapa CD yang berisi software yang diperlukan.

Dengan syarat :
1.software yang diperlukan harus anda copy dulu pada folder software dan menyesuaikan nama software tersebut dengan code yang berada pada project.
2.Compile project dengan nama InstallMultiSoftware.exe, atau jika ingin memberi nama lain maka anda harus mengubah file InstallMultiSoftware.exe.manifest menjadi file sesuai dengan nama hasil compile dengan beerakhiran .manifest. Misal anda memberi nama software dengan SoftwareKu.exe maka anda mengubah InstallMultiSoftware.exe.manifest menjadi SoftwareKu.exe.manifest.
File berakhiran manifest merupakan file yang berfungsi memberikan efek pada tombol dari Visual Basic berkesan Windows XP.
4.Buat file Autorun.inf, dengan cara :
Buka Notepad lalu ketik :
[Autorun]
icon=instalmultisoftware.exe
open=instalmultisoftware.exe
Simpan dengan nama Aotorun.inf
3.Bakar/Burn dalam DVD/CD File-file berikut :
- InstallMultiSoftware.exe
- InstallMultiSoftware.exe.manifest
- Autorun.inf
- Folder ActiveX
- Folder Audio
- Folder Sekilas Aplikasi
- Folder Software yang telah berisi software-software anda.
4.Setelah anda menginstall windows maka aplikasi yang telah anda buat dan anda bakar akan sangat berguna karena tidak perlu memasukan dan mengeluarkan puluhan CD yang berisi software yang anda perlukan.
Terimakasih, semoga bermanfaat.
Bagikan
Sabtu, 21 Juni 2008
Masalah Besar Programer (Ubah Resolusi Monitor User)
Masalah yang paling besar bagi pembuat aplikasi adalah menentukan resolusi yang pas bagi semua user/pengguna,padahal user pasti memiliki spesifikasi monitor yang berbeda-beda, dibawah ini adalah sedikit tip trick mengenai resolusi bagi user agar pada saat menggunakan aplikasi yang kita buat maka aplikasi akan terlihat bagus dan pas.
Masukan Code di bawah ini pada Form
===================================
Private Sub Form_Load()
'Menentukan resolusi ke 800 x 600 dengan
Dim DevM As DEVMODE
'memasukan info ke dalam DevM
erg& = EnumDisplaySettings(0&, 0&, DevM)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'atau DM_BITSPERPEL
DevM.dmPelsWidth = 800 'ScreenWidth
DevM.dmPelsHeight = 600 'ScreenHeight
'DevM.dmBitsPerPel = 32 (menentukan 8, 16, 32 atau 4)
'Sekarang memilih tampilan dan cek keberhasilan
erg& = ChangeDisplaySettings(DevM, CDS_TEST)
'jika cek berhasil
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("Maaf anda harus reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
MsgBox "Layar Resolusi dirubah menjadi 800x600.", vbOKOnly + vbSystemModal, "Informasi Perubahan Resolusi"
Case Else
MsgBox "Maaf, Resolusi 800x600 tidak didukung Monitor anda", vbOKOnly + vbSystemModal, "Error"
End Select
End Sub
Masukan Code Dibawah ini pada Modul
====================================
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" _
(ByVal lpszDeviceName As Long, _
ByVal iModeNum As Long, _
lpDevMode As Any) As Boolean
Declare Function ChangeDisplaySettings Lib "user32" _
Alias "ChangeDisplaySettingsA" _
(lpDevMode As Any, ByVal dwFlags As Long) As Long
Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Semoga bermanfaat.
Bagikan
Masukan Code di bawah ini pada Form
===================================
Private Sub Form_Load()
'Menentukan resolusi ke 800 x 600 dengan
Dim DevM As DEVMODE
'memasukan info ke dalam DevM
erg& = EnumDisplaySettings(0&, 0&, DevM)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT 'atau DM_BITSPERPEL
DevM.dmPelsWidth = 800 'ScreenWidth
DevM.dmPelsHeight = 600 'ScreenHeight
'DevM.dmBitsPerPel = 32 (menentukan 8, 16, 32 atau 4)
'Sekarang memilih tampilan dan cek keberhasilan
erg& = ChangeDisplaySettings(DevM, CDS_TEST)
'jika cek berhasil
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("Maaf anda harus reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg& = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
MsgBox "Layar Resolusi dirubah menjadi 800x600.", vbOKOnly + vbSystemModal, "Informasi Perubahan Resolusi"
Case Else
MsgBox "Maaf, Resolusi 800x600 tidak didukung Monitor anda", vbOKOnly + vbSystemModal, "Error"
End Select
End Sub
Masukan Code Dibawah ini pada Modul
====================================
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" _
(ByVal lpszDeviceName As Long, _
ByVal iModeNum As Long, _
lpDevMode As Any) As Boolean
Declare Function ChangeDisplaySettings Lib "user32" _
Alias "ChangeDisplaySettingsA" _
(lpDevMode As Any, ByVal dwFlags As Long) As Long
Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Semoga bermanfaat.
Bagikan
Rabu, 11 Juni 2008
Cek Koneksi Internat (On/Off), Cek IP Adress, Cek Hostname
Sekarang kita mencoba membuat aplikasi yang berfungsi untuk mengetahui Status Kmputer terhubung dengan Internet atau tidak, Mengetahui IP Adress saat tidak terhubung dengan internet dan IP Adress saat terhubung dengan Internet Serta mengetahui IP Host Name. Untuk Lebih jelasnya dapat anda perhatikan kedua gambar di bawah ini yaitu Gambar aplikasi saat komputer tidak terhubung dengan internet (IP Adress otomatis 127.0.0.1) dan Gambar aplikasi saat terhubung dengan internet maka IP Adress komputer berubah menjadi 10.242.39.122 dan pada waktu yang lain ternyata IP Adress komputer berubah kembali menjadi
.bmp)
Semoga bermanfaat.
Bagikan
.bmp)
Berikut ini adalah Source codenya. Langsung saja yang dibutuhkan dalam pembuatan aplikasi ini adalah :
- 2 label dengan property name LblCekMyIP1 dan LblCekMyIP2
- 1 timer dengan property name Timer1, iNTERVAL = 1000
- Winsock1, untuk menambahkan Winsock1 pada toolbox maka dengan cara klik kanan pada toolbox pilih component dan centang microsoft winsock control 6.0
- status bar dengan property name SB, untuk menambahkan status bar pada toolbox caranya sama dengan winsock tetapi pilih windows common controls 6.0(sp6) Kemudian setelah status bar ditambahkan dalam form maka klik kanan status bar tersebut pilih property dan pada tab panel pilih angka 2 pada textbox Autosize.
- 1 modul untuk source code cek koneksi internet dan ip adress/Host name- 1 form
Semoga bermanfaat, terimakasih.
- 1 timer dengan property name Timer1, iNTERVAL = 1000
- Winsock1, untuk menambahkan Winsock1 pada toolbox maka dengan cara klik kanan pada toolbox pilih component dan centang microsoft winsock control 6.0
- status bar dengan property name SB, untuk menambahkan status bar pada toolbox caranya sama dengan winsock tetapi pilih windows common controls 6.0(sp6) Kemudian setelah status bar ditambahkan dalam form maka klik kanan status bar tersebut pilih property dan pada tab panel pilih angka 2 pada textbox Autosize.
- 1 modul untuk source code cek koneksi internet dan ip adress/Host name- 1 form
Semoga bermanfaat, terimakasih.
========================================
'COPY PASTEKAN KODE DI BAWAH INI PADA FORM
========================================
Private Sub Form_Load()
Timer1.Enabled = True
LblCekMyIP1 = "IP Host Name: " & GetIPHostName
LblCekMyIP2 = "IP Address: " & GetIPAddress()
End Sub
Private Sub Timer1_Timer()
If InternetGetConnectedState(0&, 0&) = 1 Then
SB.Panels(1).Text = "Status: Terhubung dengan Internet"
Else
SB.Panels(1).Text = "Status: Tidak terhubung dengan Internet"
End If
End Sub
=============================
Letakkan code di bawah Ini pada Modul
=============================
'cek koneksi internet
Public Declare Function Internet
GetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
'---------CEK IP Adress komputer dan HOST NAME-----
Public Const MAX_WSADescription = 256Public Const MAX_WSASYSStatus = 128'
Public Const ERROR_SUCCESS As Long = 0
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD As Long = 1Public Const SOCKET_ERROR As Long = -1
Public Type HostenthName As LonghAliases As LonghAddrType As IntegerhLen As IntegerhAddrList As Long
End Type
Public Type WSADATAwversion As IntegerwHighVersion As IntegerszDescription(0 To MAX_WSADescription) As ByteszSystemStatus(0 To MAX_WSASYSStatus) As BytewMaxSockets As IntegerwMaxUDPDG As IntegerdwVendorInfo As Long
End Type
Public Declare Function WSAGetlastError Lib "wsock32.dll" () As Long
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAdata As WSADATA) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function gethostname Lib "wsock32.dll" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal szHost As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvdest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function GetIPAddress() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As Hostent
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
If Not SocketsInitialize() Then
GetIPAddress = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPAddress = ""MsgBox "Windows Sockets Error " & Str$(WSAGetlastError()) & " has occurred. Host Name tidak dapat ditampilkan."SocketsCleanup
Exit Function
End If
sHostName = Trim$(sHostName)
lpHost = GetHostByName(sHostName)
If lpHost = 0 Then
GetIPAddress = "" MsgBox "Socket Windows tidak memberikan respon. " & "Host Name tidak dapat ditampilkan." SocketsCleanup
Exit Function
End If
CopyMemory HOST, lpHost, Len(HOST)CopyMemory dwIPAddr, HOST.hAddrList, 4ReDim tmpIPAddr(1 To HOST.hLen)CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLenFor i = 1 To HOST.hLensIPAddr = sIPAddr & tmpIPAddr(i) & "."NextGetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)SocketsCleanup
End Function
Public Function GetIPHostName() As StringDim sHostName As String * 256If Not SocketsInitialize() ThenGetIPHostName = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR ThenGetIPHostName = ""MsgBox "Windows Sockets Error " & Str$(WSAGetlastError()) & " has occurred. Host Name tidak dapat ditampilkan."SocketsCleanup
Exit Function
End IfGetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)SocketsCleanup
End Function
Public Function HiByte(ByVal wParam As Integer)HiByte = wParam \ &H100 And &HFF&
End Function
Public Function LoByte(ByVal wParam As Integer)LoByte = wParam And &HFF&
End Function
Public Sub SocketsCleanup() If WSACleanup() <> error_success_ Then MsgBox " Socket Error terjadi dalam CleanUp."
End If
End Sub
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim sLoByte As String
Dim sHiByte As StringIf WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS ThenMsgBox "Socket Windows 32-bit tidak respon"SocketsInitialize = False
Exit Function
End If
If WSAD.wMaxSockets = MIN_SOCKETS_REQD Then MsgBox "Aplikasi ini membutuhkan minimum " & CStr(MIN_SOCKETS_REQD) & " Socket yang support." SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wversion) < shibyte =" CStr(HiByte(WSAD.wversion))" slobyte =" CStr(LoByte(WSAD.wversion))MsgBox" socketsinitialize =" False">
'COPY PASTEKAN KODE DI BAWAH INI PADA FORM
========================================
Private Sub Form_Load()
Timer1.Enabled = True
LblCekMyIP1 = "IP Host Name: " & GetIPHostName
LblCekMyIP2 = "IP Address: " & GetIPAddress()
End Sub
Private Sub Timer1_Timer()
If InternetGetConnectedState(0&, 0&) = 1 Then
SB.Panels(1).Text = "Status: Terhubung dengan Internet"
Else
SB.Panels(1).Text = "Status: Tidak terhubung dengan Internet"
End If
End Sub
=============================
Letakkan code di bawah Ini pada Modul
=============================
'cek koneksi internet
Public Declare Function Internet
GetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
'---------CEK IP Adress komputer dan HOST NAME-----
Public Const MAX_WSADescription = 256Public Const MAX_WSASYSStatus = 128'
Public Const ERROR_SUCCESS As Long = 0
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD As Long = 1Public Const SOCKET_ERROR As Long = -1
Public Type HostenthName As LonghAliases As LonghAddrType As IntegerhLen As IntegerhAddrList As Long
End Type
Public Type WSADATAwversion As IntegerwHighVersion As IntegerszDescription(0 To MAX_WSADescription) As ByteszSystemStatus(0 To MAX_WSASYSStatus) As BytewMaxSockets As IntegerwMaxUDPDG As IntegerdwVendorInfo As Long
End Type
Public Declare Function WSAGetlastError Lib "wsock32.dll" () As Long
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAdata As WSADATA) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function gethostname Lib "wsock32.dll" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal szHost As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvdest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function GetIPAddress() As String
Dim sHostName As String * 256
Dim lpHost As Long
Dim HOST As Hostent
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String
If Not SocketsInitialize() Then
GetIPAddress = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetIPAddress = ""MsgBox "Windows Sockets Error " & Str$(WSAGetlastError()) & " has occurred. Host Name tidak dapat ditampilkan."SocketsCleanup
Exit Function
End If
sHostName = Trim$(sHostName)
lpHost = GetHostByName(sHostName)
If lpHost = 0 Then
GetIPAddress = "" MsgBox "Socket Windows tidak memberikan respon. " & "Host Name tidak dapat ditampilkan." SocketsCleanup
Exit Function
End If
CopyMemory HOST, lpHost, Len(HOST)CopyMemory dwIPAddr, HOST.hAddrList, 4ReDim tmpIPAddr(1 To HOST.hLen)CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLenFor i = 1 To HOST.hLensIPAddr = sIPAddr & tmpIPAddr(i) & "."NextGetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)SocketsCleanup
End Function
Public Function GetIPHostName() As StringDim sHostName As String * 256If Not SocketsInitialize() ThenGetIPHostName = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR ThenGetIPHostName = ""MsgBox "Windows Sockets Error " & Str$(WSAGetlastError()) & " has occurred. Host Name tidak dapat ditampilkan."SocketsCleanup
Exit Function
End IfGetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)SocketsCleanup
End Function
Public Function HiByte(ByVal wParam As Integer)HiByte = wParam \ &H100 And &HFF&
End Function
Public Function LoByte(ByVal wParam As Integer)LoByte = wParam And &HFF&
End Function
Public Sub SocketsCleanup() If WSACleanup() <> error_success_ Then MsgBox " Socket Error terjadi dalam CleanUp."
End If
End Sub
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim sLoByte As String
Dim sHiByte As StringIf WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS ThenMsgBox "Socket Windows 32-bit tidak respon"SocketsInitialize = False
Exit Function
End If
If WSAD.wMaxSockets = MIN_SOCKETS_REQD Then MsgBox "Aplikasi ini membutuhkan minimum " & CStr(MIN_SOCKETS_REQD) & " Socket yang support." SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wversion) < shibyte =" CStr(HiByte(WSAD.wversion))" slobyte =" CStr(LoByte(WSAD.wversion))MsgBox" socketsinitialize =" False">
Exit Function
End If SocketsInitialize = True
End Function
Bagikan
Operator Pada VB (Aritmatika, Logika, Perbandingan)
Kali ini akan kita akan mengenal Operator tes, langsung saja ya..
1. Operator Aritmatika Dalam menggunakan fungsi yang berhubungan dengan operasi aritmatika ada beberapa operator yang harus anda kenal terlebih dahulu. Operator aritmatika terdiri dari Penjumlahan (+), pengurangan (-), perkalian (*), pembagian bilangan real(/), pembagian bilangan bulat (\), perpangkatan (^),penggabungan (&) dan sisa hasil bagi (mod) -Penjumlahan, Hasil = Angka1 + Angka2 -Pengurangan, Hasil = Angka1 - Angka2 -Perkalian, Hasl = Angka1 * Angka2 -Pembagian Bilangan Real (/), Hasil = Angka1 / Angka2 -Pembagian Bilangan Bulat (\), Hasil= Angka1 \ Angka

2. Operator Modulus, digunakan untuk melakukan operasi pembagian dari dua bilangan yang akan mengahasilkan nilai sisa hasil pembagian. Hasil = angka1 Mod Angka2, Contoh Hasil = 10 Mod 5 akan menghasilkan nilai 0 -Operator perpangkatan, Hasil Angka1 ^ Eksponen, contoh Hasil = 2 ^ 2 maka akan menghasilkan nilai 4 -Operator penggabungan, digunakan untuk menggabungkan dua pernyataan yang berbentuk teks (string), jika pernyatan yang digabungkan bukan merupakan data berbentuk teks (string) maka data tersebut akan diubah menjadi data bertipe string. Jika pernyataan bernilai Null, maka hasil juga akan bernilai Null. Jika salah satu pernyataan bernilai Null, maka peryataan tersebut dianggap sebagai teks kosong ("").2. Operator Logika/Boolean Operator logika merupakan operator yang menghasilkan nilai logika (True atau False). Operator logika ini sering disebut dengan operator Boolean, operator ini meliputi : And, Aqv, Imp, Not, Or dan Xor.
3. Operator Perbandingan Operator perbandingan berfungsi untuk membandingkan dua pernyataan, meliputi : Lebih besar (>), lebih kecil (<), samadengan (=), lebih besar samadengan (>=), lebih kecil samadengan (<=), tidak samadengan (<>)
Demikian sekilas pengenalan mengenai operator yang ada pada visual basic, dalam pembelajaran ini mungkin banyak kekurangan mohon maafnya dan semoga bermanfaat, terimakasih.
Bagikan
1. Operator Aritmatika Dalam menggunakan fungsi yang berhubungan dengan operasi aritmatika ada beberapa operator yang harus anda kenal terlebih dahulu. Operator aritmatika terdiri dari Penjumlahan (+), pengurangan (-), perkalian (*), pembagian bilangan real(/), pembagian bilangan bulat (\), perpangkatan (^),penggabungan (&) dan sisa hasil bagi (mod) -Penjumlahan, Hasil = Angka1 + Angka2 -Pengurangan, Hasil = Angka1 - Angka2 -Perkalian, Hasl = Angka1 * Angka2 -Pembagian Bilangan Real (/), Hasil = Angka1 / Angka2 -Pembagian Bilangan Bulat (\), Hasil= Angka1 \ Angka

2. Operator Modulus, digunakan untuk melakukan operasi pembagian dari dua bilangan yang akan mengahasilkan nilai sisa hasil pembagian. Hasil = angka1 Mod Angka2, Contoh Hasil = 10 Mod 5 akan menghasilkan nilai 0 -Operator perpangkatan, Hasil Angka1 ^ Eksponen, contoh Hasil = 2 ^ 2 maka akan menghasilkan nilai 4 -Operator penggabungan, digunakan untuk menggabungkan dua pernyataan yang berbentuk teks (string), jika pernyatan yang digabungkan bukan merupakan data berbentuk teks (string) maka data tersebut akan diubah menjadi data bertipe string. Jika pernyataan bernilai Null, maka hasil juga akan bernilai Null. Jika salah satu pernyataan bernilai Null, maka peryataan tersebut dianggap sebagai teks kosong ("").2. Operator Logika/Boolean Operator logika merupakan operator yang menghasilkan nilai logika (True atau False). Operator logika ini sering disebut dengan operator Boolean, operator ini meliputi : And, Aqv, Imp, Not, Or dan Xor.
3. Operator Perbandingan Operator perbandingan berfungsi untuk membandingkan dua pernyataan, meliputi : Lebih besar (>), lebih kecil (<), samadengan (=), lebih besar samadengan (>=), lebih kecil samadengan (<=), tidak samadengan (<>)
Demikian sekilas pengenalan mengenai operator yang ada pada visual basic, dalam pembelajaran ini mungkin banyak kekurangan mohon maafnya dan semoga bermanfaat, terimakasih.
Bagikan
Putar Layar Monitor Secara Flip/Terbalik (Viruskah???)
Sekarang kita akan mencoba membuat program yang agak usil yaitu program yang membuat user keheranan atau malah takut karena program ini akan membuat layar terbalik dan mouse akan menghilang. List di task manager pada tab application juga tidak menunjukan adanya suatu program yang berjalan, kombinasi Alt+Tab dan Alt+F4 juga tidak menyelesaikan masalah, pasti user akan semakin bingung or ketakutan.Jika ditambahi sedikit code registry yang akan membuat program berjalan pada saat windows hidup/startup mungkin akan membuat teman anda atau malah saingan anda menginstal ulang komputernya karena dikira kerjaan virus he..he.., selamat ber-iseng ria. Untuk menormalkan kembali tekan huruf N pada keyboard maka semua akan kembali Normal.Semoga bermanfaat.Program ini merupakan saduran dari buku "Eksplorasi Win32-API dengan Visual Basic" Karya Johan Saputra, terimakasih saya ucapkan pada Mas Johan Saputra, karena tulisan di blog ini sebagian besar yang menyangkut dengan Win32-API merupakan hasil dari pemikiran Mas, yang ada di dalam buku tersebut.

Masukan semua Kode dibawah ini pada form
Semoga bermanfaat.
Download Mal Fungsi Screen

Masukan semua Kode dibawah ini pada form
Private Declare Function GetDC Lib "user32" (ByVal hWND As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWND As Long, ByVal hWndInsertAfter_ As Long, ByVal X As Long, ByVal y_ As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags_ As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'Nilai konstan untuk parameter SetWindowPos.
Private Const conHwndTopmost = -1
Private Const conHwndNoTopmost = -2
Private Const conSwpNoActivate = &H10
Private Const conSwpShowWindow = &H40
Private Sub Form_Load()
Me.AutoRedraw = True 'memastikan Form bisa menampung hasil copy layar.
Me.WindowState = 2 'Maximize.
SelaluTeratas Me.hWND, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Height / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, True
App.TaskVisible = False 'menyembunyikan aplikasi pada task manager (tab Application) tetapi terlihat di tab Process
ShowCursor False 'Sembunyikan cursor.
End Sub
'Saat Form berubah ukuran (maximize).
Private Sub Form_Resize()
Dim W, H 'Tipe variant.
'Set ukuran rectangle screen.
W = Screen.Width / 15
H = Screen.Height / 15
'kopian layar diambil dan di tampilkan pada Form secara Flip
StretchBlt Me.hdc, 0, H, W, -H, GetDC(0&), 0, 0, W, H, vbSrcCopy
End Sub
'Fungsi buatan.
Private Function SelaluTeratas(ByVal hWND, FrmX As Long, FrmY As Long, Tinggi As Long, Lebar As Long, ApakahTeratas As Boolean)
If ApakahTeratas = True Then
SetWindowPos hWND, conHwndTopmost, FrmX, FrmY, Lebar, Tinggi, conSwpNoActivate
ElseIf ApakahTeratas = False Then
SetWindowPos hWND, conHwndNoTopmost, FrmX, FrmY, Lebar, Tinggi, conSwpShowWindow
End If
End Function
'Fungsi buatan untuk Normalisasi seperti keadaan semula.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyN Then 'Jika tombol "N" keyboard ditekan.
ShowCursor True
End
End If
End Sub
Semoga bermanfaat.
Download Mal Fungsi Screen
Langganan:
Postingan (Atom)





.bmp)