MultiThreading in vb6 (do events?) **WILL GIVE MORE POINTS***

trying it now.

Can you explain what some of it means?
so if it doesnt work i can better debug it.

Thanks.

every time you execute the loop you call a method (StopProcess)

In that method you call doevents when the last time you called it is grater than the interval you want to call that function.  Calling Doevents will make windows able to process others events.

the command_stop_click is the function liked to the click event of your "stop" button.  When you click it, it will change a flag (m_blnStop).

So, if someone clicked on stop button, m_blnStop will be true and StopProcess will return true, then you will exit ClearScanner sub.

You can set the delay of calling Dovents to 0,1 - 0,5 seconds (then you will have to change static lngLast as long from long to double).

if (Timer - lngLast) -> DOEVENTS_INTERVAL then
should have been:
if (Timer - lngLast) > DOEVENTS_INTERVAL then

ok.. i have added the code...

Here is my FULL code page.

----------------Start Code----------------
Option Explicit
Option Base 0

'vars for Stop button
Private Const DOEVENTS_INTERVAL As Long = 500
Private m_blnStop As Boolean

Dim intSec As Integer, intMin As Integer

Private Sub cmdCleanAll_Click()

mnuClnSc01_Click
mnuClnSc02_Click
mnuClnSc03_Click
mnuClnSc04_Click
mnuClnSc05_Click
mnuClnSc06_Click
mnuClnSc07_Click
mnuClnSc08_Click

End Sub

Private Sub cmdCleanSel_Click()

timeRefresh.Enabled = False
intSec = 0
intMin = 0
pbar1.Visible = True
pbarTotal.Visible = True

Dim I
For I = 0 To 9
    If lstSelScanner.Selected(I) = True Then
    'clean scanner I
    Select Case I
        Case 0
            ClearScanner strSc01Path, intI840Days, int9500Days
        Case 1
            ClearScanner strSc02Path, intI840Days, int9500Days
        Case 2
            ClearScanner strSc03Path, intI840Days, int9500Days
        Case 3
            ClearScanner strSc04Path, intI840Days, int9500Days
        Case 4
            ClearScanner strSc05Path, intI840Days, int9500Days
        Case 5
            ClearScanner strSc06CPath, intI840Days, int9500Days
        Case 6
            ClearScanner strSc06DPath, intI840Days, int9500Days
        Case 7
            ClearScanner strSc07CPath, intI840Days, int9500Days
        Case 8
            ClearScanner strSc07DPath, intI840Days, int9500Days
        Case 9
            ClearScanner strSc08Path, intI840Days, int9500Days
    End Select
    Else
    End If
Next I

pbar1.Visible = False
pbarTotal.Visible = False
timeRefresh.Enabled = True

End Sub

Private Sub cmdRefresh_Click()

'Reset Timers
intMin = 0
intSec = 0
timeRefresh.Enabled = False
status1.SimpleText = "Refreshing Free Space..."
pbar1.Max = 10
pbar1.Value = 0

lstFreeSpace.Clear
pbar1.Visible = True

'Add Scanner Space to List box
RefreshSpace (strSc01Path)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc02Path)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc03Path)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc04Path)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc05Path)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc06CPath)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc06DPath)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc07CPath)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc07DPath)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

RefreshSpace (strSc08Path)
lstFreeSpace.AddItem (strFreeSpace)
pbar1.Value = pbar1.Value + 1

pbar1.Value = 0
status1.SimpleText = "Stopped."
timeRefresh.Enabled = True
pbar1.Visible = False

End Sub

Private Sub Command_Stop_Click()

m_blnStop = True

End Sub

Private Sub Form_Load()

'Set Default Paths
strDefaultSc01Path = "\\estsc01\imageroot\"
strDefaultSc02Path = "\\estsc02\imageroot\"
strDefaultSc03Path = "\\estsc03\imageroot\"
strDefaultSc04Path = "\\estsc04\imageroot\"
strDefaultSc05Path = "\\estsc05\imageroot\"
strDefaultSc06CPath = "\\estsc06\c\UHCTWAINScan\"
strDefaultSc06DPath = "\\estsc06\d\UHCTWAINScan\"
strDefaultSc07CPath = "\\estsc07\c\UHCTWAINScan\"
strDefaultSc07DPath = "\\estsc07\d\UHCTWAINScan\"
strDefaultSc08Path = "\\estsc08\imageroot\"

'Set Default Other Options
intDefaultRefreshTime = 1
intDefault9500Days = 5
intDefaultI840Days = 2

'Set other vars
Dim strRefreshTime As String
Dim str9500Days As String
Dim stri840Days As String

'Load Saved Settings
strSc01Path = GetSetting("Scanner Cleaner", "Options", "Sc01Path")
strSc02Path = GetSetting("Scanner Cleaner", "Options", "Sc02Path")
strSc03Path = GetSetting("Scanner Cleaner", "Options", "Sc03Path")
strSc04Path = GetSetting("Scanner Cleaner", "Options", "Sc04Path")
strSc05Path = GetSetting("Scanner Cleaner", "Options", "Sc05Path")
strSc06CPath = GetSetting("Scanner Cleaner", "Options", "Sc06CPath")
strSc06DPath = GetSetting("Scanner Cleaner", "Options", "Sc06DPath")
strSc07CPath = GetSetting("Scanner Cleaner", "Options", "Sc07CPath")
strSc07DPath = GetSetting("Scanner Cleaner", "Options", "Sc07DPath")
strSc08Path = GetSetting("Scanner Cleaner", "Options", "Sc08Path")
strRefreshTime = GetSetting("Scanner Cleaner", "Options", "RefreshTime")
str9500Days = GetSetting("Scanner Cleaner", "Options", "9500Days")
stri840Days = GetSetting("Scanner Cleaner", "Options", "i840Days")

'convert loaded strings to integers
If strRefreshTime = "" Then
    strRefreshTime = "0"
    intRefreshTime = CInt(strRefreshTime)
Else
intRefreshTime = CInt(strRefreshTime)
End If

If str9500Days = "" Then
    str9500Days = "0"
    int9500Days = CInt(str9500Days)
Else
int9500Days = CInt(str9500Days)
End If

If stri840Days = "" Then
    stri840Days = "0"
    intI840Days = CInt(stri840Days)
Else
intI840Days = CInt(stri840Days)
End If

intMin = 0
intSec = 0

cmdRefresh_Click

End Sub

Private Sub mnuCleanAll_Click()
cmdCleanAll_Click
End Sub

Private Sub mnuClnSc01_Click()
ClearScanner strSc01Path, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc02_Click()
ClearScanner strSc02Path, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc03_Click()
ClearScanner strSc03Path, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc04_Click()
ClearScanner strSc04Path, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc05_Click()
ClearScanner strSc05Path, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc06_Click()
ClearScanner strSc06CPath, intI840Days, int9500Days
ClearScanner strSc06DPath, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc07_Click()
ClearScanner strSc07CPath, intI840Days, int9500Days
ClearScanner strSc07DPath, intI840Days, int9500Days
End Sub

Private Sub mnuClnSc08_Click()
ClearScanner strSc08Path, intI840Days, int9500Days
End Sub

Private Sub mnuExit_Click()

End

End Sub

Private Sub mnuHelpWind_Click()

MsgBox ("Select the scanner from the left List Box then click Clean.  Need more help? NO!")

End Sub

Public Sub RefreshSpace(DrvPath)

'Get Scanner Space Left
    On Error GoTo NetworkError1
    Dim FreeSpace, a, b
    Set FreeSpace = CreateObject("Scripting.FileSystemObject")
    Set b = FreeSpace.GetDrive(FreeSpace.GetDriveName(DrvPath))
    a = a & FormatNumber(b.AvailableSpace / 1073768, 0)
    a = a & " Megabytes"
    strFreeSpace = a
       
NetworkError1:
    If Err.Number = 76 Then
        strFreeSpace = ": Scanner Down!"
    Else
    End If
End Sub

Public Sub ClearScanner(ScannerPath As String, i840Time As Integer, k9500Time As Integer)

Command_Stop.Enabled = True

Dim I As Integer, J As Integer, K As Integer
Dim DeletingFolder, c, d, e

If Now < #12:00:00 PM# Then
    i840Time = i840Time - 1
Else
End If

If ScannerPath = strSc06CPath Then
    varCurrentDate = DateAdd("d", -i840Time, Now)
ElseIf ScannerPath = strSc06DPath Then
    varCurrentDate = DateAdd("d", -i840Time, Now)
ElseIf ScannerPath = strSc07CPath Then
    varCurrentDate = DateAdd("d", -i840Time, Now)
ElseIf ScannerPath = strSc07DPath Then
    varCurrentDate = DateAdd("d", -i840Time, Now)
Else
varCurrentDate = DateAdd("d", -k9500Time, Now)
End If

pbar1.Visible = True
pbarTotal.Visible = True

'Set Directories
dirScanner.Path = ScannerPath
dirScanner.ListIndex = 0
fileScanner.Path = dirScanner.List(dirScanner.ListIndex)
'Set ProgressBars
pbar1.Value = 0
pbarTotal.Value = 0
If fileScanner.ListCount = 0 Then
    pbarTotal.Max = dirScanner.ListCount
    'Keep Deleting
Else
pbar1.Max = fileScanner.ListCount
pbarTotal.Max = dirScanner.ListCount
End If

'Get File and Dir List, then Delete
For I = 0 To dirScanner.ListCount - 1
    dirScanner.ListIndex = I
    'Setup FSO
    Set DeletingFolder = CreateObject("Scripting.FileSystemObject")
    Set c = DeletingFolder.GetFolder(dirScanner.List(I))
    'Get Date Created
    d = dirScanner.List(I) & " " & c.DateCreated
    varCurrentDirDate = c.DateCreated
    strDirToBeDeleted = dirScanner.List(I)
    'Compare Dir Dates
    For K = 0 To dirScanner.ListCount - 1
        If StopProcess = True Then
            Command_Stop.Enabled = False
            pbarTotal.Value = 0
            pbar1.Visible = False
            pbarTotal.Visible = False
            Command_Stop.Enabled = False
            Exit Sub
        End If
    Next K
    If varCurrentDate > varCurrentDirDate Then
        If pbarTotal.Value = pbarTotal.Max Then
            pbarTotal.Value = 0
            Else
            pbarTotal.Value = pbarTotal.Value + 1
        End If
        For K = 0 To dirScanner.ListCount - 1
            If StopProcess = True Then
                Command_Stop.Enabled = False
                pbarTotal.Value = 0
                pbar1.Visible = False
                pbarTotal.Visible = False
                Command_Stop.Enabled = False
                Exit Sub
            End If
        Next K
        For J = 0 To fileScanner.ListCount - 1
            fileScanner.ListIndex = J
            status1.SimpleText = "Deleting " & fileScanner.List(fileScanner.ListIndex)
            'DeletingFolder.DeleteFile (fileScanner.List(fileScanner.ListIndex)), True
            If pbar1.Value = pbar1.Max Then
                pbar1.Value = 0
            Else
                pbar1.Value = pbar1.Value + 1
            End If
            For K = 0 To fileScanner.ListCount - 1
                If StopProcess = True Then
                    Command_Stop.Enabled = False
                    pbarTotal.Value = 0
                    pbar1.Visible = False
                    pbarTotal.Visible = False
                    Command_Stop.Enabled = False
                    Exit Sub
                End If
            Next K
        Next J
        pbar1.Value = 0
        'DeletingFolder.DeleteFolder (dirScanner.List(dirScanner.ListIndex)), True
    Else
    End If
Next I

pbarTotal.Value = 0
pbar1.Visible = False
pbarTotal.Visible = False
Command_Stop.Enabled = False

End Sub

Private Sub mnuOptions_Click()

frmOptions.Show

End Sub

Private Sub timeRefresh_Timer()

'check sleeping time
intSec = intSec + 1
status1.SimpleText = "Waiting... (" & intSec & ")"
If intSec = 60 Then
    intSec = 0
    intMin = intMin + 1
    If intMin = intRefreshTime Then
        cmdRefresh_Click
    Else
    End If
End If

End Sub

Public Function StopProcess()

 Static lngLast As Long ' not sure if it's long

 ' Do not call doevents too often, it may slow down too
 ' much your application
 If (Timer - lngLast) > DOEVENTS_INTERVAL Then
   DoEvents
   ' It process event (like command button),
   ' so you app will not show "not responding"
   ' in task manager
   lngLast = Timer ' reset the flag
 End If
 StopProcess = m_blnStop

End Function

Private Sub class_initialize()
 m_blnStop = False
End Sub

----------------End Code----------------

It still acts as if it is "hung up" but it will stop after about 1 minute.  But i have the Delete command commented out for testing purposes.  So it might not really be stopping like it should.

Can you just explain some of that for me?
pretty confused on most of it.

Thanks.

Hi

You code is OK but there are 2 small errors in it ;)

the timer() will return a single value that holds "the seconds since midnight"

So since you store the next run as "long" you will actually only call doevents 500 seconds after the first run

Change the interval to a short and set it to 0.1 or so..

This will allow the user to interrupt the software in a resonable manner.

The setup Chimo gave you is very good... (most ppl call doevents every time the pass through a loop) You just need to change your longs to singels and it should work

Hope this helps...

Public Function StopProcess()

Static sLast As Single ' not sure if it's long

' Do not call doevents too often, it may slow down too
' much your application
If ((Timer - sLast) > (0.1)) or (Timer < sLast) Then
  '2nd test maks sure you call doevents after midnight
  DoEvents
  ' It process event (like command button),
  ' so you app will not show "not responding"
  ' in task manager
  sLast = Timer ' reset the flag
 
End If
StopProcess = m_blnStop

End Function


Hope this helps

it seems like it is working. but i wont know until there is actually a few folders to delete.  It doesnt appear locked up anymore.  but i still want to test the STOP button.  

i still dont understand how this is exactly working, but i will..  need too eh?

I will let you know.. more point will be added once i get them.. just sit tight..

thanks

whats not clear here ;) ?

just ask

it seems like it is working. but i wont know until there is actually a few folders to delete.  It doesnt appear locked up anymore.  but i still want to test the STOP button.  

i still dont understand how this is exactly working, but i will..  need too eh?

I will let you know.. more point will be added once i get them.. just sit tight..

thanks

I have modified your code.. but it works now..

thanks