form_manage.frm

开发环境：VB6.0 数据库：SQLServer2000 说明：这是一个图库管理系统

   Call CModule.CloseRs(objRs)
   Call CModule.CloseCon
   NodeAdd = False
  
End Function






Private Sub Form_Load()
  '在消息树中添加节点
  If NodeAdd() = False Then
    Exit Sub
  End If
  Tree_Main.Nodes(1).Selected = True
  Tree_Main.Nodes(1).Expanded = True
  Tree_Main_Click
  '从注册表中读取应用程序注册信息
  If CModule.GetString(HKEY_LOCAL_MACHINE, "SOFTWARE\tkgl", "Type") <> "server" Then
    '将删除和可执行文件设置置为不可用
    mExe.Enabled = False
    Toolbar_Top.Buttons(2).Enabled = False
    mDel.Enabled = False
    Toolbar_Top.Buttons(6).Enabled = False
  End If
    
End Sub

Private Sub mAddF_Click()
  Form_Sel.Show
  Form_Sel.Caption = ""
  Form_Manage.Hide
End Sub



Private Sub List_Main_DblClick()
  Dim i As Integer
  Dim strFile As String
  Dim strErr As String
  Dim mnode As Node
  On Error GoTo Err
  '确定打开目录还是文件
  If Trim(List_Main.SelectedItem.Tag) = "Direc" Then
      For i = 1 To Tree_Main.Nodes.Count
      If List_Main.SelectedItem.Key = Tree_Main.Nodes(i).Key Then
       Exit For
      End If
    Next
    Tree_Main.Nodes(i).Selected = True
    Tree_Main.Nodes(i).Expanded = True
    Tree_Main_Click
  Else   '文件
    Set mnode = Tree_Main.SelectedItem
    If CModule.GetNodePath(mnode, strFile) = False Then
        Err.Raise 90
    End If
    strFile = Trim(strFile) & Trim(List_Main.SelectedItem.Text)
    If CModule.OpenFile(strFile, strErr) = False Then
        Err.Raise 91
    End If
  End If
  Exit Sub
Err:
  Select Case Err.Number
  Case 90
    MsgBox strFile
  Case 91
    MsgBox strErr
  'Case 92
  '  MsgBox "类型错误,错误位置：List_Main_DblClick()"
  Case Else
    MsgBox "系统错误，错误描述：" & Err.Description & "错误位置：List_Main_DblClick()"
  End Select

End Sub

Private Sub mConect_Click()
    Form_Main.Show
End Sub

Private Sub mDB_Click()
    Form_Db.Show
End Sub

Private Sub mDel_Click()
  Dim i As Integer
  Dim strFile As String
  Dim mnode As Node
  
  If List_Main.ListItems.Count = 0 Then
    MsgBox "请在列表框中选择要删除的项目"
    Exit Sub
  End If
  On Error GoTo Err
  Set mnode = Tree_Main.SelectedItem
  If CModule.GetNodePath(mnode, strFile) = False Then
    Err.Raise 90
  End If
  '确定删除目录还是文件
  If Trim(List_Main.SelectedItem.Tag) = "Direc" Then '目录
    strFile = strFile & Trim(List_Main.SelectedItem.Text)
    RmDir strFile
  Else  '文件
    strFile = strFile & Trim(List_Main.SelectedItem.Text)
    Kill strFile
  End If
  '删除数据表中的数据
  strFile = Trim(List_Main.SelectedItem.Text)
  If CModule.DeleteNode(strFile) = False Then
    Err.Raise 91
  End If
  '在消息树中添加节点
  Tree_Main.Nodes.Clear
  If NodeAdd() = False Then
    Exit Sub
  End If
  Tree_Main.Nodes(1).Selected = True
  Tree_Main.Nodes(1).Expanded = True
  Tree_Main_Click
  Exit Sub
Err:
  Select Case Err.Number
  Case 90
    MsgBox strFile
  Case 91
    MsgBox strFile
  Case 92
    MsgBox "类型错误,错误位置：mDel_Click()"
  Case Else
    MsgBox "系统错误，错误描述：" & Err.Description & "错误位置：mDel_Click()"
  End Select
        
End Sub

Private Sub mExe_Click()
    Form_Sel.Show
    Unload Me
End Sub

Private Sub mExit_Click()
    Unload Me
End Sub

Private Sub mInput_Click()
    Dim i As Integer                    '拆解数据项变量
    Dim Y As Integer
    Dim Z As Integer
    Dim FileNames$()
    Dim objRs As New ADODB.Recordset    '入库和添加数形结构变量
    Dim strPath As String   '节点路径
    Dim mnode As Node       '节点
    Dim mKey As String      '节点key值
    
    
    FileDialog.FileName = ""
    On Error GoTo Err

  '如果为文件,不能创建子节点
  If Trim(Tree_Main.SelectedItem.Tag) <> "Direc" Then
    MsgBox "不能在此项中建立子项目"
    Exit Sub
  End If
  FileDialog.Filter = "All Files|*.*"
  FileDialog.FilterIndex = 1
  FileDialog.Flags = cdlOFNAllowMultiselect

  FileDialog.ShowOpen
  strPath = FileDialog.FileName
  '将多选的数据项拆开,分别填写在数组中
  Z = InStrRev(strPath, "\")
  If Mid(strPath, Z + 1, 1) <> Chr(32) Then
    strPath = Left(strPath, Z) & Chr(32) & Right(strPath, Len(strPath) - Z)
  End If
  If Z = 0 Then
    Exit Sub
  End If
  strPath = strPath & Chr(32)
  Z = 1
  For i = 1 To Len(strPath)
    i = InStr(Z, strPath, Chr(32))
    If i = 0 Then Exit For
    ReDim Preserve FileNames(Y)
    FileNames(Y) = Mid(strPath, Z, i - Z)
    Z = i + 1
    Y = Y + 1
  Next
  '如果只有目录
  If Y = 1 Then
    Exit Sub
  End If
  '***********将数据项入库
  '连接数据库
  If Not CModule.IsConnect Then
    Err.Raise 90
  End If
  '提取当前新建文件或文件夹路径
  strPath = ""
  Set mnode = Tree_Main.SelectedItem
  If CModule.GetNodePath(mnode, strPath) = False Then
    Err.Raise 91
    Err.Description = strPath
  End If
  For i = 1 To Y - 1
    '在数据表中添加记录
    objRs.Open "zdk", CModule.objCon, , adLockOptimistic, adCmdTable
    objRs.AddNew
    objRs("zdcode") = Trim(FileNames(i))
    objRs("zdname") = Trim(FileNames(i))
    mKey = mnode.Key                              '取出父节点Key值 如：F1F1C1Node
    mKey = Left(Trim(mKey), Len(Trim(mKey)) - 4)  'mKey=F1F1C1
    objRs("zdtype") = mKey
    objRs("zdIndex") = mnode.Children + i       '子节点序号
    objRs("zdbz") = Trim(FileNames(i))
    objRs("zdDes") = Right(Trim(FileNames(i)), 3)
    objRs("ftype") = Right(Trim(FileNames(i)), 4)
    FileCopy Trim(FileNames(0) & Trim(FileNames(i))), strPath & Trim(FileNames(i)) '将格式文件拷贝到当前目录下
    objRs("zdPath") = strPath & Trim(FileNames(i))
    objRs.Update
    CModule.CloseRs objRs
  Next
  '将树形框清除
  Tree_Main.Nodes.Clear
  '从新添加树形框
  If NodeAdd() = False Then
    Err.Raise 93
  End If
  Tree_Main.Nodes(1).Selected = True
  Tree_Main.Nodes(1).Expanded = True
  Tree_Main_Click

  Exit Sub
Err:
  Select Case Err.Number
  Case 90
    MsgBox ("数据库连接失败,错误位置：mInput_Click()")
  Case 92
    objRs.CancelUpdate
    MsgBox ("类型错误，请检查节点类型,错误位置：mInput_Click()")
  Case 91
    objRs.CancelUpdate
    MsgBox Err.Description
  Case 93
    MsgBox "添加浏览框出现错误"
  Case Else
    'objRs.CancelUpdate
    MsgBox ("系统错误，错误描述：" & Err.Description & "错误位置：mInput_Click()")
  End Select
End Sub

Private Sub mNew_Click()
  '如果为文件,不能创建子节点
  If Trim(Tree_Main.SelectedItem.Tag) <> "Direc" Then
    MsgBox "不能在此项中建立子项目"
    Exit Sub
  End If
  Form_Detail.Show
  Form_Manage.Hide

End Sub

Private Sub mopen_Click()
    If List_Main.ListItems.Count = 0 Then
        Exit Sub
    End If
    List_Main_DblClick
End Sub

Private Sub mQuery_Click()
   Form_Log.Show
End Sub

Private Sub Toolbar_Top_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
    Case 1
        mDB_Click
    Case 2
        mExe_Click
    Case 3
        mNew_Click
    Case 4
        mInput_Click
    Case 5
        mopen_Click
    Case 6
        mDel_Click
    Case 7
        mQuery_Click
    Case 8
        mConect_Click
    Case 9
        mExit_Click
    End Select
    
End Sub

Private Sub Tree_Main_Click()
  Dim mItem As ListItem
  Dim objRs As New ADODB.Recordset
  Dim strSql As String
  Dim Intchild As Integer
  Dim mKey As String
  
  On Error GoTo Err
  '数据库连接
  If Not CModule.IsConnect() Then
    Err.Raise 90
  End If
  mKey = Form_Manage.Tree_Main.SelectedItem.Key             '取出父节点Key值 如：F1C1C1Node
  mKey = Left(Trim(mKey), Len(Trim(mKey)) - 4)              'mKey=F1C1C1
  strSql = "select * from zdk where zdtype='" & mKey & "'"  '父节点编号
  strSql = strSql & " order by ftype desc"
  objRs.Open strSql, CModule.objCon, , adLockOptimistic, adCmdText
  List_Main.ListItems.Clear
  While Not objRs.EOF
    Set mItem = List_Main.ListItems.Add(, Key:=Trim(objRs!zdtype) & "C" & Trim(objRs!zdIndex) & _
                        "node", Text:=objRs!zdCode, Icon:=IIf(Trim(objRs!ftype) = "Direc", "direct", "file"))
    mItem.Tag = objRs!ftype

    objRs.MoveNext
  Wend
  Call CModule.CloseRs(objRs)
  Exit Sub
Err:
  Select Case Err.Number
  Case 90
    MsgBox ("数据库连接失败！")
  Case 91
    MsgBox ("添加列表错误")
  Case Else
    MsgBox ("系统出错！错误描述：" & Err.Description & "错误位置：Tree_Main_Click()")
  End Select
  Call CModule.CloseRs(objRs)
  Call CModule.CloseCon
  
End Sub

Private Sub Tree_Main_Collapse(ByVal Node As MSComctlLib.Node)
 ' 只有文件夹中的节点可以被折叠。
    If Node.Tag = 0 Then Node.Image = "close"
    
End Sub

Private Sub Tree_Main_Expand(ByVal Node As MSComctlLib.Node)
    If Node.Tag = 0 Then Node.Image = "open"
'    MsgBox (Node.Key)
End Sub
Private Sub AddListItem(ByRef xItem As ListItem, ByRef xRec As ADODB.Recordset)
    Set xItem = List_Main.ListItems.Add(, Key:=Trim(xRec!zdtype) & Trim(xRec!zdIndex) & "node", Text:=xRec!zdname, Icon:=IIf(xRec!ftype = 0, "direct", "file"))
    xItem.Tag = xRec!ftype
End Sub