📄 frmdatasourceset.frm
字号:
VERSION 5.00
Begin VB.Form frmDataSourceSet
BorderStyle = 1 'Fixed Single
Caption = "服务器配置窗口 "
ClientHeight = 1875
ClientLeft = 45
ClientTop = 330
ClientWidth = 4905
Icon = "frmDataSourceSet.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1875
ScaleWidth = 4905
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmd_ok
Caption = "确 定(&O)"
Height = 330
Left = 3600
TabIndex = 10
Top = 120
Width = 1215
End
Begin VB.CommandButton cmd_close
Caption = "关闭窗口"
Height = 330
Left = 3600
TabIndex = 6
Top = 1440
Width = 1215
End
Begin VB.CommandButton cmd_save
Caption = "保存设置"
Height = 330
Left = 3600
TabIndex = 5
Top = 1020
Width = 1215
End
Begin VB.CommandButton cmd_read
Caption = "读取配置"
Height = 330
Left = 3600
TabIndex = 3
Top = 600
Width = 1215
End
Begin VB.Frame Frame1
Height = 1815
Left = 120
TabIndex = 0
Top = 0
Width = 3375
Begin VB.TextBox text_filename
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
TabIndex = 9
Top = 1320
Width = 2175
End
Begin VB.TextBox text_dir
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
TabIndex = 7
Top = 780
Width = 2175
End
Begin VB.TextBox text_host
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1080
TabIndex = 2
Top = 240
Width = 2175
End
Begin VB.Label lab_filename
AutoSize = -1 'True
Caption = "库文件"
BeginProperty Font
Name = "Tahoma"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 8
Top = 1440
Width = 630
End
Begin VB.Label lab_workdir
AutoSize = -1 'True
Caption = "工作目录"
BeginProperty Font
Name = "Tahoma"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 4
Top = 900
Width = 840
End
Begin VB.Label lab_host
AutoSize = -1 'True
Caption = "主机名称"
BeginProperty Font
Name = "Times New Roman"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 1
Top = 360
Width = 840
End
End
End
Attribute VB_Name = "frmDataSourceSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
Function check_status_ip() As Boolean
On Error GoTo hander
If text_host.Text = "" Or text_dir.Text = "" Or text_filename.Text = "" Then
MsgBox "输入不合法!", vbCritical
check_status_ip = False
Exit Function
Else
If FileExists("\\" & Trim(text_host.Text) & "\" & Trim(text_dir.Text) & "\" & Trim(text_filename.Text)) Then
check_status_ip = True
Else
MsgBox "你无权访问 " & Trim(text_host.Text) & "\" & Trim(text_dir.Text) & "\" & Trim(text_filename.Text), vbCritical
check_status_ip = False
End If
End If
Exit Function
hander:
Select Case Err.Number
Case 52:
MsgBox "文件没找到!", vbInformation
Screen.MousePointer = 0
check_status_ip = False
Exit Function
Case 53:
MsgBox "文件没找到!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 54:
MsgBox "文件模式错误!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 55:
MsgBox "文件已打开!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 61:
MsgBox "磁盘已满!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 62:
MsgBox "文件太大!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 63:
MsgBox "文件记录号错误!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 68:
MsgBox "设备不可用!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 70:
MsgBox "对不起,无权访问!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 71:
MsgBox "磁盘没准备好!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 75:
MsgBox "文件路径不对或文件错误!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
Case 76:
MsgBox "路径没找到!", vbInformation
check_status_ip = False
Screen.MousePointer = 0
Exit Function
End Select
End Function
Private Sub cmd_close_Click()
check_ok_data = False
Unload Me
End Sub
Private Sub cmd_ok_Click()
If MsgBox("真的要改变吗?(Y/N)", vbQuestion + vbYesNo) = vbYes Then
If check_status_ip = True Then
SaveSetting "myappname", "mysection", "hostname", Trim(text_host.Text)
SaveSetting "myappname", "mysection", "hostdir", Trim(text_dir.Text)
SaveSetting "myappname", "mysection", "filename", Trim(text_filename.Text)
check_ok_data = True
Unload Me
End If
Else
MsgBox "你已取消了操作!", vbInformation
End If
End Sub
Private Sub cmd_read_Click()
Dim myhostname As String
Dim mydir As String
Dim myfilename As String
cmd_dialog.CancelError = False
cmd_dialog.Filter = "*.ini|*.ini"
cmd_dialog.DialogTitle = "打开配置文件"
cmd_dialog.ShowOpen
On Error GoTo hander
If cmd_dialog.Filename <> "" Then
Open cmd_dialog.Filename For Input As #1
Line Input #1, myhostname
Line Input #1, mydir
Line Input #1, myfilename
If Trim(myhostname) = "" Or Trim(mydir) = "" Or Trim(myfilename) = "" Then
Exit Sub
Else
If Left(myhostname, 8) = "hostname" And Left(mydir, 7) = "hostdir" And Left(myfilename, 8) = "filename" Then
text_host.Text = Mid(myhostname, 10)
text_dir.Text = Mid(mydir, 9)
text_filename.Text = Mid(myfilename, 10)
MsgBox "读取配置文件正确！", vbInformation
Else
MsgBox "读取配置文件出错!", vbCritical
Exit Sub
End If
End If
Close #1
End If
Exit Sub
hander:
Select Case Err.Number
Case 52:
MsgBox "磁盘没插好!", vbInformation
Screen.MousePointer = 0
Close #1
Exit Sub
Case 53:
MsgBox "文件没找到!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 54:
MsgBox "文件模式错误!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 55:
MsgBox "文件已打开!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 61:
MsgBox "磁盘已满!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 62:
MsgBox "文件太大!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 63:
MsgBox "文件记录号错误!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 68:
MsgBox "设备不可用!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 70:
MsgBox "对不起,无权访问!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 71:
MsgBox "磁盘没准备好!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 75:
MsgBox "文件路径不对或文件错误!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
Case 76:
MsgBox "路径没找到!", vbInformation
Close #1
Screen.MousePointer = 0
Exit Sub
End Select
End Sub
Private Sub cmd_save_Click()
cmd_dialog.CancelError = False
If check_status_ip = True Then
cmd_dialog.DialogTitle = "保存配置文件"
cmd_dialog.Filter = "*.ini|*.ini"
cmd_dialog.ShowSave
If cmd_dialog.Filename <> "" Then
Open cmd_dialog.Filename For Output As #1
Print #1, "hostname:" & Trim(text_host.Text)
Print #1, "hostdir:" & Trim(text_dir.Text)
Print #1, "filename:" & Trim(text_filename.Text)
Close #1
MsgBox "保存设置正确!", vbInformation
End If
End If
End Sub
Private Sub Form_Load()
Me.ZOrder (0)
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 600
text_host.Text = GetSetting("myappname", "mysection", "hostname")
text_dir.Text = GetSetting("myappname", "mysection", "hostdir")
text_filename.Text = GetSetting("myappname", "mysection", "filename")
End Sub
Private Sub text_dir_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
text_filename.SetFocus
End If
End Sub
Private Sub text_filename_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmd_ok.SetFocus
End If
End Sub
Private Sub text_host_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
text_dir.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -