2022年VB局域网网络管理系统 .pdf

《2022年VB局域网网络管理系统 .pdf》由会员分享，可在线阅读，更多相关《2022年VB局域网网络管理系统 .pdf（7页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、相关代码如下：Dim strIp As String strIp = InputBox( 请输入要连接的主机IP, 输入信息 , 127.0.0.1) 弹出输入框， 让用户输入要连接的主机IP If strIp = Then Exit Sub 如果输入信息为空，则退出该模块Dim I As Long I = 0 Do If I = 10000 Then If MsgBox( 主机网络连接不通,是否重试 , 4 + 256 + 64, ) = vbYes Then 如果在弹出的信息提示框中选择 “ 是”I = 0 那么继续循环Else Exit Do 否则退出循环End If End If If

2、 Me.WinConnect.State 1 Then 如果找到主机IP Me.WinConnect.Close 关闭以前可能建立的连接Me.WinConnect.Connect strIp, 8888 连接主机 IP，1234 是端口（可随便输）Exit Do 否则退出循环End If I = I + 1 DoEvents 将短暂的事务处理时间交给系统，以防止程序在循环时长时间没有响应Loop Private Sub btn 关闭 _Click() Me.WinConnect.Close 断开连接Me.Text1.Text = Me.Text1.Text & vbCrLf & 连接关闭 操作

3、记录显示Me.btn 连接 .Enabled = True 将“ 连接” 按钮设置为可用状态Me.btn 关闭 .Enabled = False 将“ 关闭 ” 按钮设置为不可用状态End Sub Private Sub Text1_Change() Me.Text1.SelStart = Len(Me.Text1.Text) Me.Text1.SelLength = 1 End Sub Private Sub WinConnect_Close() Me.Text1.Text = Me.Text1.Text & vbCrLf & 连接关闭 操作记录显示Me.btn 连接 .Enabled =

4、True 将“ 连接 ” 按钮设置为可用状态Me.btn 关闭 .Enabled = False 将“ 关闭 ” 按钮设置为不可用状态End Sub Private Sub WinConnect_Connect() Me.Text1.Text = Me.Text1.Text & vbCrLf & 连接完成 操作记录显示名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，共 7 页 - - - - - - - - - Me.btn 连接 .Enabled = False 将“ 连接

5、 ” 按钮设置为不可用状态Me.btn 关闭 .Enabled = True 将“ 关闭 ” 按钮设置为可用状态End Sub Private Sub WinConnect_DataArrival(ByVal bytesTotal As Long) 接收到对方的信息的事件Private Sub WinConnect_DataArrival(ByVal bytesTotal As Long) 接收到对方的信息的事件Dim a As String Me.WinConnect.GetData a 把接收到的信息赋值给字符串a If Mid(a, 1, 5) = 11-11 Then End If S

6、elect Case Mid(a, 1, 5) Case 11-11 Me.Text1.Text = Me.Text1.Text & vbCrLf & Time & : & Mid(a, 6) Case 22-21 Call GetScreen If Me.Picture2.Image 0 Then SavePicture Me.Picture2.Image, C:SendScreen.bmp If Dir(C:SendScreen.rar) Then Kill C:SendScreen.rar End If Call AddRar Open C:SendScreen.rar For Bina

7、ry As #1 ReDim aa(1 To LOF(1) As Byte Get #1, 1, aa End If Me.WinConnect.SendData 22-22 & LOF(1) Close DoEvents Me.WinConnect.SendData aa DoEvents Case 33-31 If Dir(c:NewFolder) = Then MkDir (c:NewFolder) End If Case 33-32 Open C:NewFile For Binary As #1 Put #1, 1, hello Close #1 Case 33-33 Shell sh

8、utdown -s -t 1 Case 33-34 打开 IE On Error Resume Next Shell C:Program FilesInternet ExplorerIEXPLORE.EXE , 3 On Error GoTo 0 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 7 页 - - - - - - - - - Case 80-81 Me.Text1.Text = Me.Text1.Text & vbCrLf & Time & : & Mid(a

9、, 6) Case 66-61 注销计算机ExitWindowsEx EWX_FORCE Or EWX_LOGOFF, 0 Case 66-62 注销计算机ExitWindowsEx EWX_FORCE Or EWX_REBOOT, 0 Case 66-63 打开光驱mciSendString Set CDAudio Door Open Wait, 0&, 0&, 0& Case 66-64 打开光驱mciSendString Set CDAudio Door Closed Wait, 0&, 0&, 0& Case 66-64 打开光驱mciSendString Set CDAudio Do

10、or Closed Wait, 0&, 0&, 0& Case 66-65 隐藏任务栏ShowHide True Case 66-66 显示任务栏ShowHide False Case 66-67 隐藏按钮hideButton False Case 66-68 隐藏按钮hideButton True Case 66-69 Me.WinConnect.SendData 66-70 & ListWindows End Select End Sub Private Sub GetScreen() Dim wScreen As Long Dim hScreen As Long Dim w As Lon

11、g Dim h As Long Picture2.Cls wScreen = Screen.Width Screen.TwipsPerPixelX hScreen = Screen.Height Screen.TwipsPerPixelY 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 3 页，共 7 页 - - - - - - - - - Picture2.ScaleMode = vbPixels w = Picture2.ScaleWidth h = Picture2.Scale

12、Height hdcScreen = GetDC(0) r = StretchBlt(Me.Picture2.hdc, 0, 0, wScreen, hScreen, hdcScreen, 0, 0, wScreen, hScreen, vbSrcCopy) End Sub Private Sub WinConnect_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpCont

13、ext As Long, CancelDisplay As Boolean) Me.Text1.Text = Me.Text1.Text & vbCrLf & 连接异常 操作记录显示End Sub Public Declare Function GetDC Lib user32 (ByVal hwnd As Long) As Long Public Declare Function StretchBlt Lib gdi32 (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHei

14、ght 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 Public Dpath As String 存储格式化后的相对路径Function AddRar() 利用 winrar 进行压缩Dim Rarexe As String WINRAR执行文件的位置Dim Source As String 解压缩前的原始文件Dim Target As S

15、tring 解压缩后的目标文件Dim FileString As String Shell指令中的字符串Dim Result As Long Rarexe = Dpath & winrarwinrar Source = c:SendScreen.bmp Target = C:SendScreen.rar FileString = Rarexe & a & Target & & Source Result = Shell(FileString, vbHide) End Function Private Sub btn 添加 _Click() 向所有的机器发送教师信息Dim i As Long D

16、im str As String str = InputBox( 输入发送的消息, 发送 , ) For i = 1 To Me.ListUser.ListItems.Count If Me.WinConn(Mid(Me.ListUser.ListItems(i).Key, 4).State = 7 Then Me.WinConn(Mid(Me.ListUser.ListItems(i).Key, 4).SendData 11-11 & str End If Next End Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - -

17、- 名师精心整理 - - - - - - - 第 4 页，共 7 页 - - - - - - - - - 点击【远程关闭所有连接的计算机】系统将检索所有的连接的机器并发送关机命令，具体代码如下：Private Sub UserControl13_Click() 相连接的所有机器发送关机命令Dim i As Long Dim str As String For i = 1 To Me.ListUser.ListItems.Count If Me.WinConn(Mid(Me.ListUser.ListItems(i).Key, 4).State = 7 Then Me.WinConn(Mid(M

18、e.ListUser.ListItems(i).Key, 4).SendData 33-33 End If Next End Sub Private Sub ControlMenu1_Click() 发送让学生机器发送截图frmUserList.WinConn(Mid(frmUserList.ListUser.SelectedItem.Key, 4).SendData 22-21 End Sub Private Sub ControlMenu2_Click() 发送在学生机器上建立文件夹NewFolder frmUserList.WinConn(Mid(frmUserList.ListUser

19、.SelectedItem.Key, 4).SendData 33-31 End Sub Private Sub ControlMenu3_Click() 发送在学生机器上建立文件NewFile frmUserList.WinConn(Mid(frmUserList.ListUser.SelectedItem.Key, 4).SendData 33-32 End Sub Private Sub ControlMenu4_Click() 发送远程关闭计算机frmUserList.WinConn(Mid(frmUserList.ListUser.SelectedItem.Key, 4).SendD

20、ata 33-33 End Sub Private Sub ControlMenu5_Click() 发送打开学生机器上面的IE frmUserList.WinConn(Mid(frmUserList.ListUser.SelectedItem.Key, 4).SendData 33-34 End Sub 相关代码如下：Private Sub WinConn_DataArrival(Index As Integer, ByVal bytesTotal As Long) If strZt = 22-22 Then 将接收到的数据信息写入文件中直到文件长度等于发送过来的总长度Dim aa() As

21、 Byte Dim str As String Me.WinConn(Index).GetData aa 把接收到的信息赋值给字符串a Open D:ReceiveScreen.rar For Binary As #1 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 5 页，共 7 页 - - - - - - - - - If LOF(1) + UBound(aa) + 1 = intFileLen Then Put #1, LOF(1) + 1, aa Dim intCurrent

22、Lof As Long intCurrentLof = LOF(1) Debug.Print LOF(1) End If Close #1 If intCurrentLof = intFileLen Then If Dir(D:SendScreen.bmp) Then Kill D:SendScreen.bmp End If Call OutRar frmScreen.Show strZt = Exit Sub End If Else 判断相应接收标志的功能Dim a As String Me.WinConn(Index).GetData a 把接收到的信息赋值给字符串a End If Sel

23、ect Case Mid(CStr(a), 1, 5) Case 22-22 If Dir(D:ReceiveScreen.rar) Then Kill D:ReceiveScreen.rar End If intFileLen = Mid(a, 6) strZt = 22-22 Exit Sub End Select End Sub Private Sub WinListen_ConnectionRequest(ByVal requestID As Long) 当接收到连接请求时,检索没有连接的winsock 让他与此连接Dim i As Long For i = 0 To MaxClien

24、t - 1 If Me.WinConn(i).State = 0 Then Exit For End If Next If Me.WinConn(i).State = 0 Then Me.WinConn(i).Accept requestID Me.ListUser.ListItems.Add , Con & i, Me.WinConn(i).RemoteHostIP, 1 Exit Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 6 页，共 7 页 - - - - - - - - - End If End Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 7 页，共 7 页 - - - - - - - - -