Multi threading in Visual Basic 6.0

[chandanrajah]

Hi,

I have a very perticular problem.

I have one form which activates and ftp process to download some files froma server. While the ftp is going on this form has a label that gets updated with the status.

To allow a yuser to cancel I have added a cancel button. But, the problem is that the control now lies with the sub-program that is carrying out the ftp, so the user can't click on any buttons.

I tried to use threads but, I just couldn't figure out how to send a message from one thread to another asking the latter to terminate. Or, even if the parent thread kills the child thread, it is fine.

Please, do help... I'm at the verge on banging my head real hard on my monitor.

I have attaching a piece of code.... in the form: frmTransfer, I have a command button, which when clicked sets the flag: ftpFlag = True

In the form: frmTranfer

Private Sub Form_Load()
    MyPath = CurDir
    
    ftpThreadHandle = CreateThread(0, _
                                0, _
                                AddressOf FtpModule.ftp, _
                                0, _
                                0, ftpThreadID)

    If (ftpThreadHandle = 0) Then
        Debug.Print "ERROR: Creating thread"
        Exit Sub
    End If
    
    CloseHandle ftpThreadHandle
    
    ftpFlag = False
End Sub

In the Mocdule: ftpModule

Public Sub ftp()
    Dim blnRC As Boolean
    Dim pData As WIN32_FIND_DATA
    Dim lngHINet As Long
    Dim intError As Integer
    Dim strTemp As String
    
    'init the filename buffer
    pData.cFileName = String(260, 0)
    Dim i As Integer
    'get the first file in the directory...
    Dim transferF As Boolean
    Dim transferT As Boolean
    Dim file As String
    Dim lngINetConn As Long
    
    lngINetConn = frmValidation.getFtpSession()
    
    ' The event index after wait
    Dim lIndex As Long
    
    Dim localPath As String
    Dim localPathTemp As String
        
    frmTransfer.setPathTempFiles (frmTransfer.getMyPath() & "\..\Performance_Data_Temp_Files\")
    
    localPathTemp = frmTransfer.getPathTempFiles()
    
    Debug.Print FileName(frmMain.cmbRType.Text) & "this Is FileNam"
    
    For i = 0 To UBound(Filter)
'        ' -----------------------------------------
'        ' Wait for some event to occur
        If (ftpFlag) Then
            InternetCloseHandle lngHINet
            Unload frmTransfer
            Exit Sub
        End If
'        ' -----------------------------------------
        Debug.Print "B4 1st ftp"
        lngHINet = FtpFindFirstFile(lngINetConn, "/santera/space/Santera/perfdata/" & FileName(frmMain.cmbRType.Text) & "." & Filter(i) & "*", pData, 0, 0)
        Debug.Print "After 1st ftp"
'        ' -----------------------------------------
'        ' Wait for some event to occur
        If (ftpFlag) Then
            InternetCloseHandle lngHINet
            Unload frmTransfer
            Exit Sub
        End If
'        ' -----------------------------------------
        
        If lngHINet = 0 Then
            'get the error from the findfirst call
            ' Me.Refresh
            
            '     Sleep (2000)
            intError = Err.LastDllError
            ' MsgBox "error in dll " & intError
            'is the directory empty?
            If intError <> 18 Then    'ERROR_NO_MORE_FILES Then
                MsgBox "Error in Dll Files & No FTP Session", vbExclamation, "SanteraOne"
                End
            End If
        Else
            'we got some dir info...
            'get the name
            transferT = True
            strTemp = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            file = localPathTemp & strTemp
            Debug.Print file & " file is stored"
            
'            ' -----------------------------------------
'            ' Wait for some event to occur
            If (ftpFlag) Then
                InternetCloseHandle lngHINet
                Unload frmTransfer
                Exit Sub
            End If
'            ' -----------------------------------------
            Debug.Print "B4 2nd ftp"
            blnRC = FtpGetFile(lngINetConn, "/santera/space/Santera/perfdata/" & strTemp, file, 0, 0, 1, 0)
            Debug.Print "After 2nd ftp"
'            ' -----------------------------------------
'            ' Wait for some event to occur
            If (ftpFlag) Then
                InternetCloseHandle lngHINet
                Unload frmTransfer
                Exit Sub
            End If
'            ' -----------------------------------------
            
            'MsgBox ("value is" & blnRC)
            '…store the file info someplace…
            'now loop through the rest of the files...
            Do
                'init the filename buffer
                pData.cFileName = String(260, 0)
                'get the next item
                
'                ' -----------------------------------------
'                ' Wait for some event to occur
                If (ftpFlag) Then
                    InternetCloseHandle lngHINet
                    Unload frmTransfer
                    Exit Sub
                End If
'                ' -----------------------------------------
                Debug.Print "B4 3rd ftp"
                blnRC = InternetFindNextFile(lngHINet, pData)
                Debug.Print "After 3rd ftp"
'                ' -----------------------------------------
'                ' Wait for some event to occur
                If (ftpFlag) Then
                    InternetCloseHandle lngHINet
                    Unload frmTransfer
                    Exit Sub
                End If
'                ' -----------------------------------------
                
                If Not blnRC Then
                    Debug.Print blnRC
                    'get the error from the findnext call
                    intError = Err.LastDllError
                    'no more items
                    If intError <> 18 Then
                        'whoa...a real error
                        transferF = False
                        MsgBox "Error in Dll Files & No FTP Session", vbExclamation, "SanteraOne"
                        End
                        Exit Do
                    Else
                        Exit Do
                    End If
                Else
                     'get the last item returned
                    transferT = True
                    strTemp = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
                    
                    file = localPathTemp & strTemp
                    Debug.Print file
                    
'                    ' -----------------------------------------
'                    ' Wait for some event to occur
                    If (ftpFlag) Then
                        InternetCloseHandle lngHINet
                        Unload frmTransfer
                        Exit Sub
                    End If
'                    ' -----------------------------------------
                    Debug.Print "B4 4th ftp"
                    blnRC = FtpGetFile(lngINetConn, "/santera/space/Santera/perfdata/" & strTemp, file, 0, 0, 1, 0)
                    Debug.Print "After 4th ftp"
'                    ' -----------------------------------------
'                    ' Wait for some event to occur
                    If (ftpFlag) Then
                        InternetCloseHandle lngHINet
                        Unload frmTransfer
                        Exit Sub
                    End If
'                    ' -----------------------------------------
                    '        …store the file info someplace…
                End If
            Loop
            
            'close the handle for the dir listing
            InternetCloseHandle lngHINet
        End If
    Next i
    
    frmMain.File1.Refresh
    If transferT Or transferF Then
        frmTransfer.Label1.Caption = "Data Importing Completed"
    Else
        frmTransfer.Label1.Caption = " No Data To Import"
        frmTransfer.Show
    End If
End Sub

Cheers,
--- Chandan !!!!!!!!!!

[Cander]

Do not try Multi threading in VB6. VB6 does not support it and the API's used for it are usntable at best.

What you need to do is, is put a DoEvents in the loop you are proabably using. Now you can click on the Cancel button. In the button set a public variable in a module to some value and let the loop check for that value and exit itself when it see's it.