Visual Basic 6 Asynchronous File IO Using the .NET Framework

Visual Basic 6 Asynchronous File IO Using the .NET Framework


Option Explicit

Dim WithEvents dirWatcher As DropDirMonitor.DirWatcher

Private Sub Form_Load()
Randomize

txtDropDir.Text = App.Path & "\Drop"
Set dirWatcher = New DropDirMonitor.dirWatcher
End Sub

Private Sub cmdStart_Click()
dirWatcher.Init txtDropDir.Text
End Sub

Private Sub cmdGenDataFile_Click()
Dim i As Integer

Dim fileName As String
fileName = txtDropDir.Text & "\" & Rand(1, 100000) & ".dat"

Open fileName For Output As #1

Print #1, "ProductID,Quantity,Price"

For i = 1 To Rand(5000, 30000)
Print #1, Rand(1, 100) & "," & Rand(1, 20) & "," & Rand(1, 50)
Next

Close #1
End Sub


Private Sub dirWatcher_ProcessingFile(ByVal fileName As String)
fileName = Right(fileName, Len(fileName) - InStrRev(fileName, "\"))
Text1.Text = Text1.Text & "Processing:" & fileName
DoEvents
End Sub

Private Sub dirWatcher_FileContentsAvailable(ByVal contents As String)
Dim lines() As String
lines = Split(contents, vbCrLf)

Dim total As Double
Dim line As Variant
For Each line In lines
Dim items() As String
items = Split(line, ",")
If UBound(items) > -1 Then
If IsNumeric(items(1)) Then
total = total + (CDbl(items(1)) * CDbl(items(2)))
End If
End If
Next

Text1.Text = Text1.Text & ", Total = " & FormatCurrency(total) &
vbCrLf
End Sub

Public Function Rand(ByVal Low As Long, ByVal High As Long) As Long
Rand = Int((High - Low + 1) * Rnd) + Low
End Function



---


_
Public Class DirWatcher
Inherits Control

#Region "COM GUIDs"
' These GUIDs provide the COM identity for this class
' and its COM interfaces. If you change them, existing
' clients will no longer be able to access the class.
Public Const ClassId As String = "db5b9156-4aa7-4a5d-a32d
-ceb6af2dc3e2"
Public Const InterfaceId As String = "2c22921f-2357-4215-9759
-0ba865a65d7a"
Public Const EventsId As String = "1c1e49dc-d641-41b3-9394
-b003de631c4d"
#End Region

Private WithEvents mFileSystemWatcher As New FileSystemWatcher

Private mDirectoryToWatch As String

Private filesToProcess As New List(Of String)

Public Sub New()
MyBase.New()
Me.CreateHandle()
End Sub

Public Sub Init(ByVal directoryToWatch As String)
mDirectoryToWatch = directoryToWatch
mFileSystemWatcher.Path = mDirectoryToWatch
mFileSystemWatcher.EnableRaisingEvents = True

For Each file As String In Directory.GetFiles(directoryToWatch)
filesToProcess.Add(file)
Next

ProcessNextFile()
End Sub

Private Sub mFileSystemWatcher_Created(ByVal sender As Object, _
ByVal e As System.IO.FileSystemEventArgs) _
Handles mFileSystemWatcher.Created

If Me.InvokeRequired Then
If e.ChangeType <> WatcherChangeTypes.Created Then Return

Me.Invoke(New EventHandler(Of FileSystemEventArgs) _
(AddressOf mFileSystemWatcher_Created), sender, e)
Else
filesToProcess.Add(e.FullPath)
ProcessNextFile()
End If
End Sub


    Private Sub ProcessNextFile()
        If filesToProcess.Count = 0 Then Return
        If Me.Cancel = True Then Return

        If Not mBackgroundWorker.IsBusy Then
            Dim fileToProcess As String = filesToProcess(0)
            filesToProcess.RemoveAt(0)
            If File.Exists(fileToProcess) Then
                mBackgroundWorker.RunWorkerAsync(fileToProcess)
            End If
        End If
    End Sub

    Private Sub mBackgroundWorker_DoWork(ByVal sender As Object, _
    ByVal e As System.ComponentModel.DoWorkEventArgs) _
    Handles mBackgroundWorker.DoWork
        Using sr As New StreamReader(File.Open( _
            e.Argument, FileMode.Open, _
            FileAccess.Read, FileShare.None))
           
            mBackgroundWorker.ReportProgress(0, e.Argument)
            e.Result = sr.ReadToEnd()
        End Using
        File.Delete(e.Argument)
    End Sub

    Private Sub mBackgroundWorker_RunWorkerCompleted( _
    ByVal sender As Object, _
    ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) _
    Handles mBackgroundWorker.RunWorkerCompleted

        If e.Result IsNot Nothing Then
            RaiseEvent FileContentsAvailable(e.Result)
        End If

        ProcessNextFile()
    End Sub