Membuat CC Generator

Ada project niy.. Kita akan membuat sebuah CC generator dengan Visual basic. Okay, tapi gak jamin Valid loch hehehe.. namanya juga usaha.. ;)



1. Pada visual basic buatlah project baru dengan properti seperti dibawah ini :

Jenis Item Nama
- Form Form1
- ComboBox CmbCCType
- CommandButton CmdStart
- CommandButton CmdExxit
- TextBox Text1

2. Buka jendela code editor atau klick 2 kali pada form lalu ketik listing dibawah :

Option Explicit
Option Base 1
Dim num1, num2
Dim CCType As String
Dim AC_Prefix As String
Dim AC_Len As Byte, AC_Prefix_Digit As Byte
Dim AC_Value() As Integer
Private Function AddDigits(ByVal mValue As String) As Long
Dim iPosition As Long
Dim mSum As Long

mSum = 0
For iPosition = 1 To Len(mValue)
mSum = mSum + CLng(Mid(mValue, iPosition, 1))
Next iPosition
AddDigits = mSum
End Function

Private Sub CmbCCType_Click()
CmdStart.Enabled = True
End Sub

Private Sub CmdExit_Click()
Unload Me
End
End Sub
Private Sub CmdStart_Click()
On Error GoTo err1
Dim str1 As String, str2 As String

str1 = ""
str2 = ""
Select Case CmbCCType.ListIndex
Case 0: AC_Len = 15
AC_Prefix_Digit = 2
AC_Prefix = "34"
Case 1: AC_Len = 14
AC_Prefix_Digit = 3
AC_Prefix = Str(Int((305 - 300 + 1) * Rnd() + 300))
Case 2: AC_Len = 16
AC_Prefix_Digit = 4
AC_Prefix = "6011"
Case 3: AC_Len = 15
AC_Prefix_Digit = 4
AC_Prefix = "2131"
Case 4: AC_Len = 16
AC_Prefix_Digit = 2
AC_Prefix = Str(Int((55 - 51 + 1) * Rnd() + 51))
Case 5: AC_Len = 13
AC_Prefix_Digit = 1
AC_Prefix = "4"
End Select

str1 = AC_Prefix
Do While True
Randomize Timer
DoEvents
For num1 = 1 To (AC_Len - AC_Prefix_Digit)
num2 = Int(Rnd * 9 + 1)
str1 = str1 + Str(num2)
Next
str2 = Format(Str(Val(str1)), "#################")

If LUHNMod10Verify(Trim(str2)) Then

CC_Number str2
Exit Sub
End If

str2 = ""
str1 = AC_Prefix
Loop

Exit Sub
err1:
MsgBox "pilih dulu dong,kartu kreditnya", vbCritical, ":-("
End Sub

Private Function LUHNMod10Verify(ByVal AccountNumber As String) As Boolean

Dim mResult As String
Dim mChar As String
Dim mPosition As Long
Dim mSum As Long

mResult = Trim(StrReverse(AccountNumber))
mSum = 0
For mPosition = 1 To Len(mResult)
mChar = Mid(mResult, mPosition, 1)

If (mPosition Mod 2 = 0) Then
mSum = mSum + AddDigits(CStr(CLng(mChar) * 2))
Else
mSum = mSum + CLng(mChar)
End If
Next mPosition
LUHNMod10Verify = (mSum Mod 10 = 0)

End Function

Private Sub Form_Load()
CmdStart.Enabled = False

CmbCCType.AddItem "AMERICAN_EXPRESS"
CmbCCType.AddItem "DINERS_CLUB"
CmbCCType.AddItem "DISCOVER"
CmbCCType.AddItem "JCB"
CmbCCType.AddItem "MASTERCARD"
CmbCCType.AddItem "VISA"
End Sub

Private Sub CC_Number(CC_Num As String)
Dim CC_Date As Date
Dim str4 As String
Dim month1 As String
Dim year1 As String

CC_Date = DateAdd("m", 1, Date)
month1 = Format(Str(CC_Date), "mmmm")
year1 = Format(Str(CC_Date), "yyyy")

str4 = vbNewLine + "********************" + vbNewLine
str4 = str4 + "type kartu kredit : " + vbNewLine
str4 = str4 + CmbCCType.Text + vbNewLine
str4 = str4 + "---------------------" + vbNewLine
str4 = str4 + "---------------------" + vbNewLine
str4 = str4 + "Nomor kartu kredit : " + vbNewLine
str4 = str4 + CC_Num + vbNewLine
str4 = str4 + "---------------------" + vbNewLine
str4 = str4 + "---------------------" + vbNewLine
str4 = str4 + "berlaku sampai :" + vbNewLine
str4 = str4 + month1 + ", " + year1 + vbNewLine
str4 = str4 + "********************" + vbNewLine
Text1 = str4
End Sub

No comments:

Post a Comment