frmmain.frm

一个把自己的东西刻成光盘后自动查询和启动的原代码

Call GetValue(tParent_Where, "Where", p_Node.key)

'读取节点信息
Set gRst = gDbs.OpenRecordset("select * from TREE_DEFINATION where Parent_Node_ID=" + tNodeID + " order by Node_Level_Index ")

If gRst.EOF Then GoTo Err

While Not gRst.EOF
   
   '设定节点参数，convert_value用来去除Null值
   tTable_Name = Convert_Value(gRst.Fields("Table_Name"), _
                 0, gRst.Fields("Table_Name").Type, False, False) '表名称
   tNodeID = Convert_Value(ConvertNull(gRst.Fields("Node_ID")), _
                 0, gRst.Fields("Node_ID").Type, False, False) '节点ID号
   tWhere = Convert_Value(gRst.Fields("where_string"), _
                 0, gRst.Fields("where_string").Type, False, False) 'Where子句
   tField_Name = Convert_Value(gRst.Fields("field_en_name"), _
                 0, gRst.Fields("field_en_name").Type, False, False) '字段名
   tSystem_Dict_Type = Convert_Value(gRst.Fields("System_Dict_Type"), _
                 0, gRst.Fields("System_Dict_Type").Type, False, False) '字段对应的数据库字典类型
   tView_List = Convert_Value(gRst.Fields("View_List"), _
                 0, gRst.Fields("View_List").Type, False, False) '显示列表类型
                
   '添加子节点
   If gRst.Fields("node_type") = 0 Then '无条件，仅显示
      'by panwei
      Call AddWhereStr(tWhere, tParent_Where)
      tKey = "N@T " + tTable_Name + "@F @I " + tNodeID + "@O @W " + _
             Replace(tWhere, gReplaceChar, "'") + "@V @L " + tView_List
      TVMain.Nodes.Add p_Node.Index, tvwChild, tKey, Trim(gRst.Fields("field_cn_name")), "Main", "Selected"
   
   ElseIf gRst.Fields("node_type") = 1 Then '特殊条件
      
      '设定查询子句
      tStr = "select " + tField_Name + "  from " + tTable_Name
      Call AddWhereStr(tWhere, tParent_Where)
      If tWhere <> "" Then tStr = tStr + " where " + Replace(tWhere, gReplaceChar, "'")
      tStr = tStr + " order by " + tField_Name + " "
      
      '选取结果集
      Set tRst = gDbs.OpenRecordset(Replace(tStr, gReplaceChar, "'"))
      
      If Not tRst.EOF Then
         tKey = "N@T" + Trim(tTable_Name) + _
                " @F " + Trim(tField_Name) + _
                " @I " + tNodeID + _
                " @O " + tField_Name + _
                " @W " + Replace(tWhere, gReplaceChar, "'") + _
                " @V " + Trim(ConvertNull(gRst.Fields("Field_Value"))) + _
                " @L " + tView_List
         TVMain.Nodes.Add p_Node.Index, tvwChild, tKey, Trim(gRst.Fields("field_cn_name")), "Main", "Selected"
      End If
      
   ElseIf gRst.Fields("node_type") = 2 Then 'group by
      
      '设定查询子句
      tStr = "select distinct " + tField_Name + "  from " + tTable_Name
      Call AddWhereStr(tWhere, tParent_Where)
      If tWhere <> "" Then tStr = tStr + " where " + Replace(tWhere, gReplaceChar, "'")
      tStr = tStr + " order by " + tField_Name + " "
      
      '选取结果集
      Set tRst = gDbs.OpenRecordset(Replace(tStr, gReplaceChar, "'"))
      tTempStr = tWhere
      If Not tRst.EOF Then
         tRst.MoveLast
         tRst.MoveFirst
      End If
     
      If tRst.RecordCount > gMax_Convert_Rec Then gConvert_To_Dict = False '结果集过大，不转换数据字典
      While Not tRst.EOF
         
         '将显示的字段值转换成在查询语句中等号后的字串
         tField_Value = Convert_Value(tRst(0), 0, tRst(0).Type, True, True)
         tWhere = tTempStr
         
         '添加到节点Key中@W中
         If UCase(tField_Value) = "NULL" Then
            Call AddWhereStr(tWhere, tField_Name + " is NULL")
         Else
            Call AddWhereStr(tWhere, tField_Name + "=" + tField_Value)
         End If
         tKey = "N@T " + Trim(tTable_Name) + _
                " @F " + Trim(tField_Name) + _
                " @I " + tNodeID + _
                " @O " + tField_Name + _
                " @W " + Replace(tWhere, gReplaceChar, "'") + _
                " @V " + Trim(CStr(tRst.Fields(0))) + _
                " @L " + tView_List
         
         TVMain.Nodes.Add p_Node.Index, tvwChild, tKey, ConvertFieldValue(tRst.Fields(0), tSystem_Dict_Type, tField_Name, 0), "Main", "Selected" '?需做数据转换
         tRst.MoveNext
      
      Wend
      gConvert_To_Dict = True
   End If
   
   gRst.MoveNext

Wend

'展开节点
p_Node.Expanded = pExpand_Node
RfshNode = True
Exit Function
Err:
   RfshNode = False
End Function

'###################################################################################
'清除界面
'###################################################################################
Public Sub ClearAll()
TVMain.Nodes.Clear
Call ClearList
End Sub

'###################################################################################
'清除子节点 p_Node 为父节点
'###################################################################################
Public Function ClearNode(p_Node As Node) As Boolean
On Error GoTo Err
Dim tNode As Node
If p_Node Is Nothing Then GoTo Err
Set tNode = p_Node.Child
While Not (tNode Is Nothing)
   TVMain.Nodes.Remove tNode.Index
   Set tNode = p_Node.Child
Wend
ClearNode = True

Exit Function
Err:
   ClearNode = False
End Function

'#########################################################################
'显示案卷列表
'参数：p_Node 选中的目录树节点 显示列表的控件
'返回：boolean 返回的值
'#########################################################################
Public Function List_View_Volume(p_Node As Node, p_ListCtl As ListView) As Boolean
On Error GoTo Err
Dim tSql As String '临时字串
Dim tNodeInfo As NodeInfo '节点对象
Dim tListItem As ListItem '临时对象
Dim i As Integer '临时变量
Dim tRst '临时结果

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 tKey As String '节点的Key
Dim tField_Value As String '节点字段在数据库中的值
Dim tTypeCode As String '文档类型
Dim tVolume_Status As String '0卷 1 盒
Dim tList_Type As String
'清除已有数据
Call ClearList

'设置节点对象信息
Call SetNodeInfo(tNodeInfo, p_Node.key)

'记录从节点继承的列表信息#Table_Name,Node_ID,Where_Str
p_ListCtl.Tag = "LV@T " + tNodeInfo.Table_Name + _
               " @I " + tNodeInfo.Node_ID + _
               " @W " + tNodeInfo.Where_Str + _
               " @X " + CStr(p_Node.Index)

'选案卷
Set gRst = gDbs.OpenRecordset("select * from LIST_DEFINATION where node_id=" + tNodeInfo.Node_ID + " and list_type=0 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, , , "ColVolume"
            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) + ",volume_id,status,type_code,type,transfer_flag,destruction_flag from " + tNodeInfo.Table_Name
    If tNodeInfo.Where_Str <> "" Then tSql = tSql + " where " + tNodeInfo.Where_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 '结果集过大，不转换数据字典
    SBar.Panels(4).Text = "记录总数：" + CStr(tRst.RecordCount)

    While Not tRst.EOF
    
        tVolume_ID = Convert_Value(tRst.Fields("volume_id"), _
                      0, tRst.Fields("volume_id").Type, False, False) 'order_by 应都一样，只取最后一个
        'tVolume_Status = Convert_Value(tRst.Fields("STATUS"), _
                      0, tRst.Fields("STATUS").Type, False, False)
        tTypeCode = Convert_Value(tRst.Fields("type_code"), _
                      0, tRst.Fields("type_code").Type, False, False)
        
        '卷盒标志+组卷标志+移交标志+销毁标志
        tVolume_Status = Convert_Value(tRst.Fields("type"), _
                      0, tRst.Fields("type").Type, False, False) & _
                      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)

        tKey = "LItm@I" + tVolume_ID + " @S " + tVolume_Status + " @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, "Volume", "Volume")
        
        '添加其余列
        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
        SBar.Panels(2).Text = "进度：" + Format(tRst.AbsolutePosition / tRst.RecordCount, "00.00%")
    Wend
    SBar.Panels(2).Text = "进度：完成"
    gConvert_To_Dict = True
End With
List_View_Volume = True
Exit Function
Err:
   List_View_Volume = False
End Function

'###################################################################################
'清除列表
'###################################################################################
Public Sub ClearList()
LVVolume.ListItems.Clear
'LVVolume.ColumnHeaders.Clear
LVVolume.Tag = ""
LVFile.ListItems.Clear
'LVFile.ColumnHeaders.Clear
LVFile.Tag = ""
End Sub

'#########################################################################
'初始化菜单
'参数：p_Type菜单类型 0文件，1案卷， 2盒  p_Status 对象状态
'返回：boolean 返回的值
'#########################################################################
Public Sub Init_Pop_Mnu(p_Type As Integer, p_Status As String)
On Error GoTo Err
Dim i As Integer

'p_Status '文件状态+移交标志+销毁标志+借阅状态

'm_File.Enabled = False
'm_Volume.Enabled = False
'm_Box.Enabled = False


If p_Type = 0 Then '文件
   
   'M_File.Enabled = True
   
   For i = 0 To m_File_Do.Count - 1
       If m_File_Do(i).Caption <> "-" Then m_File_Do(i).Enabled = False
   Next i
   '浏览
   m_File_Do(0).Enabled = True
   
   '修改，删除，归档 未销毁未归档
   If GetStatus(0, p_Status, "destruction_flag") = "0" And _
      GetStatus(0, p_Status, "status") = "0" Then
      m_File_Do(1).Enabled = True
      m_File_Do(2).Enabled = True
      m_File_Do(4).Enabled = True
   End If

   '解除归档 未销毁已归档
   If GetStatus(0, p_Status, "destruction_flag") = "0" And _
      GetStatus(0, p_Status, "status") = "1" Then
      m_File_Do(5).Enabled = True
   End If
   
   '权限设置
   m_File_Do(6).Visible = False
   m_File_Do(7).Visible = False
   
   '移交 未移交未销毁
   If GetStatus(0, p_Status, "destruction_flag") = "0" And _
      GetStatus(0, p_Status, "transfer_flag") = "0" Then
      m_File_Do(9).Enabled = True
   End If
   
   '销毁 已移交未销毁
   If GetStatus(0, p_Status, "destruction_flag") = "0" And _
      GetStatus(0, p_Status, "transfer_flag") = "1" Then
      m_File_Do(10).Enabled = True
   End If

ElseIf p_Type = 1 Then '案卷/盒
   
   If GetStatus(1, p_Status, "type") = "0" Then '案卷
      'm_Volume.Enabled = True
      For i = 0 To m_Volume_Do.Count - 1
          If m_Volume_Do(i).Caption <> "-" Then m_Volume_Do(i).Enabled = False
      Next i
   
       '浏览
       m_Volume_Do(0).Enabled = True
       
       '删除修改未销毁未封卷
       If GetStatus(0, p_Status, "destruction_flag") = "0" And _
          (GetStatus(0, p_Status, "status") = "0" Or GetStatus(0, p_Status, "status") = "1") Then
          m_Volume_Do(1).Enabled = True
          m_Volume_Do(2).Enabled = True
          m_Volume_Do(9).Enabled = True
       End If
    
          m_Volume_Do(4).Enabled = True
          m_Volume_Do(5).Enabled = True
          m_Volume_Do(7).Enabled = True
          m_Volume_Do(8).Enabled = True
    
       '移交 未移交未销毁
       If GetStatus(0, p_Status, "destruction_flag") = "0" And _
          GetStatus(0, p_Status, "transfer_flag") = "0" Then
          m_Volume_Do(11).Enabled = True
       End If
       
       '销毁 已移交未销毁
       If GetStatus(0, p_Status, "destruction_flag") = "0" And _
          GetStatus(0, p_Status, "transfer_flag") = "1" Then
          m_Volume_Do(12).Enabled = True
       End If
   
       '打印目录
       'm_Volume_Do(8).Enabled = True
       
    ElseIf GetStatus(1, p_Status, "type") = "1" Then '盒
       'm_Box.Enabled = True
       For i = 0 To m_Box_Do.Count - 1
          If m_Box_Do(i).Caption <> "-" Then m_Box_Do(i).Enabled = False
       Next i
   
       '浏览
       m_Box_Do(0).Enabled = True
       
       '删除 未销毁暂组盒或未组盒
       If GetStatus(1, p_Status, "destruc