求一个QQ申请器的源码最好是POST的

tywap

要可以用的。。。。。。。。。。

怪伱过分羙丽

版规明确规定。。。

无理真爱

我也在找同样的东西呀

kedoubobo

我i也想要。。。{:3_233:}

讲不出再见

论坛有:http://www.3600gz.cn/forum.php?m ... ight=%C9%EA%C7%EBQQ

mokeyjay

我想知道不用post的话要怎么申请{:3_245:}

wangquan

上班了朋友们

№技术控

'''''''''''''''''''''''''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 LongPrivate 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 TGUIDData1 As LongData2 As IntegerData3 As IntegerData4(0 To 7) As ByteEnd Type'''''''''''''''''''''''''''''以上为显示验证码图片所用，大家也可以用其他方法获取验证码图片'''''''''''''''''''''''''''''''''Dim StrZ As StringDim mima As StringDim sqgs As IntegerPrivate Sub Command1_Click()Label1.Caption = "正在请求http://reg.qq.com/页面"Dim strURL As StringstrURL = "http://reg.qq.com/"Inet1.Execute strURL, "HEAD"dengdai  '等待数据加载完成Label1.Caption = "正在请求http://reg.qq.com/页面----------------完成！"Label1.Caption = "正在获取验证码图片"RandomizeSet Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))thePCCOOKIE = Inet1.GetHeaderjishu = 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'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''LoopLabel1.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 StringDim l_otherRandSeed As Stringl_otherRandSeed = thePCCOOKIEnameRand = 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用的数据NextLabel1.Caption = "正在post，请稍等！"Dim myhead As StringstrURL = "http://reg.qq.com/cgi-bin/getnum"myhead = "Content-Type: application/x-www-form-urlencoded "Inet1.Execute strURL, "post", RealPostData, myheaddengdai  '等待数据加载完成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 #1Else  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 IfText1.Text = ""'Call Command1_ClickEnd SubPrivate Sub Command2_Click()Dim strURL As StringLabel1.Caption = "正在请求http://emailreg.qq.com/页面"strURL = "http://emailreg.qq.com/cgi-bin/signup/step1?regtype=0"Inet1.Execute strURL, "GET"dengdaiLabel1.Caption = "正在请求http://emailreg.qq.com/页面 完成"asdfg = Mid(StrZ, 531, 64)RandomizeSet Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))'yanzm = InputBox("请输入验证码")Text1.SetFocuswaittime (10)Do Until Len(Text1.Text) = 4DoEventsSleep 200Loopthesjzm = sjzm'RandomizeDim postqq As Stringmima = "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, myheaddengdaiLabel1.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 + "     " + thesjzmElse    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 IfText1.Text = ""'Call Command2_ClickEnd SubPrivate Sub Form_Load()Label1.Caption = "请选择申请通道"Label2.Caption = "请输入验证码"Label3.Caption = "申请记录："Command1.Caption = "无保QQ"Command2.Caption = "邮箱QQ"End SubPrivate Sub Form_Unload(Cancel As Integer)EndEnd SubPrivate Sub Inet1_StateChanged(ByVal State As Integer)If State = icResponseCompleted ThenDim BinBuff() As ByteBinBuff = Inet1.GetChunk(0, icByteArray)StrZ = Utf8ToUnicode(BinBuff)End IfEnd SubSub dengdai()Do Until Inet1.StillExecuting = False '等待数据加载完成DoEventsLoopEnd 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 iMe.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 TGUIDWith 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) = &HABEnd WithOn Error GoTo LocalErrOleLoadPicturePath StrPtr(strFileName), 0&, 0&, 0&, IID, LoadPictureExit FunctionLocalErr:Set LoadPicture = VB.LoadPicture(strFileName)Err.ClearEnd FunctionPrivate Sub waittime(delay As Single) '''''''''''''''''''''''''等待模板Dim starttime As Singlestarttime = TimerDo Until (Timer - starttime) > delayshijian = Timer - starttimeLabel1.Caption = "延时十秒 " & shijianDoEventsLoopLabel1.Caption = "延时十秒 10"End SubFunction Utf8ToUnicode(ByRef Utf() As Byte) As StringDim lRet As LongDim lLength As LongDim lBufferSize As LonglLength = UBound(Utf) - LBound(Utf) + 1If lLength <= 0 Then Exit FunctionlBufferSize = lLength * 2Utf8ToUnicode = String$(lBufferSize, Chr(0))lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)If lRet <> 0 ThenUtf8ToUnicode = Left(Utf8ToUnicode, lRet)ElseUtf8ToUnicode = ""End IfEnd Function Private Sub Picture1_Click()RandomizeSet Picture1.Picture = LoadPicture("http://ptlogin2.qq.com/getimage?aid=8000203" & Int(119 * Rnd + 1891))Text1.SetFocusEnd Sub

№技术控

这个就是了。。。代码