由于需要我在网上，下载了个QQ申请器，结果被360给kill了。大惊，把它放到在线查毒网站http://www.virscan.org/里一看。晕了，那么多的杀毒软件报毒。到底有没有毒我不知道，但是我是不会去用了，宁可信其有不可信其无。所以就萌发了自己写一个QQ申请器的想法。这不拿出来给大家分享，（http://menghuan.tk/post-4.html）
为了避免灌水的嫌疑。（还是有点）我把核心代码说一下。并提出我为解决的问题，在标签1处
首先往窗口上放
Picture1 Command1 Command2 Label1 Label2 Label3 Text1 Text2（MultiLine = True ScrollBars = 2）
最主要的一个 Inet 控件 （microsoft internet transfer control 6.0） vb精简版里没有，需要完整版。
'''''''''''''''''''''''''by 梦幻天空 http://menghuan.tk''''''''''''''''''''''''''''''''''''''''
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001'''''''''''''''''''''''''''''''以上为转UTF8所用''''''''''''''''''''''''''''''''''
Private Declare Function OleLoadPicturePath Lib "oleaut32.dll" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) As LongPrivate Type TGUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'''''''''''''''''''''''''''''以上为显示验证码图片所用，大家也可以用其他方法获取验证码图片'''''''''''''''''''''''''''''''''
Dim StrZ As String
Dim mima As String
Dim sqgs As IntegerPrivate Sub Command1_Click()Label1.Caption = "正在请求http://reg.qq.com/页面"
Dim strURL As String
strURL = "http://reg.qq.com/"
Inet1.Execute strURL, "HEAD"
dengdai '等待数据加载完成
Label1.Caption = "正在请求http://reg.qq.com/页面----------------完成！"Label1.Caption = "正在获取验证码图片"
Randomize
Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
thePCCOOKIE = Inet1.GetHeader
jishu = InStr(thePCCOOKIE, "PCCOOKIE=")
thePCCOOKIE = Mid(thePCCOOKIE, jishu + 9, 64)
'yanzm = InputBox("请输入验证码")
Text1.SetFocus''''''''''''''''''''''''''''''''''''''''''标签1'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Do Until Len(Text1.Text) = 4 '这里我是让程序等待Text1.Text的长度等于四，相信大家也发现了这样的弊端吧。有人问怎么不用Text1_Change事件啊！但这样就会转移过程，Inet控件封装了http协议以及ftp协议，使用起来非常方便，但也有弊端，转换了过程Inet控件里面的Cookies值也变了。申请就会失败。
DoEvents '望高手支招
Sleep 200'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop
Label1.Caption = "正在请求加密用的key"
Inet1.Execute "http://reg.qq.com/cgi-bin/checkconn?seed0.6238868014441234", "GET"
dengdai '等待数据加载完成
Label1.Caption = "正在请求加密用的key----------------完成！"
jishu = InStr(StrZ, "g_dataArray")
dataArray1 = Mid(StrZ, jishu + 33, 400)
dataArrayS = Split(dataArray1, Chr(34) & Chr(44) & Chr(34), -1)
dataArray1 = Mid(StrZ, jishu + 446, 64)
dataArray = Split(dataArray1, ",", -1)Dim RealPostData As String
Dim l_otherRandSeed As String
l_otherRandSeed = thePCCOOKIE
nameRand = Array(6818, 8315, 5123, 2252, 0, 0, 0, 0, 0, 0)
'elementsArrName= QQ网页注册方式、Email注册方式、昵称、申请类型（网页 or Email）、年、月、日、男、女、密码、确认密码、china、北京、东城区、验证码) ----------注册的个人信息
mima = "menghuan.tk"
elementsArrName = Array("qq", "email", "梦幻天空", "0", "1986", "11", "25", "1", "2", mima, mima, "1", "11", "1", Text1.Text)len1 = Len(l_otherRandSeed)
base = Val("&H" & Right(l_otherRandSeed, 2))
For i = 0 To 12
a = dataArray(i) Xor base
b = 13 - i - 1
For j = 0 To 3
a = a Xor nameRand(j)
Next
a = a Mod 15
RealPostData = RealPostData + dataArrayS(b) + "=" + elementsArrName(a) + "&" '得到post用的数据
Next
Label1.Caption = "正在post，请稍等！"Dim myhead As String
strURL = "http://reg.qq.com/cgi-bin/getnum"
myhead = "Content-Type: application/x-www-form-urlencoded "
Inet1.Execute strURL, "post", RealPostData, myhead
dengdai '等待数据加载完成
Label1.Caption = "完成！"
qq1 = InStr(StrZ, "xyz=")If qq1 <> 0 Then
qq2 = InStr(qq1, StrZ, ";")
qqhm = Mid(StrZ, qq1 + 5, qq2 - qq1 - 6)
Label1.Caption = "恭喜你申请到一个QQ号 " + qqhm
Text2.Text = qqhm + "----" + mima + vbCrLf + Text2.Text
sqgs = sqgs + 1
Label3.Caption = "申请记录： " & sqgs
Open App.Path & "\qq.txt" For Append As #1
Print #1, qqhm; " "; mima
Close #1
Else
qq1 = InStr(StrZ, "此IP申请的操作过于频繁")
If qq1 <> 0 Then
Label1.Caption = "此IP已被限制,请更换IP，或使用邮箱QQ。"
Else
qq1 = InStr(StrZ, "f_showInfoInLayer")
If qq1 <> 0 Then
Label1.Caption = "验证码错误"
Else
qq1 = InStr(StrZ, "现在申请的人过多")
If qq1 <> 0 Then
Label1.Caption = "现在申请的人过多，系统无法响应您的请求。"
End If
End If
End If
End If
Text1.Text = ""
'Call Command1_Click
End Sub
Private Sub Command2_Click()Dim strURL As String
Label1.Caption = "正在请求http://emailreg.qq.com/页面"
strURL = "http://emailreg.qq.com/cgi-bin/signup/step1?regtype=0"
Inet1.Execute strURL, "GET"dengdai
Label1.Caption = "正在请求http://emailreg.qq.com/页面 完成"
asdfg = Mid(StrZ, 531, 64)
Randomize
Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
'yanzm = InputBox("请输入验证码")Text1.SetFocus
waittime (10)Do Until Len(Text1.Text) = 4
DoEvents
Sleep 200
Loop
thesjzm = sjzm
'Randomize
Dim postqq As String
mima = "menghuan.tk" '密码
postqq = "email=" & thesjzm & Chr(38) & "nick=梦幻天空" & Chr(38) & "age=1989" & Chr(38) & "age_month=9" & Chr(38) & "age_day=20" & Chr(38) & "regsex=1" & Chr(38) & "password_1=" & mima & Chr(38) & "password_2=" & mima & Chr(38) & "Country=1" & Chr(38) & "State=1" & Chr(38) & "City=1" & Chr(38) & "validecode=" & Text1.Text & Chr(38) & "regqqmail=1" & Chr(38) & "asdfg=" & asdfg & Chr(38) ' regqqmail=1是qq.com 。 regqqmail=3是foxmail.comLabel1.Caption = "正在post"
Dim myhead As StringstrURL = "http://emailreg.qq.com/cgi-bin/signup/reg_result"myhead = "Content-Type: application/x-www-form-urlencoded "
Inet1.Execute strURL, "post", postqq, myheaddengdai
Label1.Caption = "post完成"
qq1 = InStr(StrZ, "申请成功")
If qq1 <> 0 Then
qq2 = InStr(qq1 + 90, StrZ, Chr(34))
qqhm = Mid(StrZ, qq1 + 86, qq2 - qq1 - 86)
thesjzm = thesjzm & "@qq.com"
Text2.Text = qqhm + "---" + thesjzm + "---" + mima + vbCrLf + Text2.Text
sqgs = sqgs + 1
Label3.Caption = "申请记录： " & sqgs
Open App.Path & "\qqemail.txt" For Append As #1
Print #1, qqhm; " "; mima; " "; thesjzm ' regqqmail=1是qq.com 。 regqqmail=3是foxmail.com
Close #1
Label1.Caption = "恭喜你申请到一个QQ号 " + qqhm + " " + thesjzm
Else qq1 = InStr(StrZ, "非法访问")
If qq1 <> 0 Then
Label1.Caption = "非法访问"
Else
qq1 = InStr(StrZ, "验证码错误")
If qq1 <> 0 Then
Label1.Caption = "验证码错误"
Else
qq1 = InStr(StrZ, "操作过于频繁")
If qq1 <> 0 Then
Label1.Caption = "操作过于频繁"
Else
qq1 = InStr(StrZ, "该帐号已被注册")
If qq1 <> 0 Then
Label1.Caption = "该帐号已被注册"
End If
End If
End If
End If
End If
Text1.Text = ""'Call Command2_Click
End SubPrivate Sub Form_Load()
Label1.Caption = "请选择申请通道"
Label2.Caption = "请输入验证码"
Label3.Caption = "申请记录："
Command1.Caption = "无保QQ"
Command2.Caption = "邮箱QQ"End SubPrivate Sub Form_Unload(Cancel As Integer)
End
End SubPrivate Sub Inet1_StateChanged(ByVal State As Integer)
If State = icResponseCompleted Then
Dim BinBuff() As ByteBinBuff = Inet1.GetChunk(0, icByteArray)
StrZ = Utf8ToUnicode(BinBuff)
End If
End Sub
Sub dengdai()
Do Until Inet1.StillExecuting = False '等待数据加载完成
DoEvents
Loop
End Sub
Private Function sjzm() As String '随机字母
Dim i%, trec%, a%()
trec = 12
ReDim a%(trec)
Randomize
For i = 1 To trec
a(i) = Int(Rnd * (122 - 97 + 1)) + 97 '小写字母
'a(i) = Int(Rnd * (90 - 65 + 1)) + 65 '大写字母
Next i
Me.Cls
For i = 1 To trec
sjzm = Chr(a(i)) & sjzm
Next i
End Function
Public Function LoadPicture(ByVal strFileName As String) As Picture '获取验证码图片模块
Dim IID As TGUID
With IID
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End WithOn Error GoTo LocalErrOleLoadPicturePath StrPtr(strFileName), 0&, 0&, 0&, IID, LoadPicture
Exit Function
LocalErr:
Set LoadPicture = VB.LoadPicture(strFileName)
Err.Clear
End Function
Private Sub waittime(delay As Single) '''''''''''''''''''''''''等待模板
Dim starttime As Single
starttime = Timer
Do Until (Timer - starttime) > delay
shijian = Timer - starttime
Label1.Caption = "延时十秒 " & shijian
DoEvents
Loop
Label1.Caption = "延时十秒 10"
End SubFunction Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength <= 0 Then Exit Function
lBufferSize = lLength * 2
Utf8ToUnicode = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
If lRet <> 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
Else
Utf8ToUnicode = ""
End If
End Function
Private Sub Picture1_Click()
Randomize
Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
Text1.SetFocus
End Sub
上面就是核心代码了，大家想怎么改，就怎么改吧！祝你成功！你可以去我的博客http://menghuan.tk看看我的软件
为了避免灌水的嫌疑。（还是有点）我把核心代码说一下。并提出我为解决的问题，在标签1处
首先往窗口上放
Picture1 Command1 Command2 Label1 Label2 Label3 Text1 Text2（MultiLine = True ScrollBars = 2）
最主要的一个 Inet 控件 （microsoft internet transfer control 6.0） vb精简版里没有，需要完整版。
'''''''''''''''''''''''''by 梦幻天空 http://menghuan.tk''''''''''''''''''''''''''''''''''''''''
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001'''''''''''''''''''''''''''''''以上为转UTF8所用''''''''''''''''''''''''''''''''''
Private Declare Function OleLoadPicturePath Lib "oleaut32.dll" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) As LongPrivate Type TGUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'''''''''''''''''''''''''''''以上为显示验证码图片所用，大家也可以用其他方法获取验证码图片'''''''''''''''''''''''''''''''''
Dim StrZ As String
Dim mima As String
Dim sqgs As IntegerPrivate Sub Command1_Click()Label1.Caption = "正在请求http://reg.qq.com/页面"
Dim strURL As String
strURL = "http://reg.qq.com/"
Inet1.Execute strURL, "HEAD"
dengdai '等待数据加载完成
Label1.Caption = "正在请求http://reg.qq.com/页面----------------完成！"Label1.Caption = "正在获取验证码图片"
Randomize
Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
thePCCOOKIE = Inet1.GetHeader
jishu = InStr(thePCCOOKIE, "PCCOOKIE=")
thePCCOOKIE = Mid(thePCCOOKIE, jishu + 9, 64)
'yanzm = InputBox("请输入验证码")
Text1.SetFocus''''''''''''''''''''''''''''''''''''''''''标签1'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Do Until Len(Text1.Text) = 4 '这里我是让程序等待Text1.Text的长度等于四，相信大家也发现了这样的弊端吧。有人问怎么不用Text1_Change事件啊！但这样就会转移过程，Inet控件封装了http协议以及ftp协议，使用起来非常方便，但也有弊端，转换了过程Inet控件里面的Cookies值也变了。申请就会失败。
DoEvents '望高手支招
Sleep 200'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop
Label1.Caption = "正在请求加密用的key"
Inet1.Execute "http://reg.qq.com/cgi-bin/checkconn?seed0.6238868014441234", "GET"
dengdai '等待数据加载完成
Label1.Caption = "正在请求加密用的key----------------完成！"
jishu = InStr(StrZ, "g_dataArray")
dataArray1 = Mid(StrZ, jishu + 33, 400)
dataArrayS = Split(dataArray1, Chr(34) & Chr(44) & Chr(34), -1)
dataArray1 = Mid(StrZ, jishu + 446, 64)
dataArray = Split(dataArray1, ",", -1)Dim RealPostData As String
Dim l_otherRandSeed As String
l_otherRandSeed = thePCCOOKIE
nameRand = Array(6818, 8315, 5123, 2252, 0, 0, 0, 0, 0, 0)
'elementsArrName= QQ网页注册方式、Email注册方式、昵称、申请类型（网页 or Email）、年、月、日、男、女、密码、确认密码、china、北京、东城区、验证码) ----------注册的个人信息
mima = "menghuan.tk"
elementsArrName = Array("qq", "email", "梦幻天空", "0", "1986", "11", "25", "1", "2", mima, mima, "1", "11", "1", Text1.Text)len1 = Len(l_otherRandSeed)
base = Val("&H" & Right(l_otherRandSeed, 2))
For i = 0 To 12
a = dataArray(i) Xor base
b = 13 - i - 1
For j = 0 To 3
a = a Xor nameRand(j)
Next
a = a Mod 15
RealPostData = RealPostData + dataArrayS(b) + "=" + elementsArrName(a) + "&" '得到post用的数据
Next
Label1.Caption = "正在post，请稍等！"Dim myhead As String
strURL = "http://reg.qq.com/cgi-bin/getnum"
myhead = "Content-Type: application/x-www-form-urlencoded "
Inet1.Execute strURL, "post", RealPostData, myhead
dengdai '等待数据加载完成
Label1.Caption = "完成！"
qq1 = InStr(StrZ, "xyz=")If qq1 <> 0 Then
qq2 = InStr(qq1, StrZ, ";")
qqhm = Mid(StrZ, qq1 + 5, qq2 - qq1 - 6)
Label1.Caption = "恭喜你申请到一个QQ号 " + qqhm
Text2.Text = qqhm + "----" + mima + vbCrLf + Text2.Text
sqgs = sqgs + 1
Label3.Caption = "申请记录： " & sqgs
Open App.Path & "\qq.txt" For Append As #1
Print #1, qqhm; " "; mima
Close #1
Else
qq1 = InStr(StrZ, "此IP申请的操作过于频繁")
If qq1 <> 0 Then
Label1.Caption = "此IP已被限制,请更换IP，或使用邮箱QQ。"
Else
qq1 = InStr(StrZ, "f_showInfoInLayer")
If qq1 <> 0 Then
Label1.Caption = "验证码错误"
Else
qq1 = InStr(StrZ, "现在申请的人过多")
If qq1 <> 0 Then
Label1.Caption = "现在申请的人过多，系统无法响应您的请求。"
End If
End If
End If
End If
Text1.Text = ""
'Call Command1_Click
End Sub
Private Sub Command2_Click()Dim strURL As String
Label1.Caption = "正在请求http://emailreg.qq.com/页面"
strURL = "http://emailreg.qq.com/cgi-bin/signup/step1?regtype=0"
Inet1.Execute strURL, "GET"dengdai
Label1.Caption = "正在请求http://emailreg.qq.com/页面 完成"
asdfg = Mid(StrZ, 531, 64)
Randomize
Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
'yanzm = InputBox("请输入验证码")Text1.SetFocus
waittime (10)Do Until Len(Text1.Text) = 4
DoEvents
Sleep 200
Loop
thesjzm = sjzm
'Randomize
Dim postqq As String
mima = "menghuan.tk" '密码
postqq = "email=" & thesjzm & Chr(38) & "nick=梦幻天空" & Chr(38) & "age=1989" & Chr(38) & "age_month=9" & Chr(38) & "age_day=20" & Chr(38) & "regsex=1" & Chr(38) & "password_1=" & mima & Chr(38) & "password_2=" & mima & Chr(38) & "Country=1" & Chr(38) & "State=1" & Chr(38) & "City=1" & Chr(38) & "validecode=" & Text1.Text & Chr(38) & "regqqmail=1" & Chr(38) & "asdfg=" & asdfg & Chr(38) ' regqqmail=1是qq.com 。 regqqmail=3是foxmail.comLabel1.Caption = "正在post"
Dim myhead As StringstrURL = "http://emailreg.qq.com/cgi-bin/signup/reg_result"myhead = "Content-Type: application/x-www-form-urlencoded "
Inet1.Execute strURL, "post", postqq, myheaddengdai
Label1.Caption = "post完成"
qq1 = InStr(StrZ, "申请成功")
If qq1 <> 0 Then
qq2 = InStr(qq1 + 90, StrZ, Chr(34))
qqhm = Mid(StrZ, qq1 + 86, qq2 - qq1 - 86)
thesjzm = thesjzm & "@qq.com"
Text2.Text = qqhm + "---" + thesjzm + "---" + mima + vbCrLf + Text2.Text
sqgs = sqgs + 1
Label3.Caption = "申请记录： " & sqgs
Open App.Path & "\qqemail.txt" For Append As #1
Print #1, qqhm; " "; mima; " "; thesjzm ' regqqmail=1是qq.com 。 regqqmail=3是foxmail.com
Close #1
Label1.Caption = "恭喜你申请到一个QQ号 " + qqhm + " " + thesjzm
Else qq1 = InStr(StrZ, "非法访问")
If qq1 <> 0 Then
Label1.Caption = "非法访问"
Else
qq1 = InStr(StrZ, "验证码错误")
If qq1 <> 0 Then
Label1.Caption = "验证码错误"
Else
qq1 = InStr(StrZ, "操作过于频繁")
If qq1 <> 0 Then
Label1.Caption = "操作过于频繁"
Else
qq1 = InStr(StrZ, "该帐号已被注册")
If qq1 <> 0 Then
Label1.Caption = "该帐号已被注册"
End If
End If
End If
End If
End If
Text1.Text = ""'Call Command2_Click
End SubPrivate Sub Form_Load()
Label1.Caption = "请选择申请通道"
Label2.Caption = "请输入验证码"
Label3.Caption = "申请记录："
Command1.Caption = "无保QQ"
Command2.Caption = "邮箱QQ"End SubPrivate Sub Form_Unload(Cancel As Integer)
End
End SubPrivate Sub Inet1_StateChanged(ByVal State As Integer)
If State = icResponseCompleted Then
Dim BinBuff() As ByteBinBuff = Inet1.GetChunk(0, icByteArray)
StrZ = Utf8ToUnicode(BinBuff)
End If
End Sub
Sub dengdai()
Do Until Inet1.StillExecuting = False '等待数据加载完成
DoEvents
Loop
End Sub
Private Function sjzm() As String '随机字母
Dim i%, trec%, a%()
trec = 12
ReDim a%(trec)
Randomize
For i = 1 To trec
a(i) = Int(Rnd * (122 - 97 + 1)) + 97 '小写字母
'a(i) = Int(Rnd * (90 - 65 + 1)) + 65 '大写字母
Next i
Me.Cls
For i = 1 To trec
sjzm = Chr(a(i)) & sjzm
Next i
End Function
Public Function LoadPicture(ByVal strFileName As String) As Picture '获取验证码图片模块
Dim IID As TGUID
With IID
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End WithOn Error GoTo LocalErrOleLoadPicturePath StrPtr(strFileName), 0&, 0&, 0&, IID, LoadPicture
Exit Function
LocalErr:
Set LoadPicture = VB.LoadPicture(strFileName)
Err.Clear
End Function
Private Sub waittime(delay As Single) '''''''''''''''''''''''''等待模板
Dim starttime As Single
starttime = Timer
Do Until (Timer - starttime) > delay
shijian = Timer - starttime
Label1.Caption = "延时十秒 " & shijian
DoEvents
Loop
Label1.Caption = "延时十秒 10"
End SubFunction Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength <= 0 Then Exit Function
lBufferSize = lLength * 2
Utf8ToUnicode = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
If lRet <> 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
Else
Utf8ToUnicode = ""
End If
End Function
Private Sub Picture1_Click()
Randomize
Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
Text1.SetFocus
End Sub
上面就是核心代码了，大家想怎么改，就怎么改吧！祝你成功！你可以去我的博客http://menghuan.tk看看我的软件
Do Until Len(Text1.Text) = 4 '这里我是让程序等待Text1.Text的长度等于四，相信大家也发现了这样的弊端吧。有人问怎么不用Text1_Change事件啊！但这样就会转移过程，Inet控件封装了http协议以及ftp协议，使用起来非常方便，但也有弊端，转换了过程Inet控件里面的Cookies值也变了。申请就会失败。
DoEvents '望高手支招
Sleep 200'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
大家说说啊!
Text1.SetFocus后面的代码都放在text1_change事件过程中执行
在text1_change事件过程中判断长度，如是4，则执行后面的代码
问题的原因我已经找到，
你上面说的有问题，应该是把Set Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))
后面的代码都放在text1_change事件过程中执行
在text1_change事件过程中判断长度，如是4，则执行后面的代码
顺便把Text1.SetFocus放到上一个过程中。因为thePCCOOKIE不是全局变量。失误啊。
我已开了新话题，请大家去看看
http://topic.csdn.net/u/20100801/10/55767216-45bc-44f0-9bb7-abfd0abd123b.html