📄 form_detail.frm
字号:
VERSION 5.00
Begin VB.Form Form_Detail
Caption = "详细信息"
ClientHeight = 4050
ClientLeft = 3750
ClientTop = 3225
ClientWidth = 4425
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4050
ScaleWidth = 4425
WhatsThisHelp = -1 'True
Begin VB.CommandButton Com_Cancel
Caption = "取消"
Height = 375
Left = 2280
TabIndex = 6
Top = 3000
Width = 1095
End
Begin VB.CommandButton Com_Ok
Caption = "确定"
Height = 375
Left = 960
TabIndex = 5
Top = 3000
Width = 975
End
Begin VB.TextBox Text_Des
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 480
Left = 1440
MaxLength = 20
TabIndex = 4
Top = 2280
Width = 2535
End
Begin VB.TextBox Text_Name
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 480
Left = 1440
MaxLength = 50
TabIndex = 3
Top = 1560
Width = 2535
End
Begin VB.ComboBox Combo_Type
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 420
Left = 1440
TabIndex = 1
Top = 360
Width = 2535
End
Begin VB.TextBox Text_Code
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 480
Left = 1440
MaxLength = 50
TabIndex = 2
Top = 960
Width = 2535
End
Begin VB.Label Label1
Caption = "类型"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 255
Index = 3
Left = 600
TabIndex = 9
Top = 480
Width = 495
End
Begin VB.Label Label1
Caption = "备注"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 255
Index = 2
Left = 600
TabIndex = 8
Top = 2400
Width = 495
End
Begin VB.Label Label1
Caption = "说明"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 255
Index = 1
Left = 600
TabIndex = 7
Top = 1680
Width = 495
End
Begin VB.Label Label1
Caption = "编码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 255
Index = 0
Left = 600
TabIndex = 0
Top = 1080
Width = 495
End
End
Attribute VB_Name = "Form_Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Com_Cancel_Click()
Form_Manage.Show
Unload Me
End Sub
Private Sub Com_OK_Click()
Dim objRs As New ADODB.Recordset
Dim strPath As String '节点路径
Dim mnode As Node '节点
Dim mKey As String '节点key值
Dim strExtend As String '文件扩展名
Dim strFormat As String '文件模板文件名
strExtend = ""
On Error GoTo Err
If Len(Trim(Text_Code.Text)) = 0 Then
MsgBox ("请输入编码")
Text_Code.SetFocus
Exit Sub
End If
'提取当前新建文件或文件夹路径
Set mnode = Form_Manage.Tree_Main.SelectedItem
If CModule.GetNodePath(mnode, strPath) = False Then
Err.Raise 91
Err.Description = strPath
End If
'连接数据库
If Not CModule.IsConnect Then
Err.Raise 90
End If
'在数据表中添加记录
objRs.Open "zdk", CModule.objCon, , adLockOptimistic, adCmdTable
objRs.AddNew
objRs("zdname") = Trim(Text_Name.Text)
mKey = Form_Manage.Tree_Main.SelectedItem.Key '取出父节点Key值 如：F1F1C1Node
mKey = Left(Trim(mKey), Len(Trim(mKey)) - 4) 'mKey=F1F1C1
objRs("zdtype") = mKey
objRs("zdIndex") = Form_Manage.Tree_Main.SelectedItem.Children + 1 '子节点序号
objRs("zdbz") = Trim(Text_Des.Text)
objRs("zdDes") = Trim(Combo_Type.Text)
If Trim(Combo_Type.Text) = "节点" Then
objRs("ftype") = "Direc"
MkDir strPath & Trim(Text_Code.Text) '建立节点
Else
If CModule.GetExe(Trim(Combo_Type.Text), strExtend, strFormat) = False Then
Err.Raise 92
End If
objRs("ftype") = strExtend
strPath = strPath & Trim(Text_Code.Text) & strExtend
FileCopy strFormat, strPath '将格式文件拷贝到当前目录下
objRs("zdPath") = strPath
End If
objRs("zdcode") = Trim(Text_Code.Text) & strExtend '将文件编码后加文件扩展名
objRs.Update
'将树形框清除
Form_Manage.Tree_Main.Nodes.Clear
'从新添加树形框
Call Form_Manage.NodeAdd
Form_Manage.Show
Unload Me
CModule.CloseRs objRs
Exit Sub
Err:
Select Case Err.Number
Case 90
MsgBox ("数据库连接失败,错误位置：Com_Ok_Click()")
Case 92
objRs.CancelUpdate
MsgBox ("类型错误，请检查节点类型,错误位置：Com_Ok_Click()")
Case 91
objRs.CancelUpdate
MsgBox Err.Description
Case Else
objRs.CancelUpdate
MsgBox ("系统错误，错误描述：" & Err.Description & "错误位置：Com_Ok_Click()")
End Select
CModule.CloseRs objRs
Form_Manage.Show
Unload Me
End Sub
Private Sub Form_Load()
Dim objRs As New ADODB.Recordset
Dim strSql As String
'数据库连接
If CModule.IsConnect() = False Then
MsgBox "数据库连接失败"
Exit Sub
End If
strSql = "select * from SysExe"
objRs.Open strSql, CModule.objCon, adOpenStatic, adLockOptimistic, adCmdText
If objRs.EOF Then
MsgBox "请首先设置可执行文件"
Exit Sub
End If
While Not objRs.EOF
Combo_Type.AddItem (objRs("ExeDes"))
Combo_Type.Text = objRs("ExeDes")
objRs.MoveNext
Wend
CModule.CloseRs objRs
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -