Cek Nomer Kartu Kredit (Carding kah..?)
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.
Basic Client - Server
Langsung saja ini screenshot dan kodenya.
Langkah Pembuatan Project
- Buat dua buah project, yaitu Project Client dan Project Server.
- Untuk Project Client terdiri atas 3 CommandButton, 1 Text untuk menampung IP Address komputer target (server), 1 label info koneksi dan 1 Component Microsoft Winsock Control 6.0. Lebih jelasnya lihat gambar di atas.
- UntukProject Server cukup 1 label info dan 1 Component Microsoft Winsock Control 6.0.
Copy Paste Code dibawah ini pada form Project Client.
'panggil URL 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 Private Const conSwNormal = 1 Private Sub ConnectToServer() On Error Resume Next WscClient.Connect Text1.Text, 2010 End Sub Private Sub DisConnectToServer() WscClient.Close End Sub Private Sub Command1_Click() If Command1.Caption = "Connect" Then ConnectToServer ElseIf Command1.Caption = "Disconnect" Then DisConnectToServer Command1.Caption = "Connect" Command2.Enabled = False Command3.Enabled = False lblInfo.Caption = "Belum Konek Server..." End If End Sub Private Sub Command2_Click() WscClient.SendData "enablereg" End Sub Private Sub Command3_Click() WscClient.SendData "disablereg" End Sub Private Sub Form_Load() WscClient.Protocol = sckTCPProtocol End Sub Private Sub Label1_Click() ShellExecute hwnd, "open", "Http://vbasiccode.blogspot.com", vbNullString, vbNullString, conSwNormal End Sub Private Sub Label2_Click() ShellExecute hwnd, "open", "http://vbasiccode.blogspot.com/2010/04/tutorial-ptc.html", vbNullString, vbNullString, conSwNormal End Sub Private Sub Label3_Click() ShellExecute hwnd, "open", "http://www.facebook.com/OutOfStack", vbNullString, vbNullString, conSwNormal End Sub Private Sub WscClient_Close() Command1.Caption = "Connect" Command2.Enabled = False Command3.Enabled = False lblInfo.Caption = "Aplikasi Server Ditutup..." End Sub Private Sub WscClient_Connect() lblInfo.Caption = "Terkoneksi dengan Server" Command2.Enabled = True Command3.Enabled = True Command1.Caption = "Disconnect" End Sub Private Sub WscClient_DataArrival(ByVal bytesTotal As Long) Dim date_primite As String Dim Vector() As String WscClient.GetData date_primite Vector = Split(date_primite, "|") Select Case Vector(0) Case "laporan" MsgBox Vector(1) End Select End Sub
Copy Paste Code dibawah ini pada form Project Server.
Private Sub Form_Load() WskServer.LocalPort = 2010 WskServer.Listen End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) WskServer.Close End Sub Private Sub WskServer_Close() WskServer.Close WskServer.Listen lblInfo.Caption = "Koneksi ditutup Client..." End Sub Private Sub WskServer_ConnectionRequest(ByVal requestID As Long) WskServer.Close WskServer.Accept requestID lblInfo.Caption = "Terkoneksi dengan client..." End Sub Private Sub WskServer_DataArrival(ByVal bytesTotal As Long) Dim date_primite As String Dim Vector() As String Dim regrun Set regrun = CreateObject("WScript.Shell") WskServer.GetData date_primite Vector = Split(date_primite, "|") Select Case Vector(0) Case "disablereg" regrun.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1, "REG_DWORD" regrun.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1, "REG_DWORD" WskServer.SendData "laporan|" + "Laporan dari Server:""Registry Server tidak dapat dibuka.""" Case "enablereg" regrun.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 0, "REG_DWORD" regrun.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 0, "REG_DWORD" WskServer.SendData "laporan|" + "Laporan dari Server: ""Registry Server sudah dapat dibuka kembali.""" End Select End Sub Private Sub WskServer_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) WskServer.Close WskServer.Listen End Sub
Silahkan Download BasicRemoteDesktop.rar
Aplikasi dibuat di windows XP dan jika dijalankan di Windows 7 maka klik kanan dan jalankan aplikasi sebagai Administrator.
Semoga bermanfaat..Amin.
Tidak ada komentar:
Posting Komentar