Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function 合并数组(SZ1() As Byte, SZ2() As Byte)
    Dim a As Long
    Dim b As Long
    a = UBound(SZ1)
    b = UBound(SZ2)
    ReDim Preserve SZ1(0 To a + b + 1)
    CopyMemory SZ1(a + 1), SZ2(0), b + 1
End Function

Public Function BytesToBstr(strBody, CodeBase)
    On Error GoTo chucuo:
    Dim ObjStream
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
        .Type = 1
        .Mode = 3
        .Open
        .Write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
        .Close
    End With
    Set ObjStream = Nothing
    Exit Function
chucuo:
    BytesToBstr = "error"
End Function

Public Function 若快验证码识别(ByVal 帐号 As String, ByVal 密码 As String, ByVal 打码类型 As String, ByVal 超时时间 As String, ByVal 软件Id As String, ByVal 软件Key As String, ByVal 图片路径 As String) As String
    On Error GoTo 错误处理:
    
    Dim html As String
    Dim cookie As String
    Dim SZ1() As Byte
    Dim SZ2() As Byte
    Dim SZ3() As Byte
    Dim WB1 As String
    Dim WB2 As String
    
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "username" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 帐号 & vbCrLf
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "password" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 密码 & vbCrLf
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "typeid" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 打码类型 & vbCrLf
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "timeout" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 超时时间 & vbCrLf
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "softid" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 软件Id & vbCrLf
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "softkey" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 软件Key & vbCrLf
    WB1 = WB1 & "---------------RK" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "image" & Chr(34) & "; filename=" & Chr(34) & "验证码.jpg" & Chr(34) & vbCrLf
    WB1 = WB1 & "Content-Type: application/octet-stream" & vbCrLf
    
    SZ1 = StrConv(WB1 & vbCrLf, vbFromUnicode)
    '字符串转成数组
    
    Open 图片路径 For Binary As #1
    ReDim SZ2(0 To LOF(1) - 1)
    Get #1, , SZ2
    Close #1
    '图片转成数组
    
    WB2 = WB2 & "---------------RK--"
    
    SZ3 = StrConv(vbCrLf & WB2, vbFromUnicode)
    '字符串转成数组
    
    Call 合并数组(SZ1, SZ2)
    Call 合并数组(SZ1, SZ3)
    
    Dim WinHttp As WinHttp.WinHttpRequest
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttp.Open "POST", "http://api.ruokuai.com/create.xml", True
    WinHttp.SetTimeouts 30000, 30000, 30000, 30000
    WinHttp.SetRequestHeader "Accept", "*/*"
    WinHttp.SetRequestHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/xaml+xml,*/*"
    WinHttp.SetRequestHeader "Accept-Language", "zh-cn"
    WinHttp.SetRequestHeader "Content-Type", "multipart/form-data; boundary=-------------RK"
    WinHttp.SetRequestHeader "Cache-Control", "no-cache"
    WinHttp.SetRequestHeader "User-Agent", "RK"
    WinHttp.SetRequestHeader "Host", "api.ruokuai.com"
    WinHttp.SetRequestHeader "Content-Length", UBound(SZ1) + 1
    WinHttp.Send SZ1
    WinHttp.WaitForResponse
    
    html = BytesToBstr(WinHttp.ResponseBody, "utf-8")
    cookie = WinHttp.GetAllResponseHeaders
    
    If InStr(html, "<Error>错误提示信息.</Error>") Then
        若快验证码识别 = "Error"
    Else
        若快验证码识别 = Split(Split(html, "<Result>")(1), "</Result>")(0)
    End If
    
    Set WinHttp = Nothing
    
    Exit Function
错误处理:
    若快验证码识别 = "Error"
End Function

'----------------------------------------------//若快打码类模块//----------------------------------------------

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function 合并数组(SZ1() As Byte, SZ2() As Byte)
    Dim a As Long
    Dim b As Long
    a = UBound(SZ1)
    b = UBound(SZ2)
    ReDim Preserve SZ1(0 To a + b + 1)
    CopyMemory SZ1(a + 1), SZ2(0), b + 1
End Function

Public Function BytesToBstr(strBody, CodeBase)
    On Error GoTo chucuo:
    Dim ObjStream
    Set ObjStream = CreateObject("Adodb.Stream")
    With ObjStream
        .Type = 1
        .Mode = 3
        .Open
        .Write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
        .Close
    End With
    Set ObjStream = Nothing
    Exit Function
chucuo:
    BytesToBstr = "error"
End Function

Public Function 联众验证码识别(ByVal 帐号 As String, ByVal 密码 As String, ByVal 验证码最小长度 As String, ByVal 验证码最大长度 As String, ByVal 打码类型 As String, ByVal 软件Key As String, ByVal 图片路径 As String) As String
    On Error GoTo 错误处理
    
    Dim html As String
    Dim cookie As String
    Dim SZ1() As Byte
    Dim SZ2() As Byte
    Dim SZ3() As Byte
    Dim WB1 As String
    Dim WB2 As String
    
    WB1 = WB1 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "user_name" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 帐号 & vbCrLf
    WB1 = WB1 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "user_pw" & Chr(34) & vbCrLf
    WB1 = WB1 & vbCrLf
    WB1 = WB1 & 密码 & vbCrLf
    WB1 = WB1 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB1 = WB1 & "Content-Disposition: form-data; name=" & Chr(34) & "upload" & Chr(34) & "; filename=" & Chr(34) & "验证码.jpg" & Chr(34) & vbCrLf
    WB1 = WB1 & "Content-Type: image/jpeg" & vbCrLf
    
    SZ1 = StrConv(WB1 & vbCrLf, vbFromUnicode)
    '字符串转成数组
    
    Open 图片路径 For Binary As #1
    ReDim SZ2(0 To LOF(1) - 1)
    Get #1, , SZ2
    Close #1
    '图片转成数组
    
    WB2 = WB2 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB2 = WB2 & "Content-Disposition: form-data; name=" & Chr(34) & "yzm_minlen" & Chr(34) & vbCrLf
    WB2 = WB2 & vbCrLf
    WB2 = WB2 & 验证码最小长度 & vbCrLf
    WB2 = WB2 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB2 = WB2 & "Content-Disposition: form-data; name=" & Chr(34) & "yzm_maxlen" & Chr(34) & vbCrLf
    WB2 = WB2 & vbCrLf
    WB2 = WB2 & 验证码最大长度 & vbCrLf
    WB2 = WB2 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB2 = WB2 & "Content-Disposition: form-data; name=" & Chr(34) & "yzmtype_mark" & Chr(34) & vbCrLf
    WB2 = WB2 & vbCrLf
    WB2 = WB2 & 打码类型 & vbCrLf
    WB2 = WB2 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25" & vbCrLf
    WB2 = WB2 & "Content-Disposition: form-data; name=" & Chr(34) & "zztool_token" & Chr(34) & vbCrLf
    WB2 = WB2 & vbCrLf
    WB2 = WB2 & 软件Key & vbCrLf
    WB2 = WB2 & "------WebKitFormBoundaryOuMP1wKv9AXzPP25--" & vbCrLf
    
    SZ3 = StrConv(vbCrLf & WB2, vbFromUnicode)
    '字符串转成数组
    
    Call 合并数组(SZ1, SZ2)
    Call 合并数组(SZ1, SZ3)
    
    Dim WinHttp As WinHttp.WinHttpRequest
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttp.Open "POST", "http://bbb4.hyslt.com/api.php?mod=php&act=upload", True
    WinHttp.SetTimeouts 30000, 30000, 30000, 30000
    WinHttp.SetRequestHeader "Host", "bbb4.hyslt.com"
    WinHttp.SetRequestHeader "Connection", "keep-alive"
    WinHttp.SetRequestHeader "Content-Length", UBound(SZ1) + 1
    WinHttp.SetRequestHeader "Cache-Control", "max-age=0"
    WinHttp.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
    WinHttp.SetRequestHeader "Origin", "null"
    WinHttp.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/43.0.2357.134 Safari/537.36"
    WinHttp.SetRequestHeader "Content-Type", "multipart/form-data; boundary=----WebKitFormBoundaryOuMP1wKv9AXzPP25"
    WinHttp.SetRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    WinHttp.Send SZ1
    WinHttp.WaitForResponse
    
    html = BytesToBstr(WinHttp.ResponseBody, "utf-8")
    cookie = WinHttp.GetAllResponseHeaders
    
    If InStr(html, "result" & Chr(34) & ":true") Then
        联众验证码识别 = Split(Split(html, "val" & Chr(34) & ":" & Chr(34))(1), Chr(34))(0)
    Else
        联众验证码识别 = "Error"
    End If
    
    Set WinHttp = Nothing
    
    Exit Function
错误处理:
    联众验证码识别 = "Error"
End Function

'----------------------------------------------//联众打码类模块//----------------------------------------------