📄 frmaddress.frm
字号:
VERSION 5.00
Begin VB.Form frmAddress
BorderStyle = 3 'Fixed Dialog
Caption = "地址簿"
ClientHeight = 3708
ClientLeft = 2952
ClientTop = 2628
ClientWidth = 5280
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3708
ScaleWidth = 5280
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Caption = "站点描述"
Height = 1560
Left = 36
TabIndex = 5
Top = 2088
Width = 5160
Begin VB.TextBox txtSite
Height = 360
Left = 3708
TabIndex = 13
Top = 792
Width = 1272
End
Begin VB.TextBox txtAuto
Height = 336
Left = 900
TabIndex = 11
Text = "\n"
Top = 792
Width = 2028
End
Begin VB.TextBox txtPort
Height = 324
Left = 3600
TabIndex = 9
Text = "23"
Top = 252
Width = 1416
End
Begin VB.TextBox txtAdd
Height = 300
Left = 612
TabIndex = 7
Top = 252
Width = 2136
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "\n表示回车"
Height = 192
Left = 108
TabIndex = 14
Top = 1224
Width = 732
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "站点名"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3024
TabIndex = 12
Top = 828
Width = 576
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "自动登录"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 72
TabIndex = 10
Top = 828
Width = 768
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "端口"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3132
TabIndex = 8
Top = 288
Width = 384
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "地址"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 108
TabIndex = 6
Top = 288
Width = 384
End
End
Begin VB.CommandButton cmdExit
Caption = "取消"
Height = 372
Left = 3780
TabIndex = 4
Top = 1692
Width = 1452
End
Begin VB.CommandButton cmdAdd
Caption = "加入站点"
Height = 372
Left = 3780
TabIndex = 3
Top = 636
Width = 1452
End
Begin VB.CommandButton cmdDel
Caption = "删除站点"
Height = 372
Left = 3816
TabIndex = 2
Top = 1164
Width = 1452
End
Begin VB.CommandButton cmdConnect
Caption = "连接站点"
Height = 372
Left = 3780
TabIndex = 1
Top = 108
Width = 1452
End
Begin VB.ListBox ListAdd
Columns = 2
Height = 1968
ItemData = "frmAddress.frx":0000
Left = 36
List = "frmAddress.frx":0002
TabIndex = 0
Top = 108
Width = 3612
End
End
Attribute VB_Name = "frmAddress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim SiteInfo(100, 3) As String
Dim SiteNum As Integer
Dim IP As String, Port As Integer, mvarAction As Command
Dim LoginString As String
Public Enum Command
comdOK
comdCancel
End Enum
Public Property Let Action(ByVal vData As Command)
mvarAction = vData
End Property
Public Property Get Action() As Command
Action = mvarAction
End Property
Public Property Get IPAddress() As String
IPAddress = IP
End Property
Public Property Get PortNum() As Integer
PortNum = Port
End Property
Public Property Let IPAddress(ByVal tempIP As String)
IP = tempIP
End Property
Public Property Let PortNum(ByVal tempPort As Integer)
Port = tempPort
End Property
Public Property Get LoginStr()
LoginStr = LoginString
End Property
Private Sub cmdAdd_Click()
Dim FileNum As Integer
Dim I As Integer
Dim Founded, Changed As Boolean
If CheckTxt Then
'查找新增加的站点以前是否加入过
For I = 0 To SiteNum - 1
If SiteInfo(I, 0) = Trim(txtSite.Text) Then
Founded = True
If SiteInfo(I, 1) <> Trim(txtAdd.Text) Or SiteInfo(I, 3) <> txtAuto.Text Or SiteInfo(I, 2) <> Trim(txtPort.Text) Then
Changed = True
SiteInfo(I, 1) = Trim(txtAdd.Text)
SiteInfo(I, 2) = Trim(txtPort.Text)
SiteInfo(I, 3) = txtAuto.Text
ListAdd.ListIndex = I
End If
Exit For
End If
Next I
If Not Founded Then
ListAdd.AddItem Trim(txtSite.Text)
SiteInfo(SiteNum, 0) = txtSite.Text
SiteInfo(SiteNum, 1) = txtAdd.Text
SiteInfo(SiteNum, 2) = txtPort.Text
SiteInfo(SiteNum, 3) = txtAuto.Text
ListAdd.ListIndex = SiteNum
SiteNum = SiteNum + 1
'获得一个没有被占用的文件号
FileNum = FreeFile
'以增加的模式打开文件
Open App.Path & "\address.txt" For Append As FileNum
'写入一个站点的信息
Print #FileNum, Trim(txtSite.Text) & "--" & Trim(txtAdd.Text) & "--" & Trim(txtPort.Text) & "--" & txtAuto.Text
'关闭文件
Close #FileNum
ElseIf Founded And Changed Then
'获得一个没有被占用的文件号
FileNum = FreeFile
'以output的模式打开文件
Open App.Path & "\address.txt" For Output As FileNum
For I = 0 To ListAdd.ListCount - 1
'循环写入每个站点的信息
Print #FileNum, SiteInfo(I, 0) & "--" & SiteInfo(I, 1) & "--" & SiteInfo(I, 2) & "--" & SiteInfo(I, 3)
Next I
'关闭文件
Close #FileNum
End If
End If
End Sub
Private Sub cmdConnect_Click()
IP = Trim(txtAdd.Text)
Port = CInt(txtPort.Text)
LoginString = Trim(txtAuto.Text)
mvarAction = comdOK
Unload Me
End Sub
Private Sub cmdDel_Click()
Call DelSite
'将站点数减少一
SiteNum = SiteNum - 1
'删除列表框中的项
ListAdd.RemoveItem (ListAdd.ListIndex)
'删除后回到的一项
If ListAdd.ListCount > 0 Then
ListAdd.ListIndex = 0
SetTxt (0)
Else
ClearTxt
End If
End Sub
Private Sub cmdExit_Click()
mvarAction = comdCancel
Unload Me
End Sub
Private Sub Form_Load()
Dim FileNum As Integer
Dim Address, tempPort, SiteDesc, AutoLogin, TempStr As String
SiteNum = 0
'获得一个文件号
FileNum = FreeFile
'打开一个文本文件
If Dir(App.Path & "\address.txt") <> "" Then
Open App.Path & "\address.txt" For Input As FileNum
'循环读取地址该文件中的所有数据
Do While Not EOF(FileNum)
Line Input #FileNum, TempStr
GetValue (TempStr)
Loop
Close #FileNum
End If
End Sub
Private Sub ListAdd_Click()
SetTxt (ListAdd.ListIndex)
End Sub
Private Sub ClearTxt()
txtSite.Text = ""
txtAdd.Text = ""
txtAuto.Text = ""
txtPort.Text = ""
End Sub
Private Sub SetTxt(Index As Integer)
txtSite.Text = SiteInfo(Index, 0)
txtAdd.Text = SiteInfo(Index, 1)
txtPort.Text = SiteInfo(Index, 2)
txtAuto.Text = SiteInfo(Index, 3)
End Sub
Private Sub DelSite()
Dim I, FileNum As Integer
FileNum = FreeFile
Open App.Path & "\address.txt" For Output As FileNum
For I = 0 To SiteNum - 1
If I <> ListAdd.ListIndex Then
Print #FileNum, SiteInfo(I, 0) & "--" & SiteInfo(I, 1) & "--" & SiteInfo(I, 2) & "--" & SiteInfo(I, 3)
End If
If I > ListAdd.ListIndex Then
ChangeValue (ListAdd.ListIndex)
End If
Next I
Close #FileNum
End Sub
Private Sub ChangeValue(I As Integer)
SiteInfo(I, 0) = SiteInfo(I + 1, 0)
SiteInfo(I, 1) = SiteInfo(I + 1, 1)
SiteInfo(I, 2) = SiteInfo(I + 1, 2)
SiteInfo(I, 3) = SiteInfo(I + 1, 3)
End Sub
Private Sub GetValue(TempStr As String)
Dim info As Variant
If Trim(TempStr) <> "" Then
info = Split(TempStr, "--", , vbTextCompare)
SiteInfo(SiteNum, 0) = info(0)
SiteInfo(SiteNum, 1) = info(1)
SiteInfo(SiteNum, 2) = info(2)
SiteInfo(SiteNum, 3) = info(3)
ListAdd.AddItem info(0)
SiteNum = SiteNum + 1
End If
End Sub
Private Function CheckTxt() As Boolean
If Trim(txtAdd.Text) = "" Then
MsgBox "请输入服务器地址！"
txtAdd.SetFocus
CheckTxt = False
Exit Function
End If
If Trim(txtPort.Text) = "" Then
MsgBox "请输入端口号，默认为23！"
txtPort.SetFocus
CheckTxt = False
Exit Function
End If
If Trim(txtSite.Text) = "" Then
MsgBox "请输入站点描述！"
txtSite.SetFocus
CheckTxt = False
Exit Function
End If
If Trim(txtAuto.Text) = "" Then
txtAuto.Text = " "
End If
CheckTxt = True
End Function
Private Sub ListAdd_DblClick()
Call cmdConnect_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -