怎样移动文档，并且保证移动过程中可视？这是用户所关心的。我们可以通过拖曳方法实现。我们把文件从列表视图中拖到树视图中,事实上就是拖动一个控件，在一个完整的拖放动作（即将一个控件拖动到一个对象上，并释放鼠标按钮）完成.。拖放操作中可以设置图标，产生拖放视角。这里有几个关键的事件如MouseMove、DragDrop、DragOver等。我们在列表视图的鼠标移动事件中通过判断鼠标左键是否按下确定拖放图标并产生拖放。代码如下：

Private Sub ListView1_MouseMove_
     (Button As Integer, Shift As Integer, x As Single, y As Single)

     If Button = vbLeftButton Then '指示拖动操作。

      indrag = True '设置标志为 true。

      '用 CreateDragImage 方法设置拖动图标。

      ListView1.DragIcon = ListView1.SelectedItem.CreateDragImage

      ListView1.Drag vbBeginDrag '拖动操作。

   End If

End Sub

在一个完整的拖放动作完成后，DragDrop事件发生。当完成拖动时我们应该判断光标是否移动到一个对象上，当光标移动到TreeView1时就显示为系统的突出颜色,这由DropHighlight指定。释放鼠标按钮后结束拖放动作。代码如下：

Private Sub ListView1_DragDrop_
    (Source As Control, x As Single, y As Single)

     If TreeView1.DropHighlight Is Nothing Then

      Set TreeView1.DropHighlight = Nothing

      indrag = False

      Exit Sub

   Else

      If nodX = TreeView1.DropHighlight Then Exit Sub

      Cls

     ' Print nodX.Text & " dropped on " & TreeView1.DropHighlight.Text

      Set TreeView1.DropHighlight = Nothing

      indrag = False

   End If

End Sub

当拖放动作产生，并拖动到TreeView1时,应该判断光标的坐标是否有效，即是否落在TreeView1上，这由HitTest 方法实现。

我们在TreeView1的DragOver（拖动经过）方法中设置鼠标的坐标。代码如下：

Private Sub TreeView1_DragOver_
   (Source As Control, x As Single, y As Single, State As Integer)

    If indrag = True Then

      '设置 DropHighlight 为鼠标的坐标。

      Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)

   End If

End Sub

当拖放结束DragDrop时，要把拖动的对象放在目的地，这里是把被拖放的文件放入目录中，形成该目录下的文件。表面看好象是把文件移置到目录表，事实上我们只需找到该文件的目录号并把它更新于所拖到的目录中就可。要表示拖放成功，应在ListItems中删除该文件，同时重新更新TreeView1。代码如下：

Private Sub TreeView1_DragDrop_
   (Source As Control, x As Single, y As Single)

  Dim recTemp As New ADODB.Recordset

  Dim intPathID As Integer

   If TreeView1.DropHighlight Is Nothing Then

      Set TreeView1.DropHighlight = Nothing

      indrag = False

      Exit Sub

   Else

   If nodX = TreeView1.DropHighlight Then Exit Sub

     Set recTemp = objDB.OpenTable_
      ("doc_path", "path_name='" & TreeView1.DropHighlight.Text & "'")

      intPathID = recTemp!Id      

      Set recTemp = objDB.OpenTable_
         ("doc_file", "File_name='" & nodX.Text & "'")

      recTemp!path_id = intPathID

      recTemp.Update      

      ListView1.ListItems.Remove (nodX.Index)

      Call CreateTree("")

      indrag = False

   End If

End Sub

删除文件的实现要简单些，主要是在ListView1删除文件，并从表中实际删除。代码如下：

Private Sub cmdDelFile_Click()

   Dim recTemp As New ADODB.Recordset    

   If ListView1.SelectedItem.Tag <> "file" Then

      MsgBox "请选择所删除的文件！", vbExclamation + vbOKOnly, "错误"

      Exit Sub

   End If

   If MsgBox("你真的要删除该文件吗？", vbQuestion + vbYesNo, "提示")=vbNo Then

        Exit Sub

   End If

    Set recTemp=objDB.OpenTable("doc_file", "File_name='" & nodX.Text & "'")

      recTemp.Delete

      recTemp.Update

      ListView1.ListItems.Remove (nodX.Index)

      cmdDelFile.Enabled = False

End Sub

删除目录实际上分为删除目录和删除文件。代码如下：

Private Sub cmdDelDir_Click()

    Dim recTemp As New ADODB.Recordset

    Dim Id As Integer

    If CurrNode.Text = "共享文件夹" Then

         MsgBox "该目录不能不删除！", vbExclamation + vbOKOnly, "错误"

         Exit Sub

    End If

    If nodX Is Nothing Then

       If MsgBox("你真的要删除该目录及目录下所有的文件吗？", _
         vbQuestion + vbYesNo, "提示") = vbNo Then

          Exit Sub

       Else

       '   Set recTemp = objDB.OpenTable("doc_path",_
           "path_name='" & CurrNode.Text & "' and ")

            Id = Mid(CurrNode.Key, 2, Len(CurrNode.Key) - 1)

           Set recTemp = objDB.ExecuteSQL("DELETE doc_path.* from doc_path _
                where id=" & Id & " or sub_id=" & Id)

'          recTemp.Delete

'          recTemp.Update

          Call CreateTree("")

           Set recTemp = objDB.ExecuteSQL("DELETE doc_file.* FROM doc_file_
              where path_id=" & Id)

            'recTemp.Delete

           ' recTemp.Update

          Exit Sub

       End If

    End If

    If nodX.Tag <> "node" Then

       MsgBox "请选择所删除的目录！", vbExclamation + vbOKOnly, "错误"

       Exit Sub

    End If

    If MsgBox("你真的要删除该目录及目录下所有的文件吗？",_
          vbQuestion + vbYesNo, "提示") = vbNo Then

       Exit Sub

     Else

       Set recTemp = objDB.OpenTable("doc_path",_
           "path_name='" & nodX.Text & "'")

       recTemp.Delete

       recTemp.Update

       ListView1.ListItems.Remove (nodX.Index)

        Call CreateTree("")

     End If

     cmdDelFile.Enabled = False

End Sub

目录共享功能的实现

目录共享是由用户授权给共享人员，我们可以把权限分为三种（私有、完全共享、受限共享），通过一个ComboBox控件实现,其类型为下拉列表框，即属性Style选择2-Dropdown List，命名为cboType;共享的人员应该全部列出供选择，可通过ListBox实现,其类型为选择盒，即属性Style选择1-CheckBox。增加一个表单,命名为frmShareDir,布置如下：

在表单的Load事件中向List1填充yg_tab表的所有的人员号和人名，同时把它放入自定义定型yg中，供确定共享人员后填充共享字段用。代码如下：

Private Sub Form_Load()

    Dim recTemp As New ADODB.Recordset

    Dim i As Integer

     i = 1

     Set recTemp = objDB.ExecuteSQL("yg_tab")

     recTemp.MoveLast

     ReDim yg(recTemp.AbsolutePosition)

     recTemp.MoveFirst

     Do While Not recTemp.EOF       

        yg(i).userId = recTemp!userId

        yg(i).userName = recTemp!userName

        List1.AddItem yg(i).userId + "  " + yg(i).userName

        i = i + 1

        recTemp.MoveNext

     Loop    

End Sub

在确定按钮中把共享人员的号码录入共享字段中，共享人员的号码由分号隔开。当然先应该保证录入有效。代码如下：

Private Sub cmdYes_Click()

  Dim recTemp As New ADODB.Recordset

  Dim i As Integer

   If CurrNode = "" Then

      MsgBox "请输入目录名称！", vbExclamation + vbOKOnly, "错误"

      Exit Sub

   End If

   For i = 1 To List1.SelCount

        strID = strID + "," + yg(i).userId

    Next

   Set recTemp = objDB.OpenTable("doc_path", "id=" _
      & Mid(CurrNode.Key, 2, Len(CurrNode.Key) - 1))

   With recTemp

      !Path_tyep = gShareType

      If gShareType = 2 Then       

           !See_id = IIf(IsNull(!See_id), "", !See_id) + "," + strID        

      End If

      .Update

   End With

     Unload Me

End Sub

文件共享功能的实现类似目录共享，这里不作说明。代码如下：

Private Sub cboType_Click()

   gShareType = cboType.ListIndex

    If gShareType = 2 Then

        List1.Enabled = True

     Else

        List1.Enabled = False

     End If

End Sub

Private Sub cmdCance_Click()

  Unload Me

End Sub

Private Sub cmdYes_Click()

  Dim recTemp As New ADODB.Recordset

  Dim strID As String

  Dim i

   If List1.SelCount = 0 Then

      MsgBox "请选择共享人名！", vbExclamation + vbOKOnly, "错误"

      Exit Sub

   End If

    For i = 1 To List1.SelCount

        strID = strID + "," + yg(i).userId

    Next

     Set recTemp = objDB.OpenTable("doc_file", "file_id="_
       & Mid(nodX.Key, 2, Len(nodX.Key) - 1))

     With recTemp

      !file_type = gShareType

      If gShareType = 2 Then

         !See_id = IIf(IsNull(!See_id), "", !See_id) + "," + strID

         .Update

       End If

     End With

    ' frmBrowse.CreateTree ("")

     Unload Me

End Sub

Private Sub Form_Load()

    Dim recTemp As New ADODB.Recordset

    Dim i As Integer    

     i = 1      

     Set recTemp = objDB.ExecuteSQL("yg_tab")

     recTemp.MoveLast

     ReDim yg(recTemp.AbsolutePosition)

     recTemp.MoveFirst

     Do While Not recTemp.EOF       

        yg(i).userId = recTemp!userId

        yg(i).userName = recTemp!userName

        List1.AddItem yg(i).userId + "  " + yg(i).userName

        i = i + 1

        recTemp.MoveNext

     Loop

End Sub

至此完成了一个复杂的文档管理软件的主要部分。其它希望读者自己完成。