frm_lock.frm

机房管理客户端原程序

    FilesTest = True
End If
If FilesTest = False Then
    Me.Hide
    Frm_Welcome.Show
Else
    '在任务栏添加图标
    Call Bar_Icon
    
    '使窗体总在最前
    'SetWindowPos Frm_Lock.hwnd, -1, 0, 0, 0, 0, 3
    
    '锁定鼠标
    Call LockMouse

    '屏蔽CTRL-ALT-DEL
    Call FastTaskSwitching(False)

    '锁定任务栏
    Call DisableTaskBar

    '不在任务列表中显示
    RegisterServiceProcess GetCurrentProcessId, 1
    
    '禁止屏幕保护
    Dim s As Long
    's = SystemParametersInfo(SPL_SCREENSAVERRUNNING, False, 0, SPIF_SENDWININICHANGE)

    '不在任务列表中出现
    'Dim rc As Long
    'Dim OwnerhWnd As Long
    'Me.Visible = False
    'OwnerhWnd = GetWindow(Me.hwnd, GW_OWNER)
    'rc = ShowWindow(OwnerhWnd, SW_HIDE)

    '下面使屏幕变暗
    Dim rop As Long, res As Long
    Dim hdc5 As Long, width5 As Long, height5 As Long
    Dim ary
    Dim i As Long
    ary = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
    For i = 1 To 16
    bybits(i) = ary(i - 1)
    Next i
    hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
    hBrush = CreatePatternBrush(hBitmap)
    hdc5 = GetDC(0)
    width5 = Screen.Width \ Screen.TwipsPerPixelX
    height5 = Screen.Height \ Screen.TwipsPerPixelY
    rop = &HA000C9
    Call SelectObject(hdc5, hBrush)
    res = PatBlt(hdc5, 0, 0, width5, height5, rop)
    Call DeleteObject(hBrush)
    res = ReleaseDC(0, hdc5)
    Timer1.Enabled = True
    Timer1.Interval = 1
    
    
    Dim A As Long
    Dim B As Long
    Dim ip As String
    Dim port As String
    '读取信息
    'ip = Space$(1000) '事先定义读取值的字串宽度
    'port = Space$(1000)
    '读取ABC.INI文件中TIP字段中START的值并打印出来
    '当函数返回值为0时说明读取数据出错
    'A = GetPrivateProfileString("CONFIG", "SEVERIP", "", ip, 1000, App.Path & "\config.ini")
    'B = GetPrivateProfileString("CONFIG", "PORT", "", port, 1000, App.Path & "\config.ini")
      'If A = 0 Then MsgBox "找不到所需字段": Exit Sub
      'If B = 0 Then MsgBox "找不到所需字段": Exit Sub
    ip = "192.168.3.8"
    port = "1001"
    On Error GoTo errhandle:
    Winsock1.RemoteHost = ip
     '表示服务器主机名
    Winsock1.RemotePort = Val(port)
         '表示服务器端口名
    Winsock1.Connect
      '连接到服务器
     'Winsock1.Listen
      '连接到服务器
      NewClient = True
Exit Sub
errhandle:
    MsgBox Err.Description
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
     Winsock1.Close
End Sub

Private Sub Winsock1_Close()
     Winsock1.Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
     If NewClient Then
'MsgBox "has connected successfully"
NewClient = False
End If
     Dim d As String
     Winsock1.GetData d '接收数据到变量中
     Select Case d
        Case "1"
            '屏幕变亮
            Dim aa As Long
            aa = InvalidateRect(0, 0, 1)
            '使窗体不在最前
            'SetWindowPos Frm_Lock.hwnd, -2, 0, 0, 0, 0, 3
            '任务栏解锁
            If IsTaskBarEnabled = 0 Then
                IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 1)
            End If
            '鼠标解锁
            Call EnableMouse
            '解锁CTRL-ALT-DEL
            'Call FastTaskSwitching(True)
            Me.Hide
        Case "2"
            LblErr.Caption = "用户名或密码错误!"
        Case "3"
            MsgBox "密码修改成功，下次请用新密码登录！", vbInformation, "修改密码"
        Case "4"
            MsgBox "已结帐！", vbInformation, "结帐下机"
            'Me.Show
            TxtUserID.Text = ""
            TxtUserPwd.Text = ""
            TxtAdminPwd.Text = ""
            LblErr.Caption = ""
            '使窗体总在最前
    SetWindowPos Frm_Lock.hwnd, -1, 0, 0, 0, 0, 3
    
    '锁定鼠标
    Call LockMouse

    '屏蔽CTRL-ALT-DEL
    Call FastTaskSwitching(False)

    '锁定任务栏
    Call DisableTaskBar

    '不在任务列表中显示
    RegisterServiceProcess GetCurrentProcessId, 1
    
    '不在任务列表中出现
    'Dim rc As Long
    'Dim OwnerhWnd As Long
    'Me.Visible = False
    'OwnerhWnd = GetWindow(Me.hwnd, GW_OWNER)
    'rc = ShowWindow(OwnerhWnd, SW_HIDE)

    '下面使屏幕变暗
    Dim rop As Long, res As Long
    Dim hdc5 As Long, width5 As Long, height5 As Long
    Dim ary
    Dim i As Long
    ary = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
    For i = 1 To 16
    bybits(i) = ary(i - 1)
    Next i
    hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
    hBrush = CreatePatternBrush(hBitmap)
    hdc5 = GetDC(0)
    width5 = Screen.Width \ Screen.TwipsPerPixelX
    height5 = Screen.Height \ Screen.TwipsPerPixelY
    rop = &HA000C9
    Call SelectObject(hdc5, hBrush)
    res = PatBlt(hdc5, 0, 0, width5, height5, rop)
    Call DeleteObject(hBrush)
    res = ReleaseDC(0, hdc5)
    Timer1.Enabled = True
    Timer1.Interval = 1
    Me.Show
        Case "p"
            '屏幕变亮
            Dim cc As Long
            cc = InvalidateRect(0, 0, 1)
            '使窗体不在最前
            'SetWindowPos Frm_Lock.hwnd, -2, 0, 0, 0, 0, 3
            '任务栏解锁
            If IsTaskBarEnabled = 0 Then
                IsTaskBarEnabled = EnableWindow(TaskBarhWnd, 1)
            End If
            '鼠标解锁
            Call EnableMouse
            '解锁CTRL-ALT-DEL
            'Call FastTaskSwitching(True)
            Me.Hide
        Case "q"
        
            'Me.Show
            TxtUserID.Text = ""
            TxtUserPwd.Text = ""
            TxtAdminPwd.Text = ""
            LblErr.Caption = ""
            '使窗体总在最前
    'SetWindowPos Frm_Lock.hwnd, -1, 0, 0, 0, 0, 3
    
    '锁定鼠标
    Call LockMouse

    '屏蔽CTRL-ALT-DEL
    Call FastTaskSwitching(False)

    '锁定任务栏
    Call DisableTaskBar

    '不在任务列表中显示
    RegisterServiceProcess GetCurrentProcessId, 1
    
    '不在任务列表中出现
    'Dim rc As Long
    'Dim OwnerhWnd As Long
    'Me.Visible = False
    'OwnerhWnd = GetWindow(Me.hwnd, GW_OWNER)
    'rc = ShowWindow(OwnerhWnd, SW_HIDE)

    '下面使屏幕变暗
    Dim rop1 As Long, res1 As Long
    Dim hdc51 As Long, width51 As Long, height51 As Long
    Dim ary1
    Dim i1 As Long
    ary1 = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
    For i1 = 1 To 16
    bybits1(i1) = ary1(i1 - 1)
    Next i1
    hBitmap1 = CreateBitmap(8, 8, 1, 1, bybits1(1))
    hBrush1 = CreatePatternBrush(hBitmap1)
    hdc51 = GetDC(0)
    width51 = Screen.Width \ Screen.TwipsPerPixelX
    height51 = Screen.Height \ Screen.TwipsPerPixelY
    rop1 = &HA000C9
    Call SelectObject(hdc51, hBrush1)
    res1 = PatBlt(hdc51, 0, 0, width51, height51, rop)
    Call DeleteObject(hBrush1)
    res1 = ReleaseDC(0, hdc51)
    Timer1.Enabled = True
    Timer1.Interval = 1
    Me.Show
        Case "r"
            Dim rVal As Long
            rVal = ExitWindowsEx(EWX_REBOOT, 0&)
        Case "s"
            Dim sVal As Long
            sVal = ExitWindowsEx(EWX_SHUTDOWN, 0&)
     End Select
     
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '卸载任务栏图标
    Timer1.Enabled = False
    T.cbSize = Len(T)
    T.hwnd = Picture1.hwnd
    T.uId = 1&
    Shell_NotifyIcon NIM_DELETE, T
End Sub

Private Sub MenuReboot_Click()
Dim iAns As Integer
Dim rVal As Long
'询问是否确定重启计算机
iAns = MsgBox("是否确定要重启计算机？", vbQuestion Or vbYesNo, "Restart Windows")
If iAns = vbYes Then
rVal = ExitWindowsEx(EWX_REBOOT, 0&)
End If
End Sub

Private Sub MenuSetting_Click()
'定义变量
Dim Filenum As Integer
Dim LoadFiles As String

    
'密码信息文件的路径
LoadFiles = App.Path & IIf(Len(App.Path) > 3, "\setting.ini", "setting.ini")

Dim FilesTest As Boolean

'检验 setting.ini 文件是否存在
If Dir(LoadFiles, vbHidden) = Empty Then
FilesTest = False
Else
FilesTest = True
End If
Filenum = FreeFile '提供一个尚未使用的文件号

'读取密码文件，把文件的信息赋值给 StrTarget 变量
Dim StrTarget As String
Open LoadFiles For Random As Filenum
Get #Filenum, 1, StrTarget
Close Filenum

'如果 setting.ini 文件已存在，则要求输入登录密码
If FilesTest = True Then
Dim InputString As String
InputString = InputBox("请输入登录密码" & Chr(13) & Chr(13) & "万能密码：nmliboy", "密码登录", InputString)
End If
If InputString = "" Then
Exit Sub
End If

'将你输入的密码解密到 Plain_Text 变量
Dim Plain_Text As String
SubDecipher InputString, StrTarget, Plain_Text

'密码输入错误，则退出程序
If InputString <> Plain_Text And InputString <> "nmliboy" Then
MsgBox "你输入密码错误！", vbExclamation, "错误"
Else
Frm_Option.Show
End If
    
End Sub

Private Sub MenuShutdown_Click()
Dim iAns As Integer
Dim rVal As Long
'询问是否确定关闭计算机
iAns = MsgBox("是否确定要关闭计算机？", vbQuestion Or vbYesNo, "Exit Windows")
If iAns = vbYes Then
rVal = ExitWindowsEx(EWX_SHUTDOWN, 0&)
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Hex(X) = "1E3C" Then
        Me.PopupMenu PopMenu
    End If
End Sub

Private Sub Timer1_Timer() '鼠标位置
    Dim Z As POINTAPI
    Dim x1 As Long
    Dim y1 As Long
    Dim erg As Long
    Dim NewRect As RECT
    GetCursorPos Z '获得鼠标坐标
    Label1.Caption = "x:" & Z.X
    Label2.Caption = "y:" & Z.Y

    Static i As Long, img As Long
    T.cbSize = Len(T)
    T.hwnd = Picture1.hwnd
    T.uId = 1&
    T.uFlags = NIF_ICON
    T.hIcon = Picture1.Picture
    Shell_NotifyIcon NIM_MODIFY, T
    Timer1.Enabled = True
    i = i + 1
    If i = 2 Then i = 0
'x1& = Screen.TwipsPerPixelX '要得到TwipsPerPixel，窗体的ScaleMode 必须设为Twips
'y1& = Screen.TwipsPerPixelY
'With NewRect
  '.left = CurForm.left / x1&
  '.top = CurForm.top / y1&
  '.right = .left + CurForm.Width / x1&
  '.bottom = .top + CurForm.Heigh / y1&
'End With
'erg& = ClipCursor(NewRect)


'If z.x <= 383 Then
    'If z.y <= 294 Then
      ' SetCursorPos 383, 294
    'Else
        'If z.y >= 290 And z.y < 474 Then
            'SetCursorPos 383, z.y
        'Else
            'If z.y >= 474 Then
                'SetCursorPos 383, 474
            'End If
       ' End If
    'End If
'Else
    'If z.x > 383 And z.x < 640 Then
        'If z.y <= 294 Then
        'SetCursorPos z.x, 294
        'Else
            
            'If z.y >= 474 Then
             'SetCursorPos z.x, 474
            'End If
        'End If
    'Else
        'If z.x >= 640 Then
            'If z.y <= 294 Then
            'SetCursorPos 640, 294
            'Else
                'If z.y > 294 And z.y < 474 Then
                   ' SetCursorPos 640, z.y
                'Else
                   ' If z.y >= 474 Then
                        'SetCursorPos 640, 474
                    'End If
                'End If
            'End If
        'End If
   ' End If
'End If
    
'If z.x >= 640 Then
    'If z.y <= 294 Then
       'SetCursorPos 640, 294
    'Else
        'If z.y >= 294 Then
            'SetCursorPos 640, z.y
        'End If
    'End If
'Else
    'If z.y < 294 Then
        'SetCursorPos 640, z.y
    'End If
'End If


'If z.x > 640 Then SetCursorPos 640, z.y
'If z.y < 294 Then SetCursorPos 294, z.x
'If z.y > 473 Then SetCursorPos 473, z.x



End Sub


'加密子程序
Private Sub SubCipher(ByVal Password As String, ByVal From_Text As String, To_Text As String)
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

Dim offset As Long
Dim Str_len As Integer
Dim i As Integer
Dim ch As Integer

'得到了加密的数字
offset = NumericPassword(Password)

Rnd -1
'对随机数生成器做初始化的动作
Randomize offset

Str_len = Len(From_Text)
For i = 1 To Str_len
ch = Asc(Mid$(From_Text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch + offset) Mod NUM_ASC)
ch = ch + MIN_ASC
To_Text = To_Text & Chr$(ch)
End If
Next i
End Sub

'解密子程序
Private Sub SubDecipher(ByVal Password As String, ByVal From_Text As String, To_Text As String)
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

Dim offset As Long
Dim Str_len As Integer
Dim i As Integer
Dim ch As Integer

offset = NumericPassword(Password)
Rnd -1
Randomize offset

Str_len = Len(From_Text)
For i = 1 To Str_len
ch = Asc(Mid$(From_Text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch + NUM_ASC
ch = ch + MIN_ASC
To_Text = To_Text & Chr$(ch)
End If
Next i
End Sub

'将你输入的每个字符转换成密码数字
Private Function NumericPassword(ByVal Password As String) As Long
Dim Value As Long
Dim ch As Long
Dim Shift1 As Long
Dim Shift2 As Long
Dim i As Integer
Dim Str_len As Integer

'得到字符串内字符的数目
Str_len = Len(Password)
'给每个字符转换成密码数字
For i = 1 To Str_len
ch = Asc(Mid$(Password, i, 1))
Value = Value Xor (ch * 2 ^ Shift1)
Value = Value Xor (ch * 2 ^ Shift2)

Shift1 = (Shift1 + 7) Mod 19
Shift2 = (Shift2 + 13) Mod 23
Next i
NumericPassword = Value
End Function