?
Solved

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

Posted on 2003-03-18
10
Medium Priority
?
197 Views
Last Modified: 2008-01-16
ok here goes.

I am still new to VB. i know the basics.  I have a program that uses FSO to delete folders off of about 8 computers.  If the folders are older then "now" minus 5 days then it deletes the folders.  But my problem is, the user cant tell that the program is doing anything when they hit the button to clear the computers.  The program appears to be "Not Responding".  I need to know if there is a way to shwo the user it is working.  I have a Statusbar on the bottom that show what file is being deleted, and progress bars, but they are the only thing that moves. Other then that, the program appears to be "locked up".  I also want to know if there is a way to make a STOP button.  I WILL add more points, but this is all i have at the moment.  (if this question requires a lot more points. just give me a suggestion and it will see what i can do.)

-----Start Code-----

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

Dim I As Integer, J 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
    If varCurrentDate > varCurrentDirDate Then
        If pbarTotal.Value = pbarTotal.Max Then
            pbarTotal.Value = 0
            Else
            pbarTotal.Value = pbarTotal.Value + 1
        End If
        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
        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

End Sub

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

Is there a way to interrupt the For...Next loops?  I was reading about a DoEvents but the MSDN library doesnt help me much.  Can some one explain how to stop the loop, execute other code (caused my user input, ex. a STOP button) and resume the code if needed?

I only have these points right now, but more WILL be givin.  

MUCH thanks....


0
Comment
Question by:kmorris1186
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
  • 2
10 Comments
 

Accepted Solution

by:
Chimo earned 140 total points
ID: 8163952
I do not have tested the code, but I think it do what your looking for.

private const DOEVENTS_INTERVAL as long = you chose the interval, but not too small
private m_blnStop as boolean

public sub Command_Stop_Click()
  m_blnStop = true
end sub

Public Sub ClearScanner(ScannerPath As String, i840Time As Integer, k9500Time As Integer)
  ' ... your code
  ' Get File and Dir List, then Delete
  For I = 0 To dirScanner.ListCount - 1
    If StopProcess then
      exit sub
    End If
    ' ... your code
  next
end sub

private 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 sub

private sub class_initialize()
  m_blnStop = false
end sub



0
 
LVL 7

Author Comment

by:kmorris1186
ID: 8164006
trying it now.

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

Thanks.
0
 

Expert Comment

by:Chimo
ID: 8164047
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
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 7

Author Comment

by:kmorris1186
ID: 8164093
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.
0
 
LVL 11

Expert Comment

by:rdrunner
ID: 8165571
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...
0
 
LVL 11

Expert Comment

by:rdrunner
ID: 8165591
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
0
 
LVL 7

Author Comment

by:kmorris1186
ID: 8168891
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
0
 
LVL 11

Expert Comment

by:rdrunner
ID: 8169144
whats not clear here ;) ?

just ask
0
 
LVL 7

Author Comment

by:kmorris1186
ID: 8169227
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
0
 
LVL 7

Author Comment

by:kmorris1186
ID: 8184191
I have modified your code.. but it works now..

thanks
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month11 days, 2 hours left to enroll

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question