Try this link:
http://www.codeproject.com/Messages/3526402/Re-Is-it-the-right-approach-to-speed-up-the-copy-p.aspx[^]
Or try this code:
Public Class FileSearch
Inherits System.Collections.Generic.List(Of String)
#Region "-----------------------------------------------------Events"
Public Event NewFileList(ByVal Sender As Object, ByVal e As FSrcEventArgs)
Public Event CurrentFolder(ByVal Sender As Object, ByVal e As FSrcEventArgs)
Public Event CurrentEvent(ByVal Sender As Object, ByVal e As FSrcEventArgs)
#End Region
#Region "--------------------------------------------Public Variables"
Public AddOnObj As Object, Info As String = "", FolderCount As Long, StopSearching As Boolean, FolderList As New List(Of String)
Public Shared ExcludeFolder As String = "Unwanted Programs", ExcludeSignFile As String = "\info.inf", ExcludeSign As String = "simpledata"
#End Region
#Region "-------------------------------------------Local Variables"
Dim e As New FSrcEventArgs
Private G_FileTypes() As String
Private Parent As System.Windows.Forms.Control
#End Region
Sub Reset()
e = New FSrcEventArgs
Me.Clear()
StopSearching = False
G_FileTypes = Nothing
FolderCount = 0
AddOnObj = Nothing
Info = ""
End Sub
#Region "--------------------------------------------FSrcEventArgs Class"
Public Class FSrcEventArgs
Inherits System.EventArgs
Friend Enum EventTypes
None = 0
Dirs = 1
Files = 2
Informations = 3
End Enum
Public Directory As String = ""
Public CurrentList As New List(Of String)
Public Completed As Boolean = False
Public StopSearching As Boolean = False
Public FileCount As Integer = 0
Public DirCount As Integer = 0
Public Info As String = ""
Public Exclude_This_Folder As Boolean
Friend EventType As EventTypes = EventTypes.None
Friend Sub CopyArgs(ByVal Directory As String, _
ByVal CurrentList As List(Of String), _
ByVal Completed As Boolean, _
ByVal StopSearching As Boolean, _
ByVal FileCount As Integer, _
ByVal DirCount As Integer, _
ByVal Info As String, _
ByVal EventType As EventTypes, ByVal Exclude_This_Folder As String)
With Me
.Directory = Directory
.CurrentList = CurrentList
.Completed = Completed
.StopSearching = StopSearching
.FileCount = FileCount
.DirCount = DirCount
.Info = Info
.EventType = EventType
End With
End Sub
End Class
#End Region
Sub GetAllFiles(ByVal InFolder As String, Optional ByVal FileTypes As String = "*.*", Optional ByVal contains As String = "")
e.Directory = InFolder
FolderList.Add(InFolder)
e.CopyArgs(InFolder, Me, e.Completed, StopSearching, Me.Count, FolderCount, "Searching Completed", FSrcEventArgs.EventTypes.Dirs, False)
Dim DG As New DLG_SrcInfo_all(AddressOf SUB_SrcInfo_all)
Try
Me.Parent.Invoke(DG, Me, e)
Catch ex As Exception
End Try
FindInFolder(InFolder, FileTypes, contains)
e.Completed = True
e.CopyArgs(InFolder, Me, e.Completed, StopSearching, Me.Count, FolderCount, "Searching Completed. Total Files: " & Me.Count, FSrcEventArgs.EventTypes.Informations, False)
Try
Me.Parent.Invoke(DG, Me, e)
Catch ex As Exception
End Try
End Sub
Shadows Function ToString(ByVal Delimiter As String) As String
Me.ToArray()
Return Microsoft.VisualBasic.Strings.Join(Me.ToArray, Delimiter)
End Function
Function FindInFolder(ByVal InFolder As String, Optional ByVal FileTypes As String = "*.*", Optional ByVal contains As String = "") As System.Collections.Generic.IEnumerable(Of String)
Dim xx = InFolder
If IsNothing(G_FileTypes) Then
G_FileTypes = FileTypes.Split(New [Char]() {","c})
End If
Try
Dim ps As Integer = InStr(InFolder, ExcludeFolder, CompareMethod.Text)
If ps > 0 Then
Dim FD As String = My.Computer.FileSystem.ReadAllText(InFolder & ExcludeSignFile)
If FD.Length = ExcludeSign.Length Then
Return Me
End If
End If
Catch ex As Exception
End Try
Dim DG As New DLG_SrcInfo_all(AddressOf SUB_SrcInfo_all)
Try
Me.AddRange(FindFiles(InFolder, FileTypes, contains))
Catch ex As Exception
Return Me
End Try
FolderCount += 1
e.CopyArgs(InFolder, e.CurrentList, e.Completed, StopSearching, Me.Count, FolderCount, "Searching for folders in '" & InFolder & "'", FSrcEventArgs.EventTypes.Informations, False)
Try
Me.Parent.Invoke(DG, Me, e)
Catch ex As Exception
End Try
For Each Directory As String In My.Computer.FileSystem.GetDirectories(InFolder, FileIO.SearchOption.SearchTopLevelOnly)
If StopSearching Then
e.CopyArgs(Directory, e.CurrentList, e.Completed, StopSearching, Me.Count, FolderCount, "Searching Stopped", FSrcEventArgs.EventTypes.Informations, False)
If Not IsNothing(Parent) Then
Me.Parent.Invoke(DG, Me, e)
End If
Return Nothing
End If
e.CopyArgs(Directory, e.CurrentList, e.Completed, StopSearching, Me.Count, FolderCount, "Searching for folders in '" & InFolder & "'", FSrcEventArgs.EventTypes.Dirs, False)
If Not IsNothing(Parent) Then
If Parent.Disposing Then
Else
Me.Parent.Invoke(DG, Me, e)
End If
End If
If e.Exclude_This_Folder Then
e.Exclude_This_Folder = False
Continue For
Else
FolderList.Add(Directory)
End If
Try
FindInFolder(Directory, FileTypes, contains)
Catch ex As Exception
xx = ex.ToString()
Continue For
End Try
Next
Return Me
End Function
#Region " -------------------------------------------- Delegates"
Private Delegate Sub DLG_SrcInfo_all(ByVal Sender As Object, ByVal e As FSrcEventArgs)
Private Sub SUB_SrcInfo_all(ByVal Sender As Object, ByVal e As FSrcEventArgs)
If StopSearching = True Then
Return
End If
Select Case e.EventType
Case FSrcEventArgs.EventTypes.Dirs
RaiseEvent CurrentFolder(Sender, e)
Case FSrcEventArgs.EventTypes.Files
RaiseEvent NewFileList(Sender, e)
Case FSrcEventArgs.EventTypes.Informations
RaiseEvent CurrentEvent(Sender, e)
End Select
End Sub
#End Region
Function FindFiles(ByVal InFolder As String, Optional ByVal FileTypes As String = "*.*", Optional ByVal contains As String = "") As System.Collections.Generic.IEnumerable(Of String)
On Error GoTo Errr
If StopSearching Then
Return Nothing
End If
Dim la As ArrayList
If IsNothing(G_FileTypes) Then
G_FileTypes = FileTypes.Split(New [Char]() {","c})
End If
Dim lResult As New List(Of String)
Dim DG As New DLG_SrcInfo_all(AddressOf SUB_SrcInfo_all)
e.CopyArgs(InFolder, e.CurrentList, e.Completed, StopSearching, Me.Count, FolderCount, "Searching for files in '" & InFolder & "'", FSrcEventArgs.EventTypes.Informations, False)
On Error Resume Next
Me.Parent.Invoke(DG, Me, e)
On Error GoTo Errr
lResult.AddRange(My.Computer.FileSystem.FindInFiles(InFolder, _
contains, False, FileIO.SearchOption.SearchTopLevelOnly, _
G_FileTypes))
If lResult.Count > 0 Then
e.CurrentList = lResult
e.CopyArgs(InFolder, lResult, e.Completed, StopSearching, Me.Count, FolderCount, "Search Completed at folder '" & InFolder & "'", FSrcEventArgs.EventTypes.Files, False)
On Error Resume Next
Me.Parent.Invoke(DG, Me, e)
On Error GoTo Errr
End If
If IsNothing(AddOnObj) Then
Else
AddOnObj.AddRange(lResult.ToArray)
End If
Return lResult
Errr:
Return Nothing
End Function
Public Sub New()
End Sub
Public Sub New(ByVal Parent As System.Windows.Forms.Control)
Me.Parent = Parent
End Sub
End Class
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++****************
I’ll be pleased if you give me any bugs report & fix that.
Here is a sample form to call that.(bugs report are not needed for below code because I know that. Its a testing.)
Public Class Form1
Dim WithEvents FF As New System_Tools.Task_Explorer
Dim WithEvents CC As System_Tools.HOOK_
Dim di As New System_Tools.HOOK_
Dim WithEvents FS As System_Tools.FileSearch
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
BackgroundWorker1.RunWorkerAsync(Me.ComboBox1.Text)
End Sub
Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
FS = New System_Tools.FileSearch(Me)
Dim xx As List(Of String)
FS.GetAllFiles(e.Argument.ToString)
End Sub
Private Sub FS_CurrentEvent(ByVal Sender As Object, ByVal e As System_Tools.FileSearch.FSrcEventArgs) Handles FS.CurrentEvent
Dim xx
Me.Text = e.Info
If e.Completed Then
Beep()
xx = EvList
xx = RefList
Me.Text = e.Info & " " & Sender.count
End If
End Sub
Private Sub FS_CurrentFolder(ByVal Sender As Object, ByVal e As System_Tools.FileSearch.FSrcEventArgs) Handles FS.CurrentFolder
Dim xx
Me.Text = e.Info
If e.Completed Then
Beep()
xx = EvList
xx = RefList
End If
End Sub
Private Sub FS_NewFileList(ByVal Sender As Object, ByVal e As System_Tools.FileSearch.FSrcEventArgs) Handles FS.NewFileList
EvList.AddRange(e.CurrentList)
Dim xx
Me.Text = e.Info
If e.Completed Then
Beep()
xx = EvList
xx = RefList
End If
TextBox1.Text = Join(e.CurrentList.ToArray, vbNewLine)
End Sub
Dim EvList, RefList As New List(Of String)
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ComboBox1.Items.Add("C:\")
ComboBox1.Items.Add("d:\")
ComboBox1.Items.Add("e:\")
ComboBox1.Items.Add("f:\")
ComboBox1.Items.Add("g:\")
ComboBox1.Items.Add("h:\")
ComboBox1.Items.Add("i:\")
ComboBox1.Items.Add("j:\")
ComboBox1.Items.Add("k:\")
ComboBox1.Text = "C:\"
Debug.WriteLine("Leaving ExpTree ShDragDrop")
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim xx
CC.autocheck1time()
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim xx
End Sub
Private Sub FF_Task_Explorer_Terminated() Handles FF.Task_Explorer_Terminated
FF.Dispose()
End Sub
Private Sub CC_
Dim addrem As String = ""
If e.
addrem = "Added: " & e.DriveInfo.Name & "-" & e.DriveInfo.VolumeLabel & vbNewLine
ElseIf e.
addrem = "Removed: " & e.DriveInfo.Name & vbNewLine
End If
Me.Text = e.
TextBox1.AppendText(addrem)
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Me.Text = System_Tools.FileAccess.FileLenStr("H:\PLangs.iso")
End Sub
End Class
Oh, I forgot to say that sample form could raise errors because some classes are not given. Just remove which raise error.
______________
Aslam Iqbal
|