函数：银行卡号验证和开户行

opiona

修改了BUG 最新附件在7楼：

闲来无事 分享两个自定义函数：

根据搜索的算法规则，写了卡号验证函数，还是比较简单的

1. Public Function Check_BankCard(ByVal CardId As String) As Boolean
   
2.     Rem 信用卡号码都是合法的，它必须通过Luhn算法来验证通过。
   
3.     Rem 测试号码：6222600810010710887 6225881414207430  5432123456788881
   
4.     Rem MsgBox Check_BankCard("6222600810010710887")
   
5.    
   
6.     Dim BL As Boolean
   
7.    
   
8.     Rem 银行卡号长度必须在16到19之间
   
9.     If Len(CardId) > 19 Or Len(CardId) < 16 Then
   
10.         Rem MsgBox "银行卡号长度必须在16到19之间"
    
11.         Check_BankCard = False
    
12.         Exit Function
    
13.     End If
    
14.    
    
15.     Rem 银行卡号必须全为数字
    
16.     BL = True
    
17.     For X = 1 To Len(CardId)
    
18.         If Asc(Mid(CardId, X, 1)) > 57 Or Asc(Mid(CardId, X, 1)) < 48 Then
    
19.             Rem MsgBox "银行卡号必须全为数字"
    
20.             Check_BankCard = False
    
21.             Exit Function
    
22.         End If
    
23.     Next
    
24.    
    
25.     Rem 银行卡号开头2位不符合规范
    
26.     Dim ARX() As String
    
27.     Dim strBin As String
    
28.     strBin = "10,18,30,35,37,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,58,60,62,65,68,69,84,87,88,94,95,98,99"
    
29.    
    
30.     ARX = Split(strBin, ",")
    
31.     BL = False
    
32.     For X = 0 To UBound(ARX)
    
33.         If Mid(CardId, 1, 2) = ARX(X) Then
    
34.             BL = True
    
35.             Exit For
    
36.         End If
    
37.     Next
    
38.     If BL = False Then
    
39.         Rem MsgBox "银行卡号开头6位不符合规范"
    
40.         Check_BankCard = False
    
41.         Exit Function
    
42.     End If
    
43.    
    
44.     Rem 必须通过Luhn算法来验证通过
    
45.     Dim INTJS, INTOS, INTTEMP As Integer
    
46.     For X = Len(CardId) To 1 Step -2
    
47.         Rem 从卡号最后一位数字开始，逆向将奇数位(1、3、5等等)相加。
    
48.         INTJS = INTJS + Val(Mid(CardId, X, 1))
    
49.         Rem 从卡号最后一位数字开始，逆向将偶数位数字，先乘以2（如果乘积为两位数，则将其减去9），再求和。
    
50.         If X > 1 Then
    
51.             INTTEMP = Val(Mid(CardId, X - 1, 1)) * 2
    
52.             If INTTEMP > 9 Then INTTEMP = INTTEMP - 9
    
53.             INTOS = INTOS + INTTEMP
    
54.         End If
    
55.     Next
    
56.     Rem  将奇数位总和加上偶数位总和（有些要减去9），结果应该可以被10整除。
    
57.     INTTEMP = INTJS + INTOS
    
58.     Rem 可以被10整除，认定校验通过。
    
59.     If INTTEMP Mod 10 = 0 Then
    
60.         Check_BankCard = True
    
61.     Else
    
62.         Rem MsgBox "完整卡号可能是：" & CardId & INTTEMP Mod 10
    
63.         Check_BankCard = False
    
64.     End If
    
65. End Function

复制代码

opiona

只粘出主要部分
BinBank  很长，详见楼上附件

1. Function GetStockAllData(ByRef StockCode As String) As String
   
2.     Rem 获得银行卡号的开户行  只是：总行
   
3.     Rem 测试号码：6222600810010710887 6225881414207430  5432123456788881
   
4.     Rem MsgBox GetStockAllData("6222600810010710887")
   
5.    
   
6.     Dim StrUrl, StrTemp As String
   
7.     Dim I, X As Integer
   
8.     Dim ARX, BRX
   
9.    
   
10.     Rem 已知银行代码
    
11.     Dim BINBANK As String
    
12.     BINBANK = ""
    
13.     BINBANK = BINBANK & "SRCB|深圳农村商业银行,BGB|广西北部湾银行,SHRCB|上海农村商业银行,BJBANK|北京银行,WHCCB|威海市商业银行,BOZK|周口银行"
    
14.   
    
15.     BRX = Split(BINBANK, ",")
    
16.    
    
17.     Rem 查询卡的信息
    
18.     StrUrl = "https://ccdcapi.alipay.com/validateAndCacheCardInfo.json?_input_charset=utf-8&cardNo="
    
19.     StrUrl = StrUrl & StockCode
    
20.     StrUrl = StrUrl & "&cardBinCheck=true"
    
21.    
    
22.     Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    
23.     With xmlhttp
    
24.         .Open "get", StrUrl, False
    
25.         .send
    
26.         StrTemp = Replace(StrConv(.responsebody, vbUnicode, &H804), Chr(34), "")
    
27.         Rem {"bank":"COMM","validated":true,"cardType":"DC","key":"6222600810010710887","messages":[],"stat":"ok"}
    
28.         Rem bank      银行的名称代码
    
29.         Rem validated 是否通过验证,支付宝的这个API并没有使用LUHN算法来验证银行卡是否合法
    
30.     End With
    
31.    
    
32.     Rem 文本处理
    
33.     ARX = Split(StrTemp, ",")
    
34.     If UBound(ARX) > 0 Then
    
35.         X = 0
    
36.         If InStr(ARX(X), "bank") > 0 Then
    
37.             ARX(X) = Split(ARX(X), ":")(1)
    
38.             For I = 0 To UBound(BRX)
    
39.                 If InStr(BRX(I), ARX(X)) > 0 Then
    
40.                     GetStockAllData = Split(BRX(I), "|")(1)
    
41.                     Exit Function
    
42.                 End If
    
43.             Next
    
44.         Else
    
45.            Rem MsgBox "未找到开户行信息"
    
46.             GetStockAllData = "未找到开户行信息"
    
47.             Exit Function
    
48.         End If
    
49.     Else
    
50.         Rem MsgBox "未获得数据，请检查网络"
    
51.         GetStockAllData = "未获得数据，请检查网络"
    
52.         Exit Function
    
53.     End If
    
54.    
    
55. End Function
    

复制代码

补充内容 (2018-8-29 09:31):
API免费通道以关闭，开户行用信息 函数 已经失效
需要的童鞋，可使用阿里的银行四要素API（付费的）
地址在：19 楼

aman1516

opiona 发表于 2018-3-3 13:14
只粘出主要部分
BinBank  很长，详见楼上附件

谢谢分享，卡号证验正确，非常好！
现时仍有不少以存折扣款的，能实现个 “存折号验证及开户行" 么？

hhwq1

我试一下，用你的《银行卡号验证和开户行》验证时有的银行卡号的开户行显示不正确，如本来是建行却显示为威海市商业银行。卡号验证时能不能不单独增加一行，直接用表格控件来验证，对错误的银行卡号下面用黄色底纹来表示呢？

aman1516

opiona 发表于 2018-3-3 13:14
只粘出主要部分
BinBank  很长，详见楼上附件

谢谢分享，验证正确，非常好！
现时仍有不少用存折扣款的，能实现 "存折号验证及开户行"  么？

dssrmyh

谢谢分享，非常实用

opiona

hhwq1 发表于 2018-3-5 12:06
我试一下，用你的《银行卡号验证和开户行》验证时有的银行卡号的开户行显示不正确，如本来是建行却显示为威 ...

谢谢指正，确实有此问题，已经修改
详见附件： 银行卡号验证和开户行.rar (24.82 KB, 下载次数: 895)

2018-3-5 14:32 上传

点击文件名下载附件
更新版本

代码修改部分：

hezudao_long

opiona 发表于 2018-3-5 14:33
谢谢指正，确实有此问题，已经修改
详见附件：
代码修改部分：

厉害了楼主，想请教您，这些卡号中，公对公帐号，和部分位数很长或者很短的卡号，也满意这算法吗？

opiona

不是业内 不是很清楚
我也是网络上收集 的

凤翔时代

opiona 发表于 2018-3-5 14:33
谢谢指正，确实有此问题，已经修改
详见附件：
代码修改部分：

谢谢老师的付出，不知能否把这两个自定义函数放在其它代码中引用，实现连动，例如某列填入卡号，然后直接就运用这两个函数进行判断了