Tippseite

VB-Homepage Tipp 144

Echtheitsprüfung von Kreditkartennummern

Nun erwarten Sie hoffentlich nicht zuviel.
Das Dumme an der Sache ist, ich bin nicht im Besitz einer solchen Kreditkarte um damit zu testen, ob die Anzeige korrekt ist.
Da das Tool aber sinnfällige Ergebnisse erzielt und das Testen dann halt in Ihren Verantwortungsbereich fällt, möchte ich den Quellcode hier zur Verfügung stellen.

cards_ok.vbp
Form=cards_ok.Frm
ProjWinSize=82,578,222,128
ProjWinShow=2
IconForm="Form1"
Title="Kreditkartennummern Checker"
ExeName32="cards_ok.exe"
Name="Projekt1"
HelpContextID="0"
StartMode=0
VersionCompatible32="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0

cards_ok.frm
VERSION 4.00
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "Kreditkartennummern Checker"
ClientHeight = 1830
ClientLeft = 3465
ClientTop = 3930
ClientWidth = 3990
Height = 2235
Left = 3405
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1830
ScaleWidth = 3990
ShowInTaskbar = 0 'False
Top = 3585
Width = 4110
Begin VB.Frame Frame1
Height = 1815
Left = 0
TabIndex = 0
Top = 0
Width = 3975
Begin VB.TextBox Text1
Height = 285
Left = 120
TabIndex = 1
Top = 480
Width = 1695
End
Begin VB.Shape Shape1
BackColor = &H0000FFFF&
BackStyle = 1 'Opaque
BorderColor = &H00808080&
BorderWidth = 2
FillStyle = 6 'Cross
Height = 375
Left = 240
Top = 840
Width = 495
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Überprüfen von Kreditkartennummern auf Echtheit."
Height = 495
Left = 1080
TabIndex = 3
Top = 1200
Width = 2775
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "mit <Enter> abschliessen !"
Height = 255
Left = 1920
TabIndex = 2
Top = 480
Width = 1935
End
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "Tipp : James Johnston e-mail : instant@email4life.com"
Height = 255
Left = 0
TabIndex = 4
Top = 1800
Width = 3975
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Function IsEven(TestInt As Integer) As Boolean
Dim TestValues As String, TmpChar As String, Answer As Integer
TestValues = "02468"
TmpChar = Right$(Trim(Str$(TestInt)), 1)
Answer = InStr(1, TestValues, TmpChar)
IsEven = Answer
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
'Debug.Print Counter, TmpInt, Answer
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
'Debug.Print Counter, TmpInt, Answer
Counter = Counter + 1
End If
Wend
Answer = Answer Mod 10
If Answer = 0 Then CheckCard = True
End Function
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Text1) > 0 Then x = CheckCard(Text1)
If x = True Then MsgBox "OK" Else MsgBox "Falsch"
End If
End Sub

Um diesen Quellcode zu nutzen, erstellen Sie sich mit einem Editor Dateien, die Sie wie angegeben benennen und starten anschließend die *.vbp Datei oder öffnen das Projekt aus VB heraus.

Tipp-Download

Quelle : James Johnston instant@email4life.com