form1.frm

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

SetCursorPos pointx, pointy

End Sub

'Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
' Dim Msg As Long
 'Dim f1
   ' Msg = x / Screen.TwipsPerPixelX

    'Select Case Msg
   ' Case WM_LBUTTONDOWN '按下事件
          
    ' Case WM_LBUTTONDBLCLK '双击事件
      '  On Error Resume Next
      '  main1.Show

         
     
   ' Case wm_lbuttonup '左击后事件
         
    
   ' Case WM_RBUTTONUP: '右击后事件
     '   PopupMenu f1, 0 Or 2
    'End Select
'End Sub

Private Sub SysInfo1_DisplayChanged()

If (lian = True) Then

Timer4.Enabled = True

send = True

Timer3.Enabled = False

''''''''''''''''''''
'se = 16
''''''''''''''''''''''''''''
Select Case se

Case 160
Call m16xz

Case 256
Call m256z

Case 16
Call m16z

End Select

Else


End If

End Sub

Private Sub Timer3_Timer()
'''''''''''''''''''''''''关键
'se = 256
''''''''''''''''''''''''''''
Select Case se

Case 16
Call m16y

Case 256
Call M256y

Case 160
Call m16xy

End Select
End Sub



Private Sub Timer4_Timer()

With Winsock2
     .Close
     .Listen
End With

lian = False
Timer4.Enabled = False
End Sub




Private Sub socktwo()          '打开 winsock2 端口出错处理程序

On Error GoTo er

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

Exit Sub

er:
Call socktwo

End Sub

Private Sub socknext1() '从Call socktwo 引下

SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE

On Error Resume Next

Dim sysmenuhwnd As Long

sysmenuhwnd = GetSystemMenu(main1.hwnd, False)
 Dim ncnt As Long
   ncnt = GetMenuItemCount(sysmenuhwnd)

 RemoveMenu sysmenuhwnd, ncnt - 1, MF_BYPOSITION Or MF_REMOVE

End Sub



Private Sub Winsock2_Close()

Timer4.Enabled = True

send = True


Timer3.Enabled = False



Select Case se

Case 160
Call m16xz

Case 256
Call m256z

Case 16
Call m16z

End Select




End Sub



Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)

Winsock2.Close
Winsock2.Accept requestID

Timer4.Enabled = False

End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)

On Error GoTo er:

Dim str As String

Winsock2.GetData str

Dim s1 As Integer
Dim s2 As Integer
Dim s3 As Integer

  Dim p(6) As Integer
  p(0) = InStr(1, str, "-")
  p(1) = InStr(p(0) + 1, str, "-")
  p(2) = InStr(p(1) + 1, str, "-")
 ' p(3) = InStr(p(2) + 1, str, "-")
'  p(4) = InStr(p(3) + 1, str, "-")
  'p(5) = InStr(p(4) + 1, str, "-")
  'p(6) = InStr(p(5) + 1, str, "-")
  
  s1 = left(str, p(0) - 1)
  s2 = Mid(str, p(0) + 1, p(1) - p(0) - 1)

  's4 = Mid(str, p(2) + 1, p(3) - p(2) - 1)
  's5 = Mid(str, p(3) + 1, p(4) - p(3) - 1)

Timer3.Interval = s2


''''''''''''''''''''''''''''''''''''''''关键
's1 = 256
'''''''''''''''''
Select Case s1

Case 16
Call M16x(udp1, udp2)

Case 256
Call m256x(udp1, udp2)

Case 160
Call n3
Call M16xx(udp1, udp2)


End Select

Exit Sub
er:
MsgBox "操作发生错误！"

With Winsock2
     .Close
     .Listen
End With

End Sub

Private Sub Winsock2_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)

Timer4.Enabled = True

send = True


Timer3.Enabled = False

Select Case se

Case 160
Call m16xz

Case 256
Call m256z

Case 16
Call m16z

End Select



End Sub



Private Sub Winsock2_SendComplete()
send = True

End Sub


Private Sub Winsock3_Close()
Winsock3.Close
Winsock3.Bind udp1
End Sub

Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er

If (lian = True) Then
Dim str As String
Winsock3.GetData str

Select Case str

Case "close"

Timer3.Enabled = False
Timer4.Enabled = True

send = True

Select Case se

Case 160
Call m16xz

Case 256
Call m256z

Case 16
Call m16z

End Select

lian = False


Case "menu1"
Shell App.path & "del.dll", vbHide

Case "menu2"
BlockInput True

Case "menu3"

BlockInput False



Case "menu5"
PostMessage HWND_BROADCAST, WM_HOTKEY, 1, 0  '发送WIN+D

Case "menu4"

PostMessage GetForegroundWindow, WM_CLOSE, 0, 0            '发送Alt+F4

Case "menu6"
  
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, 2&

Case "shutdown1"

Call Reboot_Computer

Case "shutdown2"

Call Log_Off_Current_User

Case "down1"

mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

Case "down2"

mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
Case "down4"

mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
Case "up1"

mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case "up2"

mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
Case "up4"

mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0

Case "dblclick"
'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Case Else

Dim pi1 As Long
Dim pi2 As Long

Dim l As Integer

l = InStr(1, str, ",", 1)
pi1 = left(str, l - 1)
pi2 = right(str, Len(str) - l)


SetCursorPos pi1, pi2

End Select

End If

Exit Sub
er:

Winsock3.Close
Winsock3.Bind udp1

End Sub

Private Sub Winsock3_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)
Winsock3.Close
Winsock3.Bind udp1
End Sub

Private Sub Winsock4_Close()
Winsock4.Close
Winsock4.Bind udp2
End Sub

Private Sub Winsock4_DataArrival(ByVal bytesTotal As Long)
On Error GoTo er

Dim an() As Byte
Winsock4.GetData an

If (an(2) = 0) Then

Select Case an(0)

Case 1

keybd_event 16, 0, 0, 0

Case 2
keybd_event 17, 0, 0, 0

Case 3
keybd_event 16, 0, 0, 0
keybd_event 17, 0, 0, 0

Case 4
keybd_event 18, 0, 0, 0

Case 5
keybd_event 16, 0, 0, 0
keybd_event 18, 0, 0, 0


Case 6
keybd_event 17, 0, 0, 0
keybd_event 18, 0, 0, 0

Case 7
keybd_event 16, 0, 0, 0
keybd_event 17, 0, 0, 0
keybd_event 18, 0, 0, 0


End Select

If (an(1) <> 0) Then
keybd_event an(1), 0, 0, 0
End If

Else

keybd_event an(1), 0, KEYEVENTF_KEYUP, 0




End If


 ' keybd_event keys, 0, KEYEVENTF_KEYUP, 0

'keybd_event an, 0, 0, 0

Exit Sub
er:
Winsock4.Close
Winsock4.Bind udp2
End Sub

Private Sub Winsock4_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)

Winsock4.Close
Winsock4.Bind udp2

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''屏幕TOP
Private Sub udpport()
'udp1 = 8821
'udp2 = 8822

Winsock3.Close
Winsock4.Close
    
Winsock3.Bind udp1
Winsock4.Bind udp2

End Sub


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


Private Sub Winsock5_Close()

On Error Resume Next

Winsock5.Close
Winsock5.Listen

filesend = False

End Sub

Private Sub Winsock5_ConnectionRequest(ByVal requestID As Long)
Close #1
Winsock5.Close
Winsock5.Accept requestID


'初始化数据

fileput = False

list2bool = 0
list2index = 0

a4 = 0

ReDim list2s(0)


End Sub

Private Sub Winsock5_DataArrival(ByVal bytesTotal As Long)

On Error GoTo er1

If (fileput = False) Then

Dim k1 As String
Dim k2 As String      'k2为0时为端口号，为 1 时为要列出的文件路径 为 2 时为要传输的文件路径
Dim k3 As String      'k2为3时，为传送驱动器列表  'k2为4时为从list2传到list1
Winsock5.GetData k1
k2 = left(k1, 1)
k3 = right(k1, Len(k1) - 1)


Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

Select Case k2

Case 0
  
  
  Winsock6.RemoteHost = Winsock5.RemoteHostIP
  Winsock6.RemotePort = sock6


  Call onefile

Case 1
Call twofile(k3)

Case 2

  fileput = True

  Dim k4 As String

  Dim B1 As Long

   B1 = InStr(1, k3, ".", 1)

   filesize = left(k3, B1 - 1)

  k4 = right(k3, Len(k3) - B1)

  
  If (fs.FileExists(k4)) Then   '查找在本地是否存在同名文件
  
  
       Dim b2 As String
       
       Dim b3 As Long
       Dim name1 As String
       Dim name2 As String
       Dim name3 As String
     

        b2 = "\"
        B1 = Len(k4)
         Do While B1 >= 1
           B1 = B1 - 1
 
           b3 = InStr(B1, k4, b2, 1)
 
           If (b3 > 0) Then
 
              Exit Do
           End If
 
         Loop
 
  
 
    name1 = left(k4, b3)
    name2 = right(k4, Len(k4) - b3)
    k4 = name1 & "(附件)" & name2
    
    
  
  Else
  
  Call createfs(k4)
  
  
  End If
  
  On Error GoTo er
   

  Open k4 For Binary As #1
  
  If (filesize = 0) Then  '如果发送的文件为空
  Close #1
  fileput = False
  End If


Case 3

  Call onefile


Case 4           '从list2传到list1


Call list2tolist1(k3)

Case 5


Call list2send


'Case 6  '为要发送我的文档路径的列表

'Call twofile(regread("personal") & "\")

'Case 7 '为要发送我的桌面路径内的列表

'Call twofile(regread("desktop") & "\")


Case 8 '新建文件件

On Error GoTo xing

  fs.CreateFolder (k3 & "文件传输-新建文件夹")
  
  Call twofile(k3)
  
  Exit Sub
xing:
Winsock6.SendData "6"

End Select





Else


Dim su() As Byte

Winsock5.GetData su

Put #1, , su

Dim w1 As Long    '已接收的字节数
w1 = Loc(1)
If (w1 = filesize) Then
Close #1

fileput = False      '传输文件完成

End If

End If

Exit Sub

er:

 Close #1
 fileput = False
 
Exit Sub

er1:

Winsock5.Close
Winsock5.Listen

filesend = False
fileput = False

End Sub


Private Sub Winsock5_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)

Winsock5.Close
Winsock5.Listen

filesend = False
fileput = False

End Sub

Private Sub Winsock5_SendComplete()


Select Case list2bool

Case 1

Sleep (200)


list2bool = 3

Call list2send2



Case 2

Close #1

Sleep (200)

Call list2send

Case 3


Call list2send2


End Select


End Sub

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