📄 frmserver1.frm

📁 机房管理
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    
    '配置Ini数据
     File = App.Path & "\day.ini"
     
    '初始化数据
     InitData
     
     If ShowPic = 0 Then
        picInfo.Visible = False
     End If
     
     sJH = "01"   '初始化
     
     Screen.MousePointer = 0
    
     Exit Sub
     
Err_D:
     MsgBox "NetBar服务器装载错误： " & vbCrLf & vbCrLf & Err.Description
     
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

 If imgMove = True Then
    HideLine
 End If
 
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim ArrayIndex As Integer
    
    For ArrayIndex = 1 To UBound(gActiveSockets)
        If gActiveSockets(ArrayIndex).Connected Then
            sktTCPChatServer(ArrayIndex).Close
            Unload sktTCPChatServer(ArrayIndex)
          End If
        Next ArrayIndex
    End Sub

Private Sub Form_Resizes()
    
    On Error Resume Next
    Dim MinFormHeight As Long
    Dim MinFormWidth As Long
    Dim FreeSpace As Long
        
    If frmServer.WindowState = vbMinimized Then
        Exit Sub
    End If
    
    If Me.Height < 1000 Then Me.Height = 1000
    If Me.Width < 3000 Then Me.Width = 3000
    
    MinFormHeight = (Height - ScaleHeight) + _
                    sbWinsockStatus.Height + _
                    cmdSendData.Height + _
                    lblDataToSend.Height + 100 + _
                    lblDataReceived.Height + 100 + _
                    8 * FormSpace
    MinFormWidth = (Width - ScaleWidth) + _
                   cmdSendData.Width + _
                   3 * FormSpace + 100
    frmServer.Height = MaxLong(frmServer.Height, MinFormHeight)
    frmServer.Width = MaxLong(frmServer.Width, MinFormWidth)
    
    cmdSendData.left = ScaleWidth - _
        (cmdSendData.Width + FormSpace) - cmdConfig.Width - 110 - FormSpace
    cmdSendData.tOp = ScaleHeight - _
        (sbWinsockStatus.Height + cmdSendData.Height + FormSpace)
    cmdConfig.left = cmdSendData.left + FormSpace + cmdSendData.Width + 100
    cmdConfig.tOp = cmdSendData.tOp
    
    FreeSpace = (cmdSendData.tOp - 3 * FormSpace)
    
    lblIPAddress.left = FormSpace
    lblIPAddress.tOp = cmdSendData.tOp
    lblIPAddress.Width = cmdSendData.left - 8 * FormSpace
    
    lblDataToSend.left = FormSpace
    lblDataToSend.tOp = FormSpace
    txtDataToSend.left = FormSpace
    txtDataToSend.tOp = lblDataToSend.tOp + lblDataToSend.Height
    txtDataToSend.Width = ScaleWidth - (2 * FormSpace)
    txtDataToSend.Height = (FreeSpace * 0.33) - _
                           lblDataToSend.Height
    lblDataReceived.left = FormSpace
    lblDataReceived.tOp = txtDataToSend.tOp + _
                          txtDataToSend.Height + FormSpace
    txtDataReceived.left = FormSpace
    txtDataReceived.tOp = lblDataReceived.tOp + _
                          lblDataReceived.Height
    txtDataReceived.Width = txtDataToSend.Width
    txtDataReceived.Height = (FreeSpace * 0.67) - _
                             lblDataReceived.Height
    
    chkTop.tOp = lblDataToSend.tOp
    chkClipBoard.tOp = lblDataReceived.tOp
    
    End Sub

Private Sub Form_Resize()

  On Error Resume Next
  If Me.WindowState = 1 Then Exit Sub '最小化时退出
    
  ' 设定最小值
  If Me.Width <= 8000 Then
     Me.Width = 8000
  End If
  If Me.Height <= 5000 Then
     Me.Height = 5000
  End If
  
  picAvi1.left = frmServer.ScaleWidth - picAvi1.Width - 30
  
  If ShowPic = 1 Then
     lvComputer.Width = Me.ScaleWidth * 0.7  '70%
     lvComputer.Height = Me.ScaleHeight - tbToolBar.Height - sbWinsockStatus.Height - 100 - tbToolbar2.Height
     picInfo.Width = Me.ScaleWidth * 0.3 - 100
     picInfo.Height = lvComputer.Height
     picInfo.left = lvComputer.Width + 20
    Else
     lvComputer.Width = Me.ScaleWidth
     lvComputer.Height = Me.ScaleHeight - tbToolBar.Height - sbWinsockStatus.Height - 100 - tbToolbar2.Height
  End If
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

   '保存设置
    SaveSetting App.EXEName, "Config", "Left", Me.left
    SaveSetting App.EXEName, "Config", "Top", Me.tOp
    SaveSetting App.EXEName, "Config", "Height", Me.Height
    SaveSetting App.EXEName, "Config", "Width", Me.Width
    SaveSetting App.EXEName, "Config", "WindowState", Me.WindowState
    
   ' 御载的所有窗体
   If FA = True Then
      Unload frmAbout
   End If
   If FC = True Then
      Unload frmCheck
   End If
   If FCT = True Then
      Unload frmCustomer
   End If
   If FE = True Then
     Unload frmExchange
   End If
   If FI = True Then
      Unload frmInfo
   End If
   If FL = True Then
      Unload frmLock
   End If
   If FO = True Then
      Unload frmOption
   End If
   If FS = True Then
      Unload frmSend
   End If

End Sub

Private Sub imgCloseInfo_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   
 If Button = 1 Then '左键
    LineDown  '按下
 End If
 
End Sub

Private Sub imgCloseInfo_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

 If imgMove = True Then Exit Sub
 
    ShowLine
    
End Sub

Private Sub imgCloseInfo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    
  If Button = 1 Then
     LineUp
     HideLine
     picInfo.Visible = False

     SaveSetting App.Path, "Option", "InfoShow", 0  '存
     ShowPic = 0
     Call Form_Resize
  End If
    
End Sub

Private Sub lblJH_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 
 If imgMove = True Then
    HideLine
 End If
 
End Sub

Private Sub lvComputer_ItemClick(ByVal Item As MSComctlLib.ListItem)

   If Item.Text = "空闲" Then   '没有计费时
      tbToolBar.Buttons(2).Enabled = True
      tbToolBar.Buttons(4).Enabled = False
      tbToolBar.Buttons(3).Enabled = False
      MnuStart.Enabled = True
      MnuStop.Enabled = False
      m_cMenu1.Enabled(1) = True
      m_cMenu1.Enabled(4) = False
      m_cMenu1.Enabled(5) = False
      m_cMenu1.Enabled(6) = False
      m_cMenu1.Enabled(2) = False
   Else
      tbToolBar.Buttons(4).Enabled = True
      tbToolBar.Buttons(3).Enabled = True
      tbToolBar.Buttons(2).Enabled = False
      MnuStart.Enabled = False
      MnuStop.Enabled = True
      m_cMenu1.Enabled(1) = False
      m_cMenu1.Enabled(2) = True
      m_cMenu1.Enabled(4) = True
      m_cMenu1.Enabled(5) = True
      m_cMenu1.Enabled(6) = True
   End If
     
     sJH = left(Item.SubItems(1), 2)
    
End Sub

Private Sub lvComputer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

 If imgMove = True Then
    HideLine
 End If
 
End Sub

Private Sub lvComputer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

  If Button = 2 Then
     
   '菜单Click
    Dim lIndex As Long
    lIndex = m_cMenu1.ShowPopupMenu(x + 50, y + tbToolBar.Height + tbToolbar2.Height + 100, x + 50, y + tbToolBar.Height + tbToolbar2.Height + 100, Me.ScaleWidth, 0, False)
      
      '事件
       If (lIndex > 0) Then

         Select Case m_cMenu1.ItemKey(lIndex)
         Case "Start"
            MnuStart_Click
         Case "Stop"
            MnuStop_Click
         Case "Message"
            MnuMessage_Click
         Case "Exchange"
            If FE = True Then Unload frmExchange
            Load frmExchange
            frmExchange.Show 1
         Case "Customer"
            If FCT = True Then Unload frmCustomer
            Load frmCustomer
            frmCustomer.Show 1
         Case "Reboot"
            MnuRestart_Click
         Case "Close"
            MnuShutdown_Click
         Case "Lock"
            MnuLock_Click
         Case "Info"
            If ShowPic = 0 Then
               ShowPic = 1
               Call Form_Resize
               picInfo.Visible = True
               SaveSetting App.Path, "Option", "InfoShow", 1  '存
             Else
               frmInfo.Show 1
            End If
         End Select
      End If
 
  End If
  
End Sub

Private Sub MnuLock_Click()

   ' 锁定计算机
     frmLock.Show 1

End Sub

Private Sub MnuMessage_Click()

  ' 发送消息
  If FS = True Then Unload frmSend
  Load frmSend    ' 安装消息系统
  frmSend.picSendMessage.Visible = True
  frmSend.cmdSend.Default = True
  frmSend.cmdCancel.Cancel = True
  frmSend.Show 1
  
End Sub

Private Sub MnuRestart_Click()
  
  ' 发送消息
  If FS = True Then Unload frmSend
  Load frmSend    ' 安装重新系统
  frmSend.picRestart.Visible = True
  frmSend.Command1.Default = True
  frmSend.Command2.Cancel = True
  frmSend.Show 1

End Sub

Private Sub MnuShutdown_Click()
  
  ' 发送消息
  If FS = True Then Unload frmSend
  Load frmSend    ' 安装关闭系统
  frmSend.picShutDown.Visible = True
  frmSend.Command3.Default = True
  frmSend.Command4.Cancel = True
  frmSend.Show 1
  
End Sub

Private Sub MnuStart_Click()
      
      If lvComputer.SelectedItem.Text = "" Then
         Exit Sub
        Else
         ' 开始计费
         Dim curIndex As Integer
             curIndex = lvComputer.SelectedItem.Index
         lvComputer.ListItems(curIndex).SmallIcon = ImageList1.ListImages(2).Key
         lvComputer.ListItems(curIndex).Text = "计费"
         lvComputer.ListItems(curIndex).SubItems(2) = Now
         lvComputer.ListItems(curIndex).SubItems(3) = ""  '结束时间
         lvComputer.ListItems(curIndex).SubItems(4) = ""  '时间/分
         lvComputer.ListItems(curIndex).SubItems(6) = ""  '上网费用
         lvComputer.ListItems(curIndex).SubItems(8) = ""  '合计
         tbToolBar.Buttons(2).Enabled = False
         tbToolBar.Buttons(4).Enabled = True
         tbToolBar.Buttons(3).Enabled = True
         ' 其它操作
         AppName = Trim(Str(curIndex))
上一页 1 2 3 45
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -