扫码消费机介绍：
https://item.taobao.com/item.htm?spm=a1z10.1-c.w4004-21914722028.4.2b826baado8Yr1&id=17030077924
下载：
vb6支付宝、微信扫码收款软件源码.rar-餐饮零售文档类资源-CSDN下载
Public Declare Function PQRCodeEx Lib "PayApiFun.dll" (ByRef QRCodeStr As String) As Integer
Public Declare Function WeiXinPayCode Lib "PayApiFun.dll" (ByRef AuthCode As String, ByRef OrdNum As String, ByRef TotalFee As String, ByRef outinf As String) As Integer
Public Declare Function WeiXinQuery Lib "PayApiFun.dll" (ByRef OrdNum As String, ByRef outinf As String) As Integer
Public Declare Function WeiXinPayCodeEx Lib "PayApiFun.dll" (ByRef Lockappid As String, ByRef Lockmchid As String, ByRef LockIdkey As String, ByRef AuthCode As String, ByRef OrdNum As String, ByRef TotalFee As String, ByRef outinf As String) As Integer
Public Declare Function WeiXinPayQRCodeEx Lib "PayApiFun.dll" (ByRef Lockappid As String, ByRef Lockmchid As String, ByRef LockIdkey As String, ByRef OrdNum As String, ByRef TotalFee As String, ByRef outinf As String) As Integer
Public Declare Function WeiXinQueryEx Lib "PayApiFun.dll" (ByRef Lockappid As String, ByRef Lockmchid As String, ByRef LockIdkey As String, ByRef OrdNum As String, ByRef outinf As String) As Integer
Public Declare Function ZhiFuBaoPayCodeEx Lib "PayApiFun.dll" (ByRef Lockappid As String, ByRef AuthCode As String, ByRef OrdNum As String, ByRef TotalFee As String, ByRef outinf As String) As Integer
Public Declare Function ZhiFuBaoPayQRCodeEx Lib "PayApiFun.dll" (ByRef Lockappid As String, ByRef OrdNum As String, ByRef TotalFee As String, ByRef outinf As String) As Integer
Public Declare Function ZhiFuBaoQueryEx Lib "PayApiFun.dll" (ByRef Lockappid As String, ByRef OrdNum As String, ByRef outinf As String) As Integer
'------------------------------------------------------------------------------------------------------------------------------------------------------以上函数仅用于vb6调用，下面的函数可以备各种开发工具调用，注意声明函数的参数类型-------------------------------------------------------------------------
Public Declare Function WeiXinPayCodeEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal Lockmchid As String, ByVal Idkey As String, ByVal IdkeyLock As Integer, ByVal AuthCode As String, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function WeiXinPayQRCodeEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal Lockmchid As String, ByVal Idkey As String, ByVal IdkeyLock As Integer, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function WeiXinQueryEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal Lockmchid As String, ByVal Idkey As String, ByVal IdkeyLock As Integer, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function WeiXinCloseOrderEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal Lockmchid As String, ByVal Idkey As String, ByVal IdkeyLock As Integer, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoPayCodeEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal AuthCode As String, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoPayQRCodeEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoQueryEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoPayCancelEx1 Lib "PayApiFun.dll" (ByVal Lockappid As String, ByVal OrdNum As String, ByRef outinf As Any) As Integer
'------------------------------------------------------------------------------------------------------------------------------------------------------第二版函数，未授权加密的账号也可以调用，但是有金额限制--------------------------------------------------------------------------------------------------
Public Declare Function WeiXinPayCodeEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal mchid As String, ByVal registered As Integer, ByVal Idkey As String, ByVal keylock As Integer, ByVal AuthCode As String, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function WeiXinPayQRCodeEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal mchid As String, ByVal registered As Integer, ByVal Idkey As String, ByVal keylock As Integer, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function WeiXinQueryEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal mchid As String, ByVal registered As Integer, ByVal Idkey As String, ByVal keylock As Integer, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function WeiXinCloseOrderEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal mchid As String, ByVal registered As Integer, ByVal Idkey As String, ByVal keylock As Integer, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoPayCodeEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal registered As Integer, ByVal AuthCode As String, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoPayQRCodeEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal registered As Integer, ByVal OrdNum As String, ByVal TotalFee As String, ByVal inbody As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoQueryEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal registered As Integer, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function ZhiFuBaoPayCancelEx2 Lib "PayApiFun.dll" (ByVal appid As String, ByVal registered As Integer, ByVal OrdNum As String, ByRef outinf As Any) As Integer
Public Declare Function PQRCodeEx1 Lib "PayApiFun.dll" (ByVal QRCodeStr As String) As Integer
Public Declare Function MyMD5 Lib "PayApiFun.dll" (ByVal inputstr As String, ByRef outinf As Any) As Integer
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Function sGetINI(strPath As String, strSection As String, strKey As String, strDefault As String) As String
Dim strV As String
Dim aa As Long
strV = " "
aa = GetPrivateProfileString(strSection, strKey, strDefault, strV, 255, strPath)
strV = Trim(strV)
strV = Left(strV, Len(strV) - 1)
sGetINI = strV
End Function
Public Sub writeINI(strPath As String, strSection As String, strKey As String, strValue As String)
WritePrivateProfileString strSection, strKey, strValue, strPath
End Sub
Public Function GetMACAddress() As String
Set objs = GetObject("winmgmts:").ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapter WHERE ((MACAddress Is Not NULL) AND (Manufacturer <> 'Microsoft'))")
For Each obj In objs
GetMACAddress = Trim(Replace(obj.Macaddress, ":", ""))
MyMACStr = GetMACAddress
Exit For
Next obj
End Function
Public Function WritePayInf(inf As String)
Dim FileNameStr As String
FileNameStr = "\" + Format(Date, "YYYYMMDD") + ".TXT"
Open App.Path & FileNameStr For Append As #1
Print #1, inf
Close #1
End Function
Dim QrcodeTimer As Date
Dim MyMACStr As String
Dim QrZFBNum As String
Dim PayInfStr As String
Private Sub Command1_Click()
Dim outinf(500) As Byte
Dim OrdNumStr As String
Dim resul As Integer
QrZFBNum = ""
OrdNumStr = Format(Now, "YYMMDDHHMMSS" & Right(timeGetTime, 3)) & MyMACStr
resul = MyMD5(OrdNumStr, VarPtr(outinf(0)))
If resul = 0 Then
OrdNumStr = OrdNumStr & Mid(MidB(StrConv(outinf, vbUnicode), 1, 500), 1, 3)
End If
Text2 = OrdNumStr
Text3 = ""
Text3.SetFocus
End Sub
Private Sub Command14_Click()
Dim asnw As Long
asnw = MsgBox("是否要保存当前的收款账号信息？", vbQuestion + vbOKCancel, "提示")
If asnw = vbOK Then
On Error Resume Next
writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "ZhiFuBaoAppid", Trim(ZFBAPPID.Text)
writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinAppid", Trim(WXGZH.Text)
writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinMchid", Trim(WXSFH.Text)
writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinKey", Trim(WXKEY.Text)
If Option2.Value Then writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "RegisteredEn", "1" Else writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "RegisteredEn", "0"
If Option4.Value Then writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinKeyLockEn", "1" Else writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinKeyLockEn", "0"
writeINI App.Path & "\PayConfig.ini", "DefaultSetup", "InBody", Trim(Text7.Text)
End If
Frame1.Visible = False
End Sub
Private Sub Command15_Click()
Frame1.Visible = True
End Sub
Private Sub Command16_Click()
Dim resul As Integer
Dim Lockappid As String
Dim Lockmchid As String
Dim Idkey As String
Dim IdkeyLock As Integer
Dim registered As Integer
Dim AuthCode As String
Dim OrdNum As String
Dim TotalFee As String
Dim inbody As String
Dim outinf(255) As Byte
Text4 = ""
If Trim(Text2) = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If Trim(Text3) = "" Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If CCur(Text3.Text) * 100 = 0 Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
Lockappid = Trim(WXGZH.Text) '微信公众账号
Lockmchid = Trim(WXSFH.Text) '商户号
Idkey = Trim(WXKEY.Text) 'API密钥
If Option4.Value Then IdkeyLock = 1 Else IdkeyLock = 0 'API是否加密
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
OrdNum = Trim(Text2.Text)
TotalFee = Format(CCur(Text3.Text) * 100, "0") '总计支付金额，单位分
inbody = Trim(Text7.Text) '商品信息
Command16.Caption = "正在申请，请稍后..."
Command16.Enabled = False
'resul = WeiXinPayQRCodeEx1(Lockappid, Lockmchid, Idkey, IdkeyLock, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第一代函数加密收款账号 函数调用
resul = WeiXinPayQRCodeEx2(Lockappid, Lockmchid, registered, Idkey, IdkeyLock, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第二代函数调用
PayInfStr = MidB(StrConv(outinf, vbUnicode), 1, 255)
PayInfStr = "Wei " & OrdNum & " " & Trim(PayInfStr)
WriteInf PayInfStr
Select Case resul
Case 0
QrcodeTimer = Now
Text4.Text = "微信支付单号‘" + OrdNum + "’支付二维码已经生成，有效时间5分钟，可轮询调用‘查询微信订单状态’函数查询支付结果！"
Image1.Picture = LoadPicture(App.Path & "\QRcode.BMP")
Case 1
Text4.Text = "微信支付单号‘" + OrdNum + "’正在申请支付二维码..." + Trim(MidB(StrConv(outinf, vbUnicode), 1, 255))
Case -10
Text4.Text = "微信支付单号‘" + OrdNum + "’二维支付地址：" + Trim(MidB(StrConv(outinf, vbUnicode), 1, 255)) '二维码字符串申请成功，生成图形时异常
QrcodeTimer = Now
Case Else
Text4.Text = "微信支付单号‘" + OrdNum + "’二维支付地址申请失败！API接口返回信息：" + Trim(MidB(StrConv(outinf, vbUnicode), 1, 255))
End Select
Command16.Caption = "生成二维码扫码支付"
Command16.Enabled = True
If resul = 0 Then QueryWeiXin
End Sub
Private Sub Command17_Click()
Dim resul As Integer
Dim Lockappid As String
Dim registered As Integer
Dim outinf(255) As Byte
Dim a() As Byte
Dim OrdNum As String
Dim TotalFee As String
Dim inbody As String
Text4 = ""
If Trim(Text2) = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If Trim(Text3) = "" Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If CCur(Text3.Text) = 0 Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
a = StrConv(Space(300), vbFromUnicode) '字符串转换为字节数组
For i = 0 To 255
outinf(i) = a(i)
Next
Lockappid = Trim(ZFBAPPID.Text) '支付宝合作身份者（PID） D003731A306623CD651DD59EFE0421380000D2
OrdNum = Trim(Text2.Text)
TotalFee = Format(CCur(Text3.Text), "0.00") '总计支付金额，单位元
AuthCode = Trim(Text1)
inbody = Trim(Text7.Text) '商品信息
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
Command17.Caption = "正在申请，请稍后..."
Command17.Enabled = False
'resul = ZhiFuBaoPayQRCodeEx1(Lockappid, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第一代函数调用
resul = ZhiFuBaoPayQRCodeEx2(Lockappid, registered, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第二代函数调用
PayInfStr = "ZFB " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
Select Case resul
Case 0
QrcodeTimer = Now
QrZFBNum = OrdNum
Text4.Text = "支付宝支付单号‘" + OrdNum + "’支付二维码已经生成，可调用‘查询支付宝订单状态’函数查询支付结果！"
PQRCodeEx Trim(Trim(MidB(StrConv(outinf, vbUnicode), 1, 255)))
Image1.Picture = LoadPicture(App.Path & "\QRcode.BMP")
Case Else
Text4.Text = "支付宝支付单号‘" + OrdNum + "’二维支付地址申请失败！" + Trim(MidB(StrConv(outinf, vbUnicode), 1, 255))
End Select
Command17.Caption = "生成支付宝支付二维码"
Command17.Enabled = True
If resul = 0 Then QueryZhiFuBao
End Sub
Private Sub Command18_Click()
Dim resul As Integer
Dim Lockappid As String
Dim Lockmchid As String
Dim Idkey As String
Dim IdkeyLock As Integer
Dim registered As Integer
Dim AuthCode As String
Dim OrdNum As String
Dim TotalFee As String
Dim outinf(255) As Byte
Text4 = ""
Lockappid = Trim(WXGZH.Text) '微信公众账号
Lockmchid = Trim(WXSFH.Text) '商户号
Idkey = Trim(WXKEY.Text) 'API密钥
If Option4.Value Then IdkeyLock = 1 Else IdkeyLock = 0 'API是否加密
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
OrdNum = Trim(Text2.Text)
If OrdNum = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Text2.SetFocus: Exit Sub
Command18.Enabled = False
Command18.Caption = "正在关闭订单，请稍后..."
Timer2.Enabled = False
'resul = WeiXinCloseOrderEx1(Lockappid, Lockmchid, Idkey, IdkeyLock, OrdNum, VarPtr(outinf(0))) '第一代函数调用
resul = WeiXinCloseOrderEx2(Lockappid, Lockmchid, registered, Idkey, IdkeyLock, OrdNum, VarPtr(outinf(0))) '第二代函数调用
Text1.Text = ""
PayInfStr = "Wei " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
Select Case resul
Case 0
Text4.Text = "微信支付单号‘" + OrdNum + "’关闭成功！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "微信支付单号‘" + OrdNum + "’关闭成功！", vbInformation + vbOKOnly, "提示"
Command1_Click
Case Else
Text4.Text = "微信支付单号‘" + OrdNum + "’关闭失败！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
End Select
Command18.Enabled = True
Command18.Caption = "关闭微信扫码订单"
CancelQueryWeiXin
End Sub
Private Sub Command19_Click()
Dim Lockappid As String
Dim registered As Integer
Dim resul As Integer
Dim OrdNum As String
Dim outinf(255) As Byte
Text4 = ""
Lockappid = Trim(ZFBAPPID.Text) '支付宝合作身份者（PID） D003731A306623CD651DD59EFE0421380000D2
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
OrdNum = Trim(Text2.Text)
If OrdNum = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Text2.SetFocus: Exit Sub
Command19.Enabled = False
Command19.Caption = "正在申请，请稍后..."
Timer3.Enabled = False
'resul = ZhiFuBaoPayCancelEx1(Lockappid, OrdNum, VarPtr(outinf(0))) '第一代函数调用
resul = ZhiFuBaoPayCancelEx2(Lockappid, registered, OrdNum, VarPtr(outinf(0))) '第二代函数调用
Text1.Text = ""
PayInfStr = "ZFB " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
Select Case resul
Case 0
Text4.Text = "支付宝支付单号‘" + OrdNum + "’还未支付，已撒销成功！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "支付宝支付单号‘" + OrdNum + "’撒销成功！", vbInformation + vbOKOnly, "提示"
Command1_Click
Case 1
Text4.Text = "支付宝支付单号‘" + OrdNum + "’撒销成功！已触发退款动作！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "支付宝支付单号‘" + OrdNum + "’撒销成功！", vbInformation + vbOKOnly, "提示"
Command1_Click
Case Else
Text4.Text = "支付宝支付单号‘" + OrdNum + "’撒销失败！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
End Select
Command19.Enabled = True
Command19.Caption = "撤销支付宝支付订单"
CancelQueryZhiFuBao
End Sub
Private Sub Command5_Click()
Dim resul As Integer
Dim Lockappid As String
Dim Lockmchid As String
Dim Idkey As String
Dim IdkeyLock As Integer
Dim registered As Integer
Dim AuthCode As String
Dim OrdNum As String
Dim TotalFee As String
Dim outinf(255) As Byte
Text4 = ""
Lockappid = Trim(WXGZH.Text) '微信公众账号
Lockmchid = Trim(WXSFH.Text) '商户号
Idkey = Trim(WXKEY.Text) 'API密钥
If Option4.Value Then IdkeyLock = 1 Else IdkeyLock = 0 'API是否加密
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
OrdNum = Trim(Text2.Text)
If OrdNum = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Text2.SetFocus: Exit Sub
Timer2.Enabled = False
Command5.Enabled = False
Command5.Caption = "正在查询中，请稍后..."
'resul = WeiXinQueryEx1(Lockappid, Lockmchid, Idkey, IdkeyLock, OrdNum, VarPtr(outinf(0))) '第一代函数调用
resul = WeiXinQueryEx2(Lockappid, Lockmchid, registered, Idkey, IdkeyLock, OrdNum, VarPtr(outinf(0))) '第二代函数调用
Select Case resul
Case 0
Text4.Text = "微信支付单号‘" + OrdNum + "’支付成功！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
PayInfStr = "Wei " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
MsgBox "微信支付单号‘" + OrdNum + "’支付成功！", vbInformation + vbOKOnly, "提示"
CancelQueryWeiXin
Command1_Click
Case 1
Timer2.Enabled = True '继续查询该订单
Text4.Text = "微信支付单号‘" + OrdNum + "’正在支付中...请稍后查询此单支付状态，API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
Case 2
If DateDiff("s", QrcodeTimer, Now) < 300 Then '二维码还在有效时间内，需继续查询该订单
Timer2.Enabled = True '继续查询该订单
Text4.Text = "微信支付单号‘" + OrdNum + "’还未支付，订单有效期 5 分钟，系统正在查询支付结果，API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
Else
Text4.Text = "微信支付单号‘" + OrdNum + "’还未支付，订单已过有效期，提交关闭订单指令。API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
Command18_Click '关闭订单
End If
Case Else
Text4.Text = "微信支付单号‘" + OrdNum + "’支付失败！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
PayInfStr = "Wei " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
MsgBox "微信支付单号‘" + OrdNum + "’支付失败！", vbCritical + vbOKOnly, "提示"
CancelQueryWeiXin
Command1_Click
End Select
Command5.Enabled = True
Command5.Caption = "查询微信订单状态"
End Sub
Private Sub Command6_Click()
Dim resul As Integer
Dim Lockappid As String
Dim Lockmchid As String
Dim Idkey As String
Dim IdkeyLock As Integer
Dim registered As Integer
Dim AuthCode As String
Dim OrdNum As String
Dim TotalFee As String
Dim inbody As String
Dim outinf(255) As Byte
Text4 = ""
If Trim(Text2) = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If Trim(Text3) = "" Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If CCur(Text3.Text) * 100 = 0 Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If Trim(Text1) = "" Then MsgBox "请扫描或输入18位微信付款码！", vbCritical + vbOKOnly, "提示": Text1.SetFocus: Exit Sub
Lockappid = Trim(WXGZH.Text) '微信公众账号
Lockmchid = Trim(WXSFH.Text) '商户号
Idkey = Trim(WXKEY.Text) 'API密钥
If Option4.Value Then IdkeyLock = 1 Else IdkeyLock = 0 'API是否加密
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
OrdNum = Trim(Text2.Text)
TotalFee = Format(CCur(Text3.Text) * 100, "0") '总计支付金额，单位分
AuthCode = Trim(Text1)
inbody = Trim(Text7.Text) '商品信息
If Option4.Value Then
If MsgBox(" 本次支付将从微信账号扣款，此扣款不能退回，确定要继续吗？", vbQuestion + vbOKCancel) <> vbOK Then Exit Sub
End If
Command6.Caption = "正在支付中，请稍后..."
Command6.Enabled = False
'resul = WeiXinPayCodeEx1(Lockappid, Lockmchid, Idkey, IdkeyLock, AuthCode, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第一代函数调用
resul = WeiXinPayCodeEx2(Lockappid, Lockmchid, registered, Idkey, IdkeyLock, AuthCode, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第二代函数调用
Text1.Text = ""
PayInfStr = "Wei " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
Select Case resul
Case 0
Text4.Text = "微信支付单号‘" + OrdNum + "’支付成功！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "微信支付单号‘" + OrdNum + "’支付成功！", vbInformation + vbOKOnly, "提示"
Command1_Click
Case 1
Text4.Text = "微信支付单号‘" + OrdNum + "’正在支付中...请稍后查询此单支付状态，API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
QueryWeiXin
Case Else
Text4.Text = "微信支付单号‘" + OrdNum + "’支付失败！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "微信支付单号‘" + OrdNum + "’支付失败！", vbCritical + vbOKOnly, "提示"
Command1_Click
End Select
Command6.Caption = "扫微信付款码支付"
Command6.Enabled = True
End Sub
Private Sub Command7_Click()
Dim resul As Integer
Dim Lockappid As String
Dim registered As Integer
Dim AuthCode As String
Dim OrdNum As String
Dim TotalFee As String
Dim inbody As String
Dim outinf(255) As Byte
Text4 = ""
If Trim(Text2) = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If Trim(Text3) = "" Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If CCur(Text3.Text) = 0 Then MsgBox "请输入支付金额！", vbCritical + vbOKOnly, "提示": Command1_Click: Exit Sub
If Trim(Text1) = "" Then MsgBox "请扫描或输入正确的支付宝付款码！", vbCritical + vbOKOnly, "提示": Text1.SetFocus: Exit Sub
Lockappid = Trim(ZFBAPPID.Text) '支付宝合作身份者（PID） D003731A306623CD651DD59EFE0421380000D2
OrdNum = Trim(Text2.Text)
TotalFee = Format(CCur(Text3.Text), "0.00") '总计支付金额，单位元
AuthCode = Trim(Text1)
inbody = Trim(Text7.Text) '商品信息
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
If Option4.Value Then
If MsgBox(" 本次支付将从支付宝账号扣款，此扣款不能退回，确定要继续吗？", vbQuestion + vbOKCancel) <> vbOK Then Exit Sub
End If
Command7.Caption = "正在支付中，请稍后..."
Command7.Enabled = False
'resul = ZhiFuBaoPayCodeEx1(Lockappid, AuthCode, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第一代函数调用
resul = ZhiFuBaoPayCodeEx2(Lockappid, registered, AuthCode, OrdNum, TotalFee, inbody, VarPtr(outinf(0))) '第二代函数调用
Text1.Text = ""
PayInfStr = "ZFB " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
Select Case resul
Case 0
Text4.Text = "支付宝支付单号‘" + OrdNum + "’支付成功！" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "支付宝支付单号‘" + OrdNum + "’支付成功！", vbInformation + vbOKOnly, "提示"
Command1_Click
Case 1
Text4.Text = "支付宝支付单号‘" + OrdNum + "’正在支付中...请稍后查询此单支付状态，API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
QueryZhiFuBao
Case Else
Text4.Text = "支付宝支付单号‘" + OrdNum + "’支付失败！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
MsgBox "支付宝支付单号‘" + OrdNum + "’支付失败！", vbCritical + vbOKOnly, "提示"
Command1_Click
End Select
Command7.Caption = "扫支付宝付款码支付"
Command7.Enabled = True
End Sub
Private Sub Command8_Click()
Dim resul As Integer
Dim Lockappid As String
Dim registered As Integer
Dim OrdNum As String
Dim outinf(255) As Byte
Text4 = ""
Lockappid = Trim(ZFBAPPID.Text) '支付宝合作身份者（PID） D003731A306623CD651DD59EFE0421380000D2
If Option2.Value Then registered = 1 Else registered = 0 '1 账号已注册授权 0未授权
OrdNum = Trim(Text2.Text)
If OrdNum = "" Then MsgBox "请输入商户号内的唯一订单编号！", vbCritical + vbOKOnly, "提示": Text2.SetFocus: Exit Sub
Command8.Enabled = False
Command8.Caption = "正在查询中，请稍后..."
'resul = ZhiFuBaoQueryEx1(Lockappid, OrdNum, VarPtr(outinf(0))) '第一代函数调用
resul = ZhiFuBaoQueryEx2(Lockappid, registered, OrdNum, VarPtr(outinf(0))) '第二代函数调用
Select Case resul
Case 0
Text4.Text = "支付宝支付单号‘" + OrdNum + "’支付成功！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
PayInfStr = "ZFB " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
MsgBox "支付宝支付单号‘" + OrdNum + "’支付成功！", vbInformation + vbOKOnly, "提示"
CancelQueryZhiFuBao
Command1_Click
Case 1
Text4.Text = "支付宝支付单号‘" + OrdNum + "’正在支付中...请稍后查询此单支付状态，API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
Case Else
If OrdNum = QrZFBNum And DateDiff("s", QrcodeTimer, Now) < 300 Then '还在有效时间内的扫码订单，需继续查询该订单
Text4.Text = "支付宝支付单号‘" + OrdNum + "’还未支付，订单有效期 5 分钟，系统正在查询支付结果，API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
Timer3.Enabled = True
Else
Text4.Text = "支付宝支付单号‘" + OrdNum + "’支付失败！API接口返回信息：" + MidB(StrConv(outinf, vbUnicode), 1, 255)
PayInfStr = "ZFB " & OrdNum & " " & MidB(StrConv(outinf, vbUnicode), 1, 255)
WriteInf PayInfStr
MsgBox "支付宝支付单号‘" + OrdNum + "’支付失败！", vbCritical + vbOKOnly, "提示"
CancelQueryZhiFuBao
Command1_Click
End If
End Select
Command8.Enabled = True
Command8.Caption = "查询支付宝订单状态"
End Sub
Private Sub Command9_Click()
End Sub
Private Sub Form_Activate()
If MyMACStr = "" Then MyMACStr = GetMACAddress '本电MAC
If Trim(Text2.Text) = "" Then Command1_Click
End Sub
Private Sub Form_Load()
On Error Resume Next
ZFBAPPID.Text = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "ZhiFuBaoAppid", "7349097602257AE331FADA6A700ECC0E00003C")
WXGZH.Text = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinAppid", "8D9C9D261CAB512B7B5234056000E337974BB7C30B4B8CC200066B")
WXSFH.Text = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinMchid", "E015D55433D4FEB188E0532ADCA3BEAF0806AD")
WXKEY.Text = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinKey", "37883883C24506DB42A5F227623BC563F2158C41C55089217BAC61DF568A5C23DB0095")
If Val(sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "RegisteredEn", "")) > 0 Then Option2.Value = True: Option1 = False Else Option2.Value = False: Option1.Value = True
If Val(sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "WeiXinKeyLockEn", "")) > 0 Then Option4.Value = True: Option3 = False Else Option4.Value = False: Option3.Value = True
Text7.Text = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "InBody", "荣士消费机、读卡器")
Label6.Caption = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "NoteStr", "QQ:954486673 Tel:22307058 微信:13822155058 公司官网:https//www.ruk168.com/ 淘宝:")
Text5.Text = sGetINI(App.Path & "\PayConfig.ini", "DefaultSetup", "UrlStr", "https://shop73172356.taobao.com")
PQRCodeEx Trim(Text5.Text)
Image1.Picture = LoadPicture(App.Path & "\QRcode.BMP")
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Timer1.Enabled = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
Timer1.Enabled = False
Label3.BackColor = &H8000000F
If InStr(1, "101112131415", Mid(Text1.Text, 1, 2)) > 0 And Len(Text1.Text) = 18 Then
Command6.SetFocus
Command6_Click
ElseIf InStr(1, "252627282930", Mid(Text1.Text, 1, 2)) > 0 And Len(Text1.Text) >= 16 And Len(Text1.Text) <= 24 Then
Command7.SetFocus
Command7_Click
End If
Case vbKey0 To vbKey9, vbKeyBack
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub Text5_Click()
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe " & Trim(Text5)
End Sub
Private Sub Text1_LostFocus()
Timer1.Enabled = False
Label3.BackColor = &H8000000F
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
Text1.SetFocus
Case 45, 46, vbKey0 To vbKey9, vbKeyBack
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub Text3_LostFocus()
If Trim(Text3) <> "" Then
If CCur(Text3) > 0 Then
If Trim(Text2) = "" Then
Dim outinf(500) As Byte
Dim OrdNumStr As String
Dim resul As Integer
OrdNumStr = Format(Now, "YYMMDDHHMMSS" & Right(timeGetTime, 3)) & MyMACStr
resul = MyMD5(OrdNumStr, VarPtr(outinf(0)))
If resul = 0 Then
OrdNumStr = OrdNumStr & Mid(MidB(StrConv(outinf, vbUnicode), 1, 500), 1, 3)
End If
Text2 = OrdNumStr
End If
End If
End If
End Sub
Private Sub Timer1_Timer()
If Label3.BackColor = &H8000000F Then Label3.BackColor = &HC0FFFF Else Label3.BackColor = &H8000000F
End Sub
Private Sub QueryWeiXin()
Timer2.Enabled = True
Command1.Enabled = False
Command16.Enabled = False
Command6.Enabled = False
Command5.Enabled = True
Command18.Enabled = True
Command17.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command19.Enabled = False
End Sub
Private Sub CancelQueryWeiXin()
Timer2.Enabled = False
Command1.Enabled = True
Command16.Enabled = True
Command6.Enabled = True
Command5.Enabled = True
Command18.Enabled = True
Command17.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
Command19.Enabled = True
End Sub
Private Sub Timer2_Timer()
Command5_Click
End Sub
Private Sub QueryZhiFuBao()
Timer3.Enabled = True
Command1.Enabled = False
Command16.Enabled = False
Command6.Enabled = False
Command5.Enabled = False
Command18.Enabled = False
Command17.Enabled = False
Command7.Enabled = False
Command8.Enabled = True
Command19.Enabled = True
End Sub
Private Sub CancelQueryZhiFuBao()
Timer3.Enabled = False
Command1.Enabled = True
Command16.Enabled = True
Command6.Enabled = True
Command5.Enabled = True
Command18.Enabled = True
Command17.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
Command19.Enabled = True
End Sub
Private Sub Timer3_Timer()
Command8_Click
End Sub
Private Sub WriteInf(ByVal BackInf As String)
If List1.ListCount > 50 Then List1.Clear
List1.AddItem (BackInf)
List1.ListIndex = List1.ListCount - 1
WritePayInf BackInf
End Sub
版权声明：本文为zhangjin7422原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。