זקוק לקוד של בדיקת מס' כרטיס אשראי וזהות (access)

[יהודה מילר]

אודה מאד למי שיש קוד כזה ויהי' מוכן לשלוח לי, בתודה מראש

 

[saryoram]

[SIZE=2]
'[/SIZE][FONT=Courier New (Hebrew)][SIZE=2]בדיקת מספר תעודת זהות
[/SIZE][/FONT][SIZE=2]Public Function CheckZehot(sNum As String) As Boolean
Dim ch As String, i As Integer, iSum As Integer
Dim iTemp As Integer

For i = 1 To 8
ch = Mid(sNum, i, 1)
iTemp = Val(ch) * (((i - 1) Mod 2) + 1)
If iTemp > 9 Then iTemp = (iTemp Mod 10) + (iTemp \ 10)
iSum = iSum + iTemp

Next i

If ((10 - (iSum Mod 10)) Mod 10) = Val(Mid(sNum, 9, 1)) Then
' If (iSum Mod 10) + Val(Mid(sNum, 9, 1)) = 10 Then
CheckZehot = True
Else
CheckZehot = False
End If
End Function
[/SIZE][FONT=Courier New (Hebrew)][/FONT]

 

[saryoram]

זה של ויזה
ישרכארט זה אחר.
שאר הכרטיסים לא בדקתי

Option Explicit
' ------------------------------------------------------------------------
' Credit Card Validation Solution, version 3.7        Visual Basic Edition
' 20 December 2002
'
' ------------------------------------------------------------------------
' DESCRIPTION:
' Credit Card Validation Solution uses a four step process to ensure
' credit card numbers are keyed in correctly.  This procedure accurately
' checks cards from American Express, Australian BankCard, Carte Blanche,
' Diners Club, Discover/Novus, JCB, MasterCard and Visa.
'
' ------------------------------------------------------------------------
' CAUTION:
' CCVS uses exact number ranges as part of the validation process. These
' ranges are current as of 13 Sept 1999.  If presently undefined ranges
' come into use in the future, this program will improperly deject card
' numbers in such ranges, rendering an error message entitled "Potential
' Card Type Discrepancy."  If this happens while entering a card & type
' you KNOW are valid, please contact us so we can update the ranges.
'
' ------------------------------------------------------------------------
' POTENTIAL CUSTOMIZATIONS:
' *  If you don't accept some of these card types, just comment out that
' section of the code by putting a single quote mark "'" at the beginning
' of the "Case," "CardName" and "ShouldLength" lines in question.
' *  Additional card types can be added by inserting new "Case,"
' "CardName" and "ShouldLength" lines.
' *  The three functions here can be called from elsewhere in your databse
' to check any number.
'
' ------------------------------------------------------------------------
' CREDITS:
' We learned of the Mod 10 Algorithm in some Perl code, entitled
' "The Validator," available on Matt's Script Archive,
' [URL]http://worldwidemart.com/scripts/readme/ccver.shtml[/URL].  That code was
' written by David Paris, who based it on material Melvyn Myers reposted
' from an unknown author.  Paris credits Aries Solis for tracking down the
' data underlying the algorithm.  At the same time, our code bears no
' resemblance to its predecessors.  My thanks to Allen Browne and
' Rico Zschau for feedback and further refinements.
'
' ------------------------------------------------------------------------
' COPYRIGHT NOTICE:
' a) This code is property of The Analysis and Solutions Company.
' b) It is being distributed free of charge and on an "as is" basis.
' c) Use of this code, or any part thereof, is contingent upon leaving
'     this copyright notice, name and address information in tact.
' d) Written permission must be obtained from us before this code, or any
'     part thereof, is sold or used in a product which is sold.
' e) By using this code, you accept full responsibility for it's use
'     and will not hold the Analysis and Solutions Company, its employees
'     or officers liable for damages of any sort.
' f) This code is not to be used for illegal purposes.
' g) Please email us any revisions made to this code.
' h) This code can not be reposted.  Sites such as code repositories
'     need to provide a link directly to our URI, below.
'
' Copyright 2002      [URL]http://www.AnalysisAndSolutions.com/code/ccvs-vb.htm[/URL]
' The Analysis and Solutions Company         [EMAIL="<לא ניתן לפרסם מיילים באופן פומבי>"]<לא ניתן לפרסם מיילים באופן פומבי>[/EMAIL]
' ------------------------------------------------------------------------
 
Public Function CCValidationSolution(Number As String) As Boolean
    On Error GoTo ErrHandle
    Dim NumberLength As Integer
    Dim CardName As String
    Dim ShouldLength As Integer
    Dim Missing As Integer
    '1) Get rid of spaces and non-numeric characters.
    Number = OnlyNumericSolution(Number)
    '2) Do the first four digits fit within proper ranges?
    '     If so, who's the card issuer and how long should the number be?
    NumberLength = Len(Number)
    Select Case Left(Number, 4)
        Case 3000 To 3059, 3600 To 3699, 3800 To 3889
            CardName = "Diners Club"
            ShouldLength = 14
        Case 3400 To 3499, 3700 To 3799
            CardName = "American Express"
            ShouldLength = 15
        Case 3528 To 3589
            CardName = "JCB"
            ShouldLength = 16
        Case 3890 To 3899
            CardName = "Carte Blanche"
            ShouldLength = 14
        Case 4000 To 4999
            CardName = "Visa"
            Select Case NumberLength
                Case Is > 14
                    ShouldLength = 16
                Case Is < 14
                    ShouldLength = 13
                Case Else
'                    MsgBox "The Visa number you typed in is 14 digits long." & Chr(13) & "Visa cards usually have 16 digits, though some have 13." & Chr(13) & Chr(13) & "Please check the number and try again.", vbExclamation, "Invalid Length:"
                    CCValidationSolution = False
                    Exit Function
            End Select
        Case 5100 To 5599
            CardName = "MasterCard"
            ShouldLength = 16
        Case 5610
            CardName = "Australian BankCard"
            ShouldLength = 16
        Case 6011
            CardName = "Discover/Novus"
            ShouldLength = 16
        Case Else
            MsgBox "The first four digits of the number entered are " & Left(Number, 4) & "." & Chr(13) & "If that's correct, we don't accept that type of credit card." & Chr(13) & "If it's wrong, please try again.", vbExclamation, "Potential Card Type Discrepancy:"
            CCValidationSolution = False
            Exit Function
    End Select
    '3) Is the number the right length?
    If NumberLength <> ShouldLength Then
        Missing = NumberLength - ShouldLength
'        If Missing < 0 Then
'            MsgBox "The " & CardName & " number entered, " & Number & ", is missing " & Abs(Missing) & " digit(s)." & Chr(13) & Chr(13) & "Please check the number and try again.", vbExclamation, "Invalid Length:"
'        Else
'            MsgBox "The " & CardName & " number entered, " & Number & ", has " & Missing & " too many digit(s)." & Chr(13) & Chr(13) & "Please check the number and try again.", vbExclamation, "Invalid Length:"
'        End If
        CCValidationSolution = False
        Exit Function
    End If
    '4) Does the number pass the Mod 10 Algorithm Checksum?
    If Mod10Solution(Number) = True Then
        CCValidationSolution = True
    Else
'        MsgBox "The " & CardName & " number entered, " & Number & ", is invalid." & Chr(13) & Chr(13) & "Please check the number and try again.", vbExclamation, "Bzzzzzzt..."
        CCValidationSolution = False
    End If
    Exit Function
ErrHandle:
    MsgBox Error, vbExclamation, "CC Validation Solution Had Error:"
    CCValidationSolution = False
End Function
 
Public Function OnlyNumericSolution(Number As String)
    On Error GoTo ErrHandle
    Dim Location As Integer
    Dim NumberLength As Integer
    Dim CurrentOutput As String
    Dim CurrentCharacter As String * 1
    NumberLength = Len(Number)
    If NumberLength > 50 Then
       ' Avoids system overload from hacking via super long input.
       NumberLength = 50
    End If
 
    ' Go through each number in the string.
    For Location = 1 To NumberLength
        CurrentCharacter = Mid(Number, Location, 1)
        Select Case Asc(CurrentCharacter)
            Case 48 To 57
                ' This character is a number,
                ' append it to the variable we're going to output.
                CurrentOutput = CurrentOutput & CurrentCharacter
        End Select
    Next
ExitHandle:
    OnlyNumericSolution = CurrentOutput
    Exit Function
ErrHandle:
    MsgBox Error, vbExclamation, "Only Numeric Solution Had Error:"
    Resume ExitHandle
End Function
 
Public Function Mod10Solution(Number As String) As Boolean
    'This works for numbers up to 255 characters long.
    'For longer numbers, increase variable data types as needed.
    On Error GoTo ErrHandle
    Dim NumberLength As Byte 'Up to 255 digits.
    Dim Location As Byte     'Up to 255 digits.
    Dim Checksum As Integer  'Up to 3,640 digits.
    Dim Digit As Byte
    NumberLength = Len(Number)
    'Add even digits in even length strings
    'or odd digits in odd length strings.
    For Location = 2 - (NumberLength Mod 2) To NumberLength Step 2
        Checksum = Mid(Number, Location, 1) + Checksum
    Next Location
    'Analyze odd digits in even length strings
    'or even digits in odd length strings.
    For Location = (NumberLength Mod 2) + 1 To NumberLength Step 2
        Digit = Mid(Number, Location, 1) * 2
        If Digit < 10 Then
            Checksum = Digit + Checksum
        Else
            Checksum = Digit - 9 + Checksum
        End If
    Next Location
    'Is the checksum divisible by ten?
    Mod10Solution = (Checksum Mod 10 = 0)
    Exit Function
ErrHandle:
    MsgBox Error, vbExclamation, "Mod 10 Solution Had Error:"
    Mod10Solution = False
End Function
 
 
'  ------------  BEGIN SAMPLE USER INTERFACE SECTION  -------------
'
' This section provides a simple sample user interface for the
' Credit Card Validation functions.  It produces an input box
' where you enter a card number to check.
'
' To run this code from the Module Window (without input from a
' form or query), place the cursor within this function, select the
' Run Menu and then choose Go/Continue.
'
' For real world use, call the CCValidationSolution directly from
' forms' After Update Event Procedures or other similar situations.
'
Public Function CCVSModuleWindowCCNumberTester()
    Dim CCVSAnswer As Boolean
    Dim Number As String
    Number = InputBox("Enter a Credit Card Number", "Enter a Number")
    CCVSAnswer = CCValidationSolution(Number)
    If CCVSAnswer = True Then
        Number = OnlyNumericSolution(Number)
        MsgBox Number & " is a valid number.", vbInformation, "Test Result:"
    End If
End Function
'
'  -------------  END SAMPLE USER INTERFACE SECTION  --------------

 

[יהודה מילר]

תודה על העזרה במס' זהות

רשמתי את הנ"ל בטופס כקוד,

אבל אני לא מצליח? הוא כותב לי הודעת שגיאה גם את המס' זהות תקין

 

[saryoram]

אתה חייב להזין 9 ספרות בכל מקרה גם אם יש 0 בהתחלה, ולכן שדה ת"ז חייב להיות מסוג טקסט ולא מספר

 

[יהודה מילר]

אני לא מצליח

יתכן שאיני יודע בדיוק היכן לרשום את הפונקציה? אולי תוכלו לעזור?

 

[saryoram]

אם לתיבת הטקסט קוראים TxtZehut

Private Sub TxtZehut_Exit(Cancel As Integer)
    If Not IsNull(TxtZehut) Then
        If CheckZehot(TxtZehut) = False Then
            Msgbox "מספר תעודת זהות שגוי"
            Cancel = True
        End If
    End If
End Sub