📄 serverlist.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form ServerList
Caption = "Form3"
ClientHeight = 4980
ClientLeft = 60
ClientTop = 345
ClientWidth = 6195
ClipControls = 0 'False
ControlBox = 0 'False
LinkTopic = "Form3"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4980
ScaleWidth = 6195
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Interval = 1
Left = 5760
Top = 0
End
Begin VB.CommandButton Command1
Caption = "刷新"
Height = 375
Left = 2160
TabIndex = 9
Top = 4560
Width = 975
End
Begin MSWinsockLib.Winsock Winsock1
Left = 5760
Top = 4560
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton Command6
Caption = "返回"
Height = 375
Left = 3600
TabIndex = 7
Top = 4560
Width = 975
End
Begin VB.CommandButton Command5
Caption = "发送"
Height = 375
Left = 720
TabIndex = 6
Top = 4560
Width = 975
End
Begin VB.CommandButton Command4
Caption = "清空"
Height = 495
Left = 3120
TabIndex = 5
Top = 2040
Width = 495
End
Begin VB.CommandButton Command3
Caption = "删除"
Height = 495
Left = 3120
TabIndex = 4
Top = 840
Width = 495
End
Begin VB.ComboBox srvtype
Height = 300
ItemData = "ServerList.frx":0000
Left = 2520
List = "ServerList.frx":0002
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 2
Top = 80
Width = 2895
End
Begin VB.TextBox Text1
Height = 1335
Left = 0
MultiLine = -1 'True
TabIndex = 1
Text = "ServerList.frx":0004
Top = 3120
Width = 6135
End
Begin VB.ListBox List1
Height = 2580
Left = 3720
TabIndex = 0
Top = 480
Width = 2415
End
Begin ComctlLib.ListView SrvList
Height = 2600
Left = 0
TabIndex = 3
Top = 480
Width = 3015
_ExtentX = 5318
_ExtentY = 4577
View = 1
Arrange = 1
LabelEdit = 1
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
_Version = 327682
SmallIcons = "Images"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
Enabled = 0 'False
NumItems = 0
End
Begin VB.Label Label1
Caption = "服务器类型"
Height = 255
Left = 1440
TabIndex = 8
Top = 120
Width = 975
End
Begin ComctlLib.ImageList Images
Left = 5160
Top = 4560
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 3
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "ServerList.frx":0015
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "ServerList.frx":032F
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "ServerList.frx":0649
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "ServerList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim q As Integer
Dim s As Integer
Dim strlb As String
Dim m As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Declare Function NetMessageBufferSend Lib "NETAPI32.DLL" (Server As Any, yToName As Byte, yFromName As Any, yMsg As Byte, ByVal lSize As Long) As Long
Private Sub Command1_Click()
srvtype.Clear
Form_Load
End Sub
Private Sub Command3_Click()
Dim j As Integer
If List1.ListCount > 0 Then
j = List1.ListIndex
If j = -1 Then
MsgBox "没有选择要删除项，请选择后再点击删除按钮!"
Else
List1.RemoveItem (j)
End If
Else
MsgBox "没有可删除的数据!"
End If
End Sub
Private Sub Command4_Click()
List1.Clear
End Sub
Private Sub Command5_Click()
Dim x As Boolean
Dim i As Integer
If List1.ListCount = 0 Then
MsgBox "没有指定用户，请选择用户!"
ElseIf Text1.Text = "" Then MsgBox "你没有写信息"
Else
For i = 0 To List1.ListCount - 1
x = SendMsg(List1.List(i), Winsock1.LocalHostName, Text1.Text)
If x = False Then
m = 1
strlb = strlb + List1.List(i) + ","
End If
Next
If m = 1 Then
MsgBox strlb + "没发成功!"
Else
MsgBox "所有用户发送完毕!"
End If
End If
m = 0
strlb = ""
End Sub
Private Sub Command6_Click()
Me.Hide
Form1.Serverlistxs = 0
End Sub
Private Sub Form_Load()
Dim x As Integer, Domain As String
Dim xItem As ListItem
Dim WksInfo As ServerInfo
m = 0
q = 0
strlb = ""
MousePointer = vbHourglass
ExtendListView Me.SrvList, True
Domain = GetPDCName()
If Domain <> "" Then
Me.Caption = "Select Computer on Domain " & GetDomainName()
LoadSrvType
Me.srvtype = "NT Server & WorkStation"
Else
WksInfo = GetServerInfo()
Me.Caption = "Local WorkStation \\" & WksInfo.ServerName
Me.srvtype.Enabled = False
Set xItem = Me.SrvList.ListItems.Add(, , WksInfo.ServerName)
xItem.SubItems(1) = WksInfo.Comment
xItem.SubItems(2) = WksInfo.Platform
Select Case WksInfo.ServerType
Case Is >= 5
xItem.Tag = "x"
xItem.SmallIcon = 1
Case Is = 4
xItem.SmallIcon = 2
Case Else
xItem.SmallIcon = 3
End Select
Me.SrvList.Enabled = True
End If
MousePointer = vbDefault
If CurrentServer <> "" Then
Set xItem = Me.SrvList.FindItem(CurrentServer)
If xItem Is Nothing Then
Exit Sub
Else
xItem.EnsureVisible
xItem.Selected = True
End If
End If
End Sub
Private Sub SrvList_DblClick()
Dim cmpname As String
Dim i As Integer
i = 0
If Me.SrvList.SelectedItem.Tag = "x" Then
Beep
Else
cmpname = Me.SrvList.SelectedItem.Text
If List1.ListCount = 0 Then
List1.AddItem cmpname
Else
Do While i <= List1.ListCount - 1
If cmpname = List1.List(i) Then
q = 1
Exit Do
Else
i = i + 1
End If
Loop
If q = 0 Then
List1.AddItem cmpname
End If
'
End If
End If
q = 0
End Sub
Private Sub ServerList_BeforeLabelEdit(Cancel As Integer)
End Sub
Private Sub SrvType_Click()
Dim x As Integer, xItem As ListItem
Dim ServerList As ListOfServer
MousePointer = vbHourglass
Me.SrvList.ListItems.Clear
Me.SrvList.Enabled = False
If Me.srvtype.ListIndex >= 0 Then
ServerList = EnumServer(Me.srvtype.ItemData(Me.srvtype.ListIndex))
' Text1.Text = x 'Me.SrvType.ListIndex 'UBound(ServerList.List)
If ServerList.Init Then
For x = 1 To UBound(ServerList.List)
Set xItem = Me.SrvList.ListItems.Add(, , ServerList.List(x).ServerName)
' xItem.SubItems(1) = ServerList.List(x).Comment
' xItem.SubItems(2) = ServerList.List(x).Platform
Select Case ServerList.List(x).ServerType
Case Is >= 5
xItem.Tag = "x"
xItem.SmallIcon = 1
Case Is = 4
xItem.SmallIcon = 2
Case Else
xItem.SmallIcon = 3
End Select
Next
End If
End If
s = x
Me.SrvList.Enabled = (Me.SrvList.ListItems.Count > 0)
MousePointer = vbDefault
End Sub
Private Sub LoadSrvType()
Me.srvtype.AddItem "All"
Me.srvtype.ItemData(Me.srvtype.NewIndex) = SRV_TYPE_ALL
Me.srvtype.AddItem "Domain Controller"
Me.srvtype.ItemData(Me.srvtype.NewIndex) = SRV_TYPE_NT_BDC + SRV_TYPE_NT_PDC
Me.srvtype.AddItem "NT Server & WorkStation"
Me.srvtype.ItemData(Me.srvtype.NewIndex) = SRV_TYPE_NT
Me.srvtype.AddItem "Print Server"
Me.srvtype.ItemData(Me.srvtype.NewIndex) = SRV_TYPE_PRINT
Me.srvtype.AddItem "RAS Server"
Me.srvtype.ItemData(Me.srvtype.NewIndex) = SRV_TYPE_RAS
Me.srvtype.AddItem "SQL Server"
Me.srvtype.ItemData(Me.srvtype.NewIndex) = SRV_TYPE_SQLSERVER
End Sub
Private Function SendMsg(sToUser As String, sFromUser As String, sMessage As String) As Boolean
Dim yToName() As Byte
Dim yFromName() As Byte
Dim yMsg() As Byte
Dim l As Long
yToName = sToUser & vbNullChar
yFromName = sFromUser & vbNullChar
yMsg = sMessage & vbNullChar
If NetMessageBufferSend(ByVal 0&, yToName(0), ByVal 0&, yMsg(0), UBound(yMsg)) = NERR_Success Then
SendMsg = True
End If
End Function
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If Shift = vbCtrlMask Then
Select Case KeyCode
'如果是 Ctrl+S 键:
Case vbKeyReturn
Command5_Click
Case vbKeyW
Me.Hide
End Select
End If
End Sub
Private Sub Timer1_Timer()
If MyHotKey(vbKeyEscape) Then Command6_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -