vb6开发支付宝、微信支付

vx_13822155058
已于 2022-03-30 14:40:27 修改
阅读量2.7k
点赞数 1
分类专栏： 18002295132 QQ:954486673 扫码支付文章标签： VB6 微信支付 VB6支付宝 VB6扫码支付 QQ954486673 VX13822155058
于 2021-01-27 10:47:59 首次发布
本文链接：https://blog.csdn.net/zhangjin7422/article/details/113242954
版权
QQ:954486673 同时被 3 个专栏收录
127 篇文章 1 订阅
订阅专栏
18002295132
124 篇文章 1 订阅
订阅专栏
扫码支付
4 篇文章 0 订阅
订阅专栏
扫码消费机介绍：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
vb6支付宝、微信扫码收款软件源码.rar_vb6.0支付-VB文档类资源-CSDN下载VB6开发的微信、支付宝支付源代码，无需域名，只需输入微信公众号、微信商户号、微信API密钥；支付宝vb6.0支付更多下载资源、学习资料请访问CSDN下载频道.https://download.csdn.net/download/zhangjin7422/16518044
vx_13822155058
关注
1
点赞
踩
4

收藏

觉得还不错? 一键收藏
打赏
1
评论
vb6开发支付宝、微信支付

vb6调DLL函数发起微信、支付宝支付源代码，无需域名，只需输入微信公众号、微信商户号、微信API密钥；支付宝APPID 、支付宝验签密钥文件就可以完成以下微信、支付宝支付。1、生成微信支付二维码Native支付；2、扫微信钱包内的“付款码”直接完成支付;3、根据微信支付订单号查询支付状态；4、关闭已生成但还未支付的订单；5、生成支付宝支付二维码扫码支付；6、扫支付宝钱包内的“付款码”直接完成支付;7、根据支付宝支付订单号查询支付状态；8、撤销已生成的支付订单并完成退款。
复制链接

扫一扫