main.frm

来自「星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V」· FRM 代码 · 共 2,195 行 · 第 1/5 页

FRM
2,195
字号
            MinWidth        =   4198
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   4092
            MinWidth        =   4092
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   2963
            MinWidth        =   2963
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            Object.Width           =   3175
            MinWidth        =   3175
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   7080
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Main.frx":1442
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Main.frx":211C
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSWinsockLib.Winsock Scmnet1 
      Index           =   0
      Left            =   600
      Top             =   7080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Scmtimer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   1560
      Top             =   7080
   End
   Begin VB.Menu File 
      Caption         =   "文件(&F)"
      Begin VB.Menu Open 
         Caption         =   "打开(&O)"
         Shortcut        =   ^O
      End
      Begin VB.Menu Htgl 
         Caption         =   "隐身(&Y)"
         Shortcut        =   ^A
      End
      Begin VB.Menu h1 
         Caption         =   "-"
      End
      Begin VB.Menu Renetser 
         Caption         =   "重启服务(&R)"
      End
      Begin VB.Menu h2 
         Caption         =   "-"
      End
      Begin VB.Menu Exit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu Gl 
      Caption         =   "管理(&G)"
      Begin VB.Menu Linkh 
         Caption         =   "连接主机(&L)"
         Shortcut        =   ^L
      End
      Begin VB.Menu Closecon 
         Caption         =   "关闭连接(&C)"
      End
      Begin VB.Menu Requt 
         Caption         =   "重启连接主机端(&R)"
      End
      Begin VB.Menu h6 
         Caption         =   "-"
      End
      Begin VB.Menu Publics 
         Caption         =   "共同管理(&P)"
         Begin VB.Menu Clcu 
            Caption         =   "关闭计算机(&C)"
         End
         Begin VB.Menu Lcul 
            Caption         =   "注销计算机(&L)"
         End
         Begin VB.Menu Reqcul 
            Caption         =   "重启计算机(&R)"
         End
      End
      Begin VB.Menu Recoms 
         Caption         =   "重新获取连接主机端(&N)"
      End
      Begin VB.Menu h3 
         Caption         =   "-"
      End
      Begin VB.Menu Sendfile 
         Caption         =   "文件传送(&S)"
      End
      Begin VB.Menu h4 
         Caption         =   "-"
      End
      Begin VB.Menu einew 
         Caption         =   "刷新(&E)"
      End
      Begin VB.Menu Del 
         Caption         =   "删除(&D)"
      End
      Begin VB.Menu Rdfile 
         Caption         =   "属性(&R)"
      End
   End
   Begin VB.Menu Szsy 
      Caption         =   "设置(&S)"
      Begin VB.Menu Sendkeyq 
         Caption         =   "发送快捷键""Enter""(&S)"
      End
      Begin VB.Menu Cuto 
         Caption         =   "取消快捷键""Enter""(&C)"
      End
   End
   Begin VB.Menu About 
      Caption         =   "关于(&A)"
      Begin VB.Menu Auup 
         Caption         =   "自动更新(&U)"
      End
      Begin VB.Menu h5 
         Caption         =   "-"
      End
      Begin VB.Menu help 
         Caption         =   "帮助(&H)"
      End
      Begin VB.Menu Abscm 
         Caption         =   "关于(&A)"
      End
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64  '指向后显示文本长度
End Type

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 Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Dim T As NOTIFYICONDATA

Public Strtimer As String

Dim Buto As String
Dim Scmnumber As Integer
Dim Scmlb1 As Long
Dim lcon As Boolean
Dim Buuse As Boolean


Private Sub Abscm_Click()
Frmabout.Show
End Sub

Private Sub Box1_Change()

 With Box1
                  '.SetFocus '选
                  .SelStart = 0
                  .SelLength = Len(.Text)
          End With
          
End Sub

Private Sub Box2_KeyPress(keyascii As Integer)

On Error GoTo sc

If keyascii = 13 Then

If Buto <> "Use Button" Then GoTo Tobuto

If Box2.Text = "" Then

MsgBox "发送内容不能空!", 64, "提示"

        Box2.Text = ""
        Box2.SetFocus
        SendKeys "{backspace}"

Else

          Call Sendinfor("Msgwins" & "(" & Time$ & ")" & Scmnet1(0).LocalHostName & ":" & vbCrLf & Box2.Text & vbCrLf & vbCrLf)

          Box1.Text = Box1.Text & "(" & Time$ & ")" & Scmnet1(0).LocalHostName & ":" & vbCrLf & Box2.Text & vbCrLf & vbCrLf

          Box2.Text = ""
          
        Box2.SetFocus
        SendKeys "{backspace}"

      Scmtxt1.Text = Scmtxt1.Text & vbCrLf & "信息发送成功!" & "(" & Time$ & ")" & vbCrLf

End If



a1 = 2

If a1 = 2 Then

Else

sc: MsgBox "(" & Scmnet1(0).LocalHostName & ")" & "该用户可能已经下了线!", 64, "提示"

 ' Command1.Enabled = False
  
   'Box2.Text = ""
        Box2.SetFocus
        SendKeys "{backspace}"
  
End If


End If

Tobuto:

End Sub

Private Sub Box5_Change()

 With Box5
                  '.SetFocus '选
                  .SelStart = 0
                  .SelLength = Len(.Text)
          End With

End Sub

Private Sub Box6_KeyPress(keyascii As Integer)

On Error GoTo sc

If keyascii = 13 Then

If Buto <> "Use Button" Then GoTo Tobuto

If Box6.Text = "" Then

MsgBox "发送内容不能空!", 64, "提示"

        Box6.Text = ""
        Box6.SetFocus
        SendKeys "{backspace}"

Else

         For i = 1 To UBound(Sac)
     If Not i = index Then
     If Sac(i) Then
     
         Scmnet1(i).SendData "Messgif" & "(" & Time$ & ")" & Scmnet1(0).LocalHostName & ":" & vbCrLf & Box6.Text & vbCrLf & vbCrLf
         
       DoEvents
      End If
     End If
   Next i
   
   Box5.Text = Box5.Text & "(" & Time$ & ")" & Scmnet1(0).LocalHostName & ":" & vbCrLf & Box6.Text & vbCrLf & vbCrLf

   Box6.Text = ""
 
        Box6.SetFocus
        SendKeys "{backspace}"
        
         Scmtxt1.Text = Scmtxt1.Text & vbCrLf & "聊天室信息发送成功!" & "(" & Time$ & ")" & vbCrLf

End If



a1 = 2

If a1 = 2 Then

Else

sc:

  'MsgBox "没有用户在线!", 64, "提示"

   Box5.Text = Box5.Text & "(" & Time$ & ")" & Scmnet1(0).LocalHostName & ":" & vbCrLf & Box6.Text & vbCrLf & vbCrLf

   Box6.Text = ""
  
   
        Box6.SetFocus
        SendKeys "{backspace}"
        
        Scmtxt1.Text = Scmtxt1.Text & vbCrLf & "聊天室信息发送成功!" & "(" & Time$ & ")" & vbCrLf
  
End If


End If

Tobuto:

End Sub

Private Sub Clcu_Click()

On Error Resume Next

If Scmlb1 > "0" Then

If MsgBox("你确定要关闭所有上线用户的计算机吗!", vbYesNo, "提示") = vbYes Then

For i = 1 To UBound(Sac)
     If Not i = index Then
      If Sac(i) Then
         Scmnet1(i).SendData "CLOSECU"
       DoEvents
      End If
     End If
   Next i
   
   End If
   
   Else
   
   MsgBox "还没有主机上线!", 64, "提示"
   
   End If

End Sub

Private Sub Closecon_Click()

  On Error Resume Next

If Conhosn <> "" Then

 Conhosn = ""
 
  Scmsta1.Panels(3).Text = "主机名称:" & "没找到"
  Scmsta1.Panels(2).Text = "连接状态:" & "已关闭连接"
  Scmsta1.Panels(4).Text = "提示:" & "已关闭连接"

End If


If Scmnet2.State = 7 Then

  Scmnet2.SendData "Closeco"

End If



End Sub

Private Sub Combo2_Click()
Dos1.Text = Combo2.Text
End Sub

Private Sub Command10_Click()
Call Sendinfor("Getsysf")
End Sub

Private Sub Command11_Click()
Call Sendinfor("Getdirs")
End Sub

Private Sub Command12_Click()

On Error GoTo Dlgerr

     Dlg1.filename = "获取主机信息记录"
 
     Dlg1.Filter = "(*.txt)|*.txt|"

     Dlg1.ShowSave

   Open Dlg1.filename For Output As #1

   Print #1, Box4.Text

   Close #1

   MsgBox "已成功保存到:" + Dlg1.filename, 64, "提示"

Exit Sub

Dlgerr:

End Sub

Private Sub Command13_Click()
Call Sendinfor("Keybinf")
End Sub

⌨️ 快捷键说明

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