screen2.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form2 
   Caption         =   "远程屏幕"
   ClientHeight    =   6600
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9855
   Icon            =   "Screen2.frx":0000
   LinkTopic       =   "Form2"
   ScaleHeight     =   6600
   ScaleWidth      =   9855
   StartUpPosition =   1  '所有者中心
   Begin VB.VScrollBar VScroll1 
      Height          =   6375
      Left            =   9600
      TabIndex        =   1
      Top             =   0
      Width           =   255
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   6360
      Width           =   9615
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   6345
      Width           =   9855
      _ExtentX        =   17383
      _ExtentY        =   450
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
      EndProperty
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      FillColor       =   &H00FFFF80&
      FillStyle       =   3  'Vertical Line
      FontTransparent =   0   'False
      ForeColor       =   &H00FFFFFF&
      Height          =   6375
      Left            =   0
      ScaleHeight     =   6375
      ScaleWidth      =   9615
      TabIndex        =   2
      Top             =   0
      Width           =   9615
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   0
      Top             =   7200
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Left            =   0
      Top             =   7200
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSWinsockLib.Winsock Winsock3 
      Left            =   0
      Top             =   7200
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   0
      Top             =   7200
   End
   Begin VB.Timer Timer2 
      Interval        =   1000
      Left            =   0
      Top             =   7200
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit


Dim ddd As Boolean

Public se As Long '定义显示位图的色度
Public port1 As String
Public port2 As String
Public port3 As String
Public IP1 As String
Public Color1 As String
Public udp2 As String
Public udp3 As String


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 BitMapInfo256, ByVal wUsage As Long) As Long


'定义模块级变量
Private bool As Boolean        '位图参数是否已接收
Private date3(6) As Long       '存放接收过来位图的信息
Private d1 As Long             '存放位图数据数组的储存情况

Private loda As Long
Private erda As Long

Private asii As Byte           'n 记录按键

'Private s1 As String, s2 As String '定义远程主机和端口 s1 为 IP或计算机名 s2 为端口号

Private clos As Integer          '记录重记连接次数

Private bf As BITMAPFILEHEADER
Private bi As BitMapInfo256
Private bi16 As BitMapInfo256

Public Sub m16a(bmWidth As Long, bmHeight As Long)


Form2.Picture1.Move 0, 0, Form2.Picture1.ScaleX(bmWidth, 3, 1), Form2.Picture1.ScaleY(bmHeight, 3, 1)

If ((bmWidth >= ScaleX(Screen.Width, 1, 3)) And (bmHeight >= ScaleY(Screen.Height, 1, 3))) Then

'Form2.WindowState = 2
Call vs
Else

Form2.Move 0, 0, Picture1.Width + 200, Picture1.Height + 600
Call vs

End If

Dim SizeOfArray As Long
Dim I As Long, r As Integer, g As Integer, b As Integer
    '
  
    SizeOfArray = (((bmWidth / 2 + 3) \ 4) * 4) * bmHeight
    '
    With bf
        .bfType = "BM"
        .bfSize = Len(bf) + Len(bi16) + SizeOfArray
        .bfReserved1 = 0
        .bfReserved2 = 0
        .bfOffBits = Len(bf) + Len(bi16)
    End With
    With bi16
        With .bmiHeader
        .biSize = Len(bi16.bmiHeader)
        .biWidth = bmWidth
        .biHeight = bmHeight
        .biPlanes = 1
        .biBitCount = 4
        .biCompression = 0
        .biSizeImage = SizeOfArray
        End With
        For I = 0 To 15
            .bmiColors(I) = QBColor(I)
        Next I
    End With
   
End Sub

Public Sub m16b(bBytes() As Byte)
   SetDIBitsToDevice formhdc, 0, 0, bi16.bmiHeader.biWidth, bi16.bmiHeader.biHeight, 0, 0, 0, bi16.bmiHeader.biHeight, bBytes(1), bi16, DIB_RGB_COLORS

End Sub


Public Sub m256a(bmWidth As Long, bmHeight As Long)
Form2.Picture1.Move 0, 0, Form2.Picture1.ScaleX(bmWidth, 3, 1), Form2.Picture1.ScaleY(bmHeight, 3, 1)

If ((bmWidth >= ScaleX(Screen.Width, 1, 3)) And (bmHeight >= ScaleY(Screen.Height, 1, 3))) Then
Call vs
'Form2.WindowState = 2

Else

Form2.Move 0, 0, Picture1.Width + 200, Picture1.Height + 600
Call vs

End If


Dim SizeOfArray As Long

Dim I As Long, r As Integer, g As Integer, b As Integer
    
    SizeOfArray = (((bmWidth + 3) \ 4) * 4) * bmHeight
       With bf
        .bfType = "BM"
        .bfSize = Len(bf) + Len(bi) + SizeOfArray
        .bfReserved1 = 0
        .bfReserved2 = 0
        .bfOffBits = Len(bf) + Len(bi)
    End With
    With bi
        With .bmiHeader
        .biSize = Len(bi.bmiHeader)
        .biWidth = bmWidth
        .biHeight = bmHeight
        .biPlanes = 1
        .biBitCount = 8
        .biCompression = 0
        .biSizeImage = SizeOfArray
        End With
        I = 0
        For b = 0 To &HE0 Step &H20
            For g = 0 To &HE0 Step &H20
                For r = 0 To &HC0 Step &H40
                    bi.bmiColors(I) = IIf(b = &HE0, &HFF, b) * &H10000 + IIf(g = &HE0, &HFF, g) * &H100 + IIf(r = &HC0, &HFF, r)
                    I = I + 1
                Next r
            Next g
        Next b
    End With
 
    
End Sub

Public Sub M256b(bBytes() As Byte)
SetDIBitsToDevice formhdc, 0, 0, bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 0, 0, 0, bi.bmiHeader.biHeight, bBytes(0), bi, DIB_RGB_COLORS
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Call keytwo(KeyCode, Shift)

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Call keyone(KeyCode, Shift)
End Sub

Private Sub Form_Load()

On Error GoTo er

loda = 0
erda = 0
main1.Label18.Caption = "丢失帧:0"
main1.Label19.Caption = "错误帧:0"

    '加入消息处理自定义函数

    OldWindowProc = GetWindowLong(Form2.hwnd, GWL_WNDPROC)
    
    '自定义系统菜单___________________________________

    SysMenuHwnd = GetSystemMenu(Form2.hwnd, False)

   Dim ncnt As Long
   ncnt = GetMenuItemCount(SysMenuHwnd)
'   RemoveMenu SysMenuHwnd, ncnt - 1, MF_BYPOSITION Or MF_REMOVE
 '  RemoveMenu SysMenuHwnd, ncnt - 2, MF_BYPOSITION Or MF_REMOVE

    Call SetWindowLong(Form2.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
    
    
    
    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2000, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2001, "发送 Ctrl+Shift+Del")
    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2002, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2003, "锁定被控端键盘和鼠标")
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2004, "解除被控端键盘和鼠标的锁定")
    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2005, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2006, "全屏显示被端桌面              F12")
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2007, "关闭被控端显示器")

    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2008, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2009, "关闭连接")
    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2010, vbNullString)
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2011, "发送 Alt+F4")
    Call AppendMenu(SysMenuHwnd, MF_STRING, 2012, "发送 Win+D")
    Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2013, vbNullString)

    Call AppendMenu(SysMenuHwnd, MF_STRING, 2014, "强制重启被控端计算机")

    Call AppendMenu(SysMenuHwnd, MF_STRING, 2015, "强制关闭被控端计算机")
    
    EnableMenuItem SysMenuHwnd, 2004, MF_GRAYED
    EnableMenuItem SysMenuHwnd, 2001, MF_GRAYED
   'EnableMenuItem SysMenuHwnd, 2006, MF_GRAYED
    






formhdc = Picture1.hDC



'Dim s3 As Integer
Dim s4 As Integer
'Dim s5 As Integer

Form2.Caption = "远程屏幕" + IP1 & "用鼠标单击窗口左上角的图标 ,弹出控制菜单；按F12键全屏显示。"
'''''''''''''''''''''''关键
's3 = 1

If main1.Strtimer = "" Then '屏幕刷新时间

If main1.Check1.Value = 1 Then

s4 = 2

ElseIf main1.Check2.Value = 1 Then

s4 = 3

ElseIf main1.Check3.Value = 1 Then

s4 = 4

Else

s4 = 1

End If


Else '屏幕刷新时间

s4 = main1.Strtimer

End If '屏幕刷新时间

'MsgBox Color1
'''''''''''''''''''''
Select Case Color1
Case 0
se = 16
Case 1
se = 256
Case 2
se = 160
End Select

Select Case s4
Case 0
time1 = 100
Case 1
time1 = 200
Case 2
time1 = 300
Case 3
time1 = 500
Case 4
time1 = 800
Case 5
time1 = 1000
End Select




With Winsock1
.Close
.RemoteHost = IP1
.RemotePort = port1

End With

Timer1.Enabled = True

Exit Sub
er:
MsgBox "初始化失败！"
End Sub

Private Sub Form_Resize()

On Error Resume Next

Call vs

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next

main1.Strtimer = ""

Winsock2.SendData "close"

'取消自定义消息处理
If OldWindowProc <> GetWindowLong(Form2.hwnd, GWL_WNDPROC) Then
        Call SetWindowLong(Form2.hwnd, GWL_WNDPROC, OldWindowProc)
End If

'Dim I As Integer
  
'For I = Forms.Count - 1 To 0 Step -1
     ' Unload Forms(I)
'Next

Winsock1.Close
Winsock2.Close
Winsock3.Close

main1.Command32.Enabled = True
main1.Option4.Enabled = True
main1.Option5.Enabled = True
main1.Option6.Enabled = True

main1.Check1.Enabled = True
main1.Check2.Enabled = True
main1.Check3.Enabled = True
main1.Command33.Enabled = False

 
End Sub

Private Sub HScroll1_KeyDown(KeyCode As Integer, Shift As Integer)
Call keytwo(KeyCode, Shift)

End Sub