1,502
社区成员
发帖
与我相关
我的任务
分享
Dim personalcode ' 临时机器码,用于防止重复登录
Private Sub Command1_Click()
Dim comfile
Dim comid
Dim key
strA = URLEncoding("KEY=" & Text1.Text & "&PERSONALCODE=" & personalcode)
Debug.Print strA
Set http = CreateObject("MSXML2.XMLHTTP")
With http
.Open "POST ", "http://www.mapleit.net/yanzheng/index.php", False
.setRequestHeader "Content-Type ", "application/x-www-form-urlencoded "
.setRequestHeader "Content-Length ", Len(strA)
.send strA
key = bytes2BSTR(.responseBody)
End With
Debug.Print key
If InStr(key, "error") <> 0 Then
msg = MsgBox("注册码错误", vbExclamation, "登录失败")
Else
msg = MsgBox("登录成功", vbInformation, "登录成功")
Me.Hide
Form2.Show
End If
End Sub
Function URLEncoding(vstrIn)
strReturn = ""
For i = 1 To Len(vstrIn)
ThisChr = Mid(vstrIn, i, 1)
If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00) \ &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
URLEncoding = strReturn
End Function
Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn, i, 1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn, i + 1, 1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
Private Sub Command2_Click()
Form2.Show
End Sub
Private Sub Form_Load()
'写入随机数
Randomize Timer
personalcode = Int((100000 * Rnd) + 1)
Debug.Print "当前机器码为:" & personalcode
End Sub