VB打造QQ批量登陆器

weixin_33805557

于 2009-04-01 17:57:58 发布

阅读量191

点赞数

文章标签：数据库

原文链接：http://blog.51cto.com/bobo27/144803

版权

转载： [url]http://www.oldjun.com[/url]

QQ太多，每天要输入真的很麻烦，网上有一些批量的登录器，可是谁也不知道有没有在登录的同时也往作者的邮箱里发一封包含qq号与密码的邮件~

于是想自己写，因为asp比较熟，所以选择VB，网上找了2个模块，于是可以直接写程序了，以前没写过application，第一次写，遇到不少困难，不过最后还是搞定了～

下面放主代码，主要是ACCESS数据库的操作：

Private Sub form_Load()
Dim i As Integer
Dim mdbpath As String
Dim strqqpath As String

getvalue strqqpath

If strqqpath = "" Then
qqpath.Text = "未检测到QQ目录，请自行设置！"
Else
qqpath.Text = strqqpath
End If
       
appdisk = Trim(App.Path)
If Right(appdisk, 1) <> "\" Then appdisk = appdisk & "\"
mdbpath = appdisk
If Dir(mdbpath & "qqlogin.mdb") = "" Then

Dim pstr As String
pstr = "Provider=Microsoft.Jet.OLEDB.4.0;" '不能把这里的4.0改为3.51
pstr = pstr & "Data Source=" & mdbpath & "qqlogin.mdb"
cat.Create pstr '创建数据库
Dim tbl As New Table
cat.ActiveConnection = pstr
tbl.Name = "qq" '表的名称
tbl.Columns.Append "id", adInteger, 4 '表的第一个字段
tbl.Columns.Append "qq", adVarWChar, 100 '表的第二个字段
tbl.Columns.Append "passwd", adVarWChar, 100 '表的第三个字段
cat.Tables.Append tbl '建立数据表
conn.Open pstr
conn.Execute "ALTER TABLE qq ADD Primary KEY(ID)"
conn.Execute "ALTER TABLE qq ALTER id int identity(1,1)"
rs.CursorLocation = adUseClient
rs.Open "qq", conn, adOpenKeyset, adLockPessimistic
For i = 1 To 10
rs.AddNew '往表中添加新记录
rs.Fields(1).Value = ""
rs.Fields(2).Value = ""
rs.Update
Next
rs.Close
Set rs = Nothing
'MsgBox "成功创建新数据库qqlogin.mdb！", vbCritical, "恭喜"

End If

Dim strCN As String
'声明存放连接串的字符串变量
Set conn = New Connection
'实例化Connection对象
'生成连接串（ConnectionString）
strCN = "Provider=Microsoft.Jet.OLEDB.4.0;
Persist Security Info=False;Data Source=" 
& mdbpath & "qqlogin.mdb"
conn.Open strCN '调用Connection对象的方法Open连接数据源
If Err.Number <> 0 Then
MsgBox Err.Number
Unload Me
End If
Dim sql As String
Set rs = New ADODB.Recordset
sql = "select * from qq"
rs.Open sql, conn, 1, 1

i = 0
Do While Not rs.EOF And i < 10 '判断EOF标记属性（Endoffile）
If Not IsNull(rs("qq")) Then qq(i).Text = rs("qq")
If Not IsNull(rs("passwd")) Then password(i).Text = rs("passwd")
i = i + 1
rs.MoveNext '将游标指针移到下一条记录
Loop

rs.Close
Set rs = Nothing
End Sub