qq申请器，有源码，用post提交

'
''''''''''''''''''''''''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

Long

Private
 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

Integer

Private

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.com

Label1.Caption
=

"
正在post
"

Dim
 myhead
As

String

strURL
=

"
http://emailreg.qq.com/cgi-bin/signup/reg_result
"

myhead
=

"
Content-Type: application/x-www-form-urlencoded
"

Inet1.Execute strURL,
"
post
"
, postqq, myhead

dengdai
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 Sub

Private

Sub
 Form_Load()
Label1.Caption
=

"
请选择申请通道
"

Label2.Caption
=

"
请输入验证码
"

Label3.Caption
=

"
申请记录：
"

Command1.Caption
=

"
无保QQ
"

Command2.Caption
=

"
邮箱QQ
"

End Sub

Private

Sub
 Form_Unload(Cancel
As

Integer
)

End

End Sub

Private

Sub
 Inet1_StateChanged(ByVal State
As

Integer
)

If
 State
=
 icResponseCompleted
Then

Dim
 BinBuff()
As

Byte

BinBuff
=
 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

With

On

Error

GoTo
 LocalErr

OleLoadPicturePath 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 Sub

Function
 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://topic.csdn.net/u/20100724/23/1d229a85-7709-4b44-9886-27d24504fe79.html?53850#r_achor

qq申请器，有源码，用post提交相关推荐

C++、VC++、MFC网页自动注册、登陆、发帖、留言，QQ注册、QQ申请器源码、注册邮箱源码、自动发帖源码...
C++.VC++.MFC网页自动注册.登陆.发帖.留言,QQ注册.QQ申请器源码.注册邮箱源码.自动发帖源码参考资料: 自动登录yahoo邮箱http://blog.csdn.net/suisu ...
C、C++、VC、MFC网页自动注册、登陆、发帖、留言 QQ注册、QQ申请器源码、源代码
查看文章 [转]C.C++.VC.MFC网页自动注册.登陆.发帖.留言 QQ注册.QQ申请器源码.源代码 2012-01-11 10:58 转载自 qq316293804 最终编辑 qq31629 ...
C++、VC++、MFC网页自动注册、登陆、发帖、留言，QQ注册、QQ申请器源码、注册邮箱源码、自动发帖源码
参考资料: 自动登录yahoo邮箱http://blog.csdn.net/suisuibianbian/archive/2005/12/12/550260.aspx VC采集网页所有表单域http: ...
基于clswindow for vb开发的qq登录器源码
clswindow是vb下控制外部程序的一个框架,封装了很多简单使用的操作函数. clswindow的详细介绍:https://blog.csdn.net/sysdzw/article/details ...
从零开始用C语言实现图片解码播放器(有源码)
1.项目描述 1.1.项目硬件平台介绍 (1)硬件平台:九鼎公司的X210开发板,S5PV210(Cortex-A8内核): (2)软件平台:linux2.6.35.7内核,直接基于linux API ...
新篇QQ申请器，完整版源码，用post提交
http://hi.baidu.com/zgq666/blog/item/2ab43c4eb173f1dbd0c86a58.html 首先往窗口上放 'Picture1 Command1 Comman ...
QQ靓号申请器v1.1.0.0【已更新】
*1.再次调整优化工具的整个界面,增加控件皮肤. *2.软件以后台模拟方式提交申请QQ号码,自动清除Cookie,简单快捷. *3.换验证码点击验证码图片即可,出现验证码便可输入,输入满位验证码后将自 ...
QQ靓号申请器v1.2.0.0【源码】
*1.再次调整优化工具的整个界面, 更换了控件皮肤. *2.软件逻辑优化, 增加内存释放功能. *3.修复验证码位数错误,改进程序框架, 异常处理更加完善. *4.增加了号码管理功能, 考虑准备添加自 ...
OP320A 文本显器生产方案另有源码原理图兼容OP320A MD204L
OP320A 文本显器生产方案另有源码原理图兼容OP320A MD204L 提供完整文本显示器方案包含上位机画面组态软件芯片 HEX文本以及PCB 文件还有电路图只需按照提供的PCB文 ...

qq申请器，有源码，用post提交

qq申请器，有源码，用post提交相关推荐

最新文章

热门文章