Private Function TrimNull(ByVal StrIn As String) As String
   Dim nul As Long
  
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         TrimNull = Left(StrIn, nul - 1)
      Case 1
         TrimNull = ""
      Case 0
         TrimNull = Trim(StrIn)
   End Select
End Function

    2、在Form1中加入一个FileListBox，Name属性设置为File1。加入一个DirListBox，
Name属性设置为Dir1，在Dir1的Change事件中加入如下代码：
Private Sub Dir1_Change()
   File1.Path = Dir1.Path
End Sub
加入一个DriveListBox，Name属性设置为Drive1，在Drive1的Change事件中加入如下
代码：
Private Sub Drive1_Change()
   Dir1.Path = Drive1.Drive
End Sub
加入一个CommandButton，Name属性设置为cmdCopy，在cmdCopy的Click事件中加入如下
代码：
Private Sub cmdCopy_Click()
   Dim Files() As String
   Dim Path As String
   Dim i As Long, n As Long
  
   Path = Dir1.Path
   If Right(Path, 1) <> "\" Then
      Path = Path & "\"
   End If
  
   ''''根据在List1上的选择建立拷贝文件的列表
   With File1
      For i = 0 To .ListCount - 1
         If .Selected(i) Then
            ReDim Preserve Files(0 To n) As String
            Files(n) = Path & .List(i)
            n = n + 1
         End If
      Next i
   End With
  
   ''''拷贝文件到Clipboard
   If clipCopyFiles(Files) Then
      MsgBox "拷贝文件成功.", , "Success"
   Else
      MsgBox "无法拷贝文件...", , "Failure"
   End If
End Sub
加入一个CommandButton，Name属性设置为cmdPaste，在cmdPaste的Click事件中加入如
下代码：
Private Sub cmdPaste_Click()
   Dim Files() As String
   Dim nRet As Long
   Dim i As Long
   Dim msg As String
  
   nRet = clipPasteFiles(Files)
   If nRet Then
      For i = 0 To nRet - 1
         msg = msg & Files(i) & vbCrLf
      Next i
      MsgBox msg, , "共粘贴" & nRet & "个文件"
   Else
      MsgBox "从剪贴版粘贴文件错误", , "Failure"
   End If
End Sub

    运行文件，在Windows 资源管理器中，选择文件，再在资源管理器菜单中选 编辑 | 复制
然后在Form1中点击cmdPaste，从资源管理器中复制的文件就拷贝到Dir1所在的目录中。从
File1中选择文件，按cmdCopy复制，再在资源管理器中选 编辑 | 粘贴 ，选择的文件就被
拷贝到Windows 资源管理器的当前目录下。
    上面的程序在Windows98 VB6.0下运行通过。

www.applevb.com

上一页  [1] [2]