📄 mdlfunction.bas
字号:
Call GetValue(tNodeID, "node_id", p_Node.key)
Call GetValue(tTypeCode, "type_code", p_Node.key)
Call GetValue(tWhere_Str, "where", p_Node.key)
Call GetValue(tTable_Name, "table_name", p_Node.key)
tIndex = CStr(p_Node.Index)
If InStr(tTable_Name, "_") = 0 Then GoTo Err
tTypeCode = Mid(tTable_Name, InStr(tTable_Name, "_") + 1) '设置文档类型
tTable_Name = "FILE" + Mid(tTable_Name, InStr(tTable_Name, "_"))
p_ListCtl.Tag = "LV @T " + tTable_Name + _
" @I " + tNodeID + _
" @W " + tWhere_Str + _
" @NX " + tIndex + _
" @P " + tList_Type
End If
'获取列表配置信息
Set gRst = gDbs.OpenRecordset("select * from LIST_DEFINATION where node_id=" + tNodeID + " and list_type=" + tList_Type + " order by View_Index")
With gRst
If Not .EOF Then
.MoveLast
.MoveFirst
ReDim gCol_System_Dict(.RecordCount) '记录列表中每列在数据库中字段对应的系统字典表的类型
Else
GoTo Err
End If
'添加ColumnHeaders
p_ListCtl.ColumnHeaders.Clear
While Not .EOF
tField_En_Name = Convert_Value(.Fields("field_en_name"), _
0, .Fields("field_en_name").Type, False, False) '字段名称
tSystem_Dict_Type = Convert_Value(.Fields("System_Dict_Type"), _
0, .Fields("System_Dict_Type").Type, False, False) '字段对应的数据库字典类型
tField_Cn_Name = Convert_Value(.Fields("field_cn_name"), _
0, .Fields("field_cn_name").Type, False, False) '字段显示名称
tOrderStr = Convert_Value(.Fields("order_by"), _
0, .Fields("order_by").Type, False, False) 'order_by 应都一样，只取最后一个
If Trim(tField_En_Name) <> "" And Trim(tField_Cn_Name) <> "" Then '加入列表
tSql = tSql + "," + tField_En_Name + " as " + tField_Cn_Name
If p_ListCtl.ColumnHeaders.Count < 1 Then
p_ListCtl.ColumnHeaders.Add , "LC" + Format(p_ListCtl.ColumnHeaders.Count + 1, "00") + tField_En_Name, tField_Cn_Name, , , "ColFile"
Else
p_ListCtl.ColumnHeaders.Add , "LC" + Format(p_ListCtl.ColumnHeaders.Count + 1, "00") + tField_En_Name, tField_Cn_Name
End If
p_ListCtl.ColumnHeaders(p_ListCtl.ColumnHeaders.Count).Tag = CStr(tSystem_Dict_Type)
End If
.MoveNext
Wend
'获取列表结果集
tSql = "select " + RemoveString(tSql, ",", 1) + ",file_id,status,borrow_status,transfer_flag,destruction_flag from " + tTable_Name
If tWhere_Str <> "" Then tSql = tSql + " where " + tWhere_Str
If tOrderStr <> "" Then tSql = tSql + " order by " + tOrderStr
Set tRst = gDbs.OpenRecordset(tSql)
If Not tRst.EOF Then
tRst.MoveLast
tRst.MoveFirst
End If
If tRst.RecordCount > gMax_Convert_Rec Then gConvert_To_Dict = False '结果集过大，不转换数据字典
If Not SBarPanel2 Is Nothing Then SBarPanel1.Text = "记录总数：" + CStr(tRst.RecordCount)
While Not tRst.EOF
tFile_ID = Convert_Value(tRst.Fields("file_id"), _
0, tRst.Fields("file_id").Type, False, False) 'order_by 应都一样，只取最后一个
'文件状态+移交标志+销毁标志+借阅状态
tFileStatus = Convert_Value(tRst.Fields("STATUS"), _
0, tRst.Fields("STATUS").Type, False, False) & _
Convert_Value(tRst.Fields("transfer_flag"), _
0, tRst.Fields("transfer_flag").Type, False, False) & _
Convert_Value(tRst.Fields("destruction_flag"), _
0, tRst.Fields("destruction_flag").Type, False, False) & _
Convert_Value(tRst.Fields("Borrow_STATUS"), _
0, tRst.Fields("Borrow_STATUS").Type, False, False)
tKey = "LItm@I" + tFile_ID + " @S " + tFileStatus + " @P " + tTypeCode
'显示值格式转换
tField_Value = ConvertFieldValue(tRst.Fields(p_ListCtl.ColumnHeaders(1).Text), CInt(p_ListCtl.ColumnHeaders(1).Tag), Mid(p_ListCtl.ColumnHeaders(1).key, 5), 0)
'添加第一列
Set tListItem = p_ListCtl.ListItems.Add(, tKey, tField_Value, "File", "File")
'添加其余列
For i = 2 To p_ListCtl.ColumnHeaders.Count
tListItem.SubItems(i - 1) = ConvertFieldValue(tRst.Fields(p_ListCtl.ColumnHeaders(i).Text), CInt(p_ListCtl.ColumnHeaders(i).Tag), Mid(p_ListCtl.ColumnHeaders(i).key, 5), 0)
Next i
tRst.MoveNext
If Not SBarPanel2 Is Nothing Then SBarPanel2.Text = "进度：" + Format(tRst.AbsolutePosition / tRst.RecordCount, "00.00%")
Wend
If Not SBarPanel2 Is Nothing Then SBarPanel2.Text = "进度：完成"
gConvert_To_Dict = True
End With
List_View_File = True
Exit Function
Err:
List_View_File = False
End Function
'#########################################################################
'显示文件列表
'参数：p_Node 选中的目录树节点 显示列表的控件
'返回：boolean 返回的值
'#########################################################################
Public Function List_View_File2(p_Volume_List As ListView, p_ListCtl As ListView, p_Node As Node, SBarPanel1 As Panel, SBarPanel2 As Panel) As Boolean
On Error GoTo Err
Dim tSql As String '临时字串
Dim tListItem As ListItem '临时对象
Dim i As Integer '临时变量
Dim tRst '临时结果
Dim tNodeInfo As NodeInfo '节点对象
Dim tSystem_Dict_Type As Integer '数据字典类型
Dim tField_En_Name As String '节点显示的数据库字段名
Dim tField_Cn_Name As String '节点显示的数据库字段名
Dim tOrderStr As String 'Order字串
Dim tVolume_ID As String '案卷序列号
Dim tVolume_Status As String '案卷状态
Dim tKey As String '节点的Key
Dim tField_Value As String '节点字段在数据库中的值
Dim tTypeCode As String '文档类型
Dim tNodeID As String '节点ID
Dim tWhere_Str As String 'where子句
Dim tTable_Name As String '表名
Dim tFile_ID As String '文件ID
Dim tFileStatus As String '文件状态
Dim tList_Type As String '显示列表类型
Dim tIndex As String '节点或项目的Index
'清除已有数据
'p_ListCtl.ColumnHeaders.Clear
p_ListCtl.ListItems.Clear
p_ListCtl.Tag = ""
If p_Volume_List Is Nothing And p_Node Is Nothing Then GoTo Err
If Not (p_Volume_List Is Nothing) Then '选取某个卷下的文件,由单击卷列表触发
tList_Type = "1" '选取某个卷下的文件,由单击卷列表触发 对应目录树列表
If p_Volume_List.SelectedItem Is Nothing Then GoTo Err
tIndex = CStr(p_Volume_List.SelectedItem.Index)
'记录列表信息
'设置变量
Call GetValue(tVolume_ID, "Volume_id", p_Volume_List.SelectedItem.key)
Call GetValue(tTypeCode, "type_code", p_Volume_List.SelectedItem.key)
Call GetValue(tNodeID, "node_id", p_Volume_List.Tag)
'文件列表控件
p_ListCtl.Tag = p_Volume_List.Tag + _
" @VX " + tIndex + " @P " + tList_Type
'Call GetValue(tNodeID, "node_id", p_ListCtl.Tag)
tWhere_Str = "volume_id=" + tVolume_ID
tTable_Name = "FILE_" + tTypeCode
ElseIf Not (p_Node Is Nothing) Then
tList_Type = "2" '选取符合节点条件的文件，由单击节点触发 对应目录树列表
If p_Node Is Nothing Then GoTo Err
'设置变量
Call GetValue(tNodeID, "node_id", p_Node.key)
Call GetValue(tTypeCode, "type_code", p_Node.key)
Call GetValue(tWhere_Str, "where", p_Node.key)
Call GetValue(tTable_Name, "table_name", p_Node.key)
tIndex = CStr(p_Node.Index)
If InStr(tTable_Name, "_") = 0 Then GoTo Err
tTypeCode = Mid(tTable_Name, InStr(tTable_Name, "_") + 1) '设置文档类型
tTable_Name = "FILE" + Mid(tTable_Name, InStr(tTable_Name, "_"))
p_ListCtl.Tag = "LV @T " + tTable_Name + _
" @I " + tNodeID + _
" @W " + tWhere_Str + _
" @NX " + tIndex + _
" @P " + tList_Type
End If
'获取列表配置信息
Set gRst = gDbs.OpenRecordset("select * from fixed_field_table where flag=1 and view_flag=1 order by View_Index")
With gRst
If Not .EOF Then
.MoveLast
.MoveFirst
ReDim gCol_System_Dict(.RecordCount) '记录列表中每列在数据库中字段对应的系统字典表的类型
Else
GoTo Err
End If
'添加ColumnHeaders
p_ListCtl.ColumnHeaders.Clear
While Not .EOF
tField_En_Name = Convert_Value(.Fields("field_name"), _
0, .Fields("field_name").Type, False, False) '字段名称
tSystem_Dict_Type = Convert_Value(.Fields("System_Dict_Type"), _
0, .Fields("System_Dict_Type").Type, False, False) '字段对应的数据库字典类型
tField_Cn_Name = Convert_Value(.Fields("display_name"), _
0, .Fields("display_name").Type, False, False) '字段显示名称
tOrderStr = "" 'order_by 应都一样，只取最后一个
If Trim(tField_En_Name) <> "" And Trim(tField_Cn_Name) <> "" Then '加入列表
tSql = tSql + "," + tField_En_Name + " as " + tField_Cn_Name
If p_ListCtl.ColumnHeaders.Count < 1 Then
p_ListCtl.ColumnHeaders.Add , "LC" + Format(p_ListCtl.ColumnHeaders.Count + 1, "00") + tField_En_Name, tField_Cn_Name, , , "ColFile"
Else
p_ListCtl.ColumnHeaders.Add , "LC" + Format(p_ListCtl.ColumnHeaders.Count + 1, "00") + tField_En_Name, tField_Cn_Name
End If
p_ListCtl.ColumnHeaders(p_ListCtl.ColumnHeaders.Count).Tag = CStr(tSystem_Dict_Type)
End If
.MoveNext
Wend
'获取列表结果集
tSql = "select " + RemoveString(tSql, ",", 1) + ",file_id,status,borrow_status,transfer_flag,destruction_flag from " + tTable_Name
If tWhere_Str <> "" Then tSql = tSql + " where " + tWhere_Str
If tOrderStr <> "" Then tSql = tSql + " order by " + tOrderStr
Set tRst = gDbs.OpenRecordset(tSql)
If Not tRst.EOF Then
tRst.MoveLast
tRst.MoveFirst
End If
If tRst.RecordCount > gMax_Convert_Rec Then gConvert_To_Dict = False '结果集过大，不转换数据字典
If Not SBarPanel2 Is Nothing Then SBarPanel1.Text = "记录总数：" + CStr(tRst.RecordCount)
While Not tRst.EOF
tFile_ID = Convert_Value(tRst.Fields("file_id"), _
0, tRst.Fields("file_id").Type, False, False) 'order_by 应都一样，只取最后一个
'文件状态+移交标志+销毁标志+借阅状态
tFileStatus = Convert_Value(tRst.Fields("STATUS"), _
0, tRst.Fields("STATUS").Type, False, False) & _
Convert_Value(tRst.Fields("transfer_flag"), _
0, tRst.Fields("transfer_flag").Type, False, False) & _
Convert_Value(tRst.Fields("destruction_flag"), _
0, tRst.Fields("destruction_flag").Type, False, False) & _
Convert_Value(tRst.Fields("Borrow_STATUS"), _
0, tRst.Fields("Borrow_STATUS").Type, False, False)
tKey = "LItm@I" + tFile_ID + " @S " + tFileStatus + " @P " + tTypeCode
'显示值格式转换
tField_Value = ConvertFieldValue(tRst.Fields(p_ListCtl.ColumnHeaders(1).Text), CInt(p_ListCtl.ColumnHeaders(1).Tag), Mid(p_ListCtl.ColumnHeaders(1).key, 5), 0)
'添加第一列
Set tListItem = p_ListCtl.ListItems.Add(, tKey, tField_Value, "File", "File")
'添加其余列
For i = 2 To p_ListCtl.ColumnHeaders.Count
tListItem.SubItems(i - 1) = ConvertFieldValue(tRst.Fields(p_ListCtl.ColumnHeaders(i).Text), CInt(p_ListCtl.ColumnHeaders(i).Tag), Mid(p_ListCtl.ColumnHeaders(i).key, 5), 0)
Next i
tRst.MoveNext
If Not SBarPanel2 Is Nothing Then SBarPanel2.Text = "进度：" + Format(tRst.AbsolutePosition / tRst.RecordCount, "00.00%")
Wend
If Not SBarPanel2 Is Nothing Then SBarPanel2.Text = "进度：完成"
gConvert_To_Dict = True
End With
List_View_File2 = True
Exit Function
Err:
List_View_File2 = False
End Function
'###################################################################################
'获取光盘驱动器 rCDPath返回路径
'###################################################################################
Public Function GetCDDrive(rCDPath As String) As Boolean
Dim nDriver As Integer
Dim fs As FileSystemObject
Dim d As Drive
Dim IsPath As Boolean
On Error GoTo Err
IsPath = False
Set fs = CreateObject("Scripting.FileSystemObject")
For nDriver = Asc("a") To Asc("z") Step 1
If (fs.DriveExists(Chr(nDriver))) Then
Set d = fs.GetDrive(Chr(nDriver))
If d.DriveType = 4 Then
If (d.IsReady) Then
IsPath = True
rCDPath = d.DriveLetter + ":"
Exit For
End If
End If
End If
Next nDriver
If (Not IsPath) Then
MsgBox "光盘驱动器未就绪，请检查!", vbOKOnly, "操作提示"
GoTo Err
End If
If Dir(rCDPath + "\data\diskdb.mdb") = "" Then
MsgBox "当前的光盘不是系统可用光盘，请检查", vbOKOnly, "操作提示"
GoTo Err
End If
GetCDDrive = True
Exit Function
Err:
GetCDDrive = False
End Function
'###################################################################################
'文件子注册 未使用 pfiletype 文件类型如txt pexefilepath刻执行文件全路经
'###################################################################################
Public Sub FileRegister(pFileType As String, pExeFilePath As String)
On Error GoTo Err
Dim Reg_Result As Long
Dim Reg_Size As Long
Dim Rtn
gErrDescription = ""
Reg_Result = RegSetValue(HKEY_CLASSES_ROOT, "." + pFileType, 1, pFileType + "file", Reg_Size)
Reg_Result = RegSetValue(HKEY_CLASSES_ROOT, pFileType + "file" + "\shell\open\command", 1, pExeFilePath, Reg_Size)
Err:
End Sub
'###################################################################################
'判断控件是否存在，主要针对控件数组
'###################################################################################
Public Function IsControl(p_Control As Control) As Boolean
On Error GoTo Err
Dim t As String
t = p_Control.Tag
IsControl = True
Exit Function
Err:
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -