dcsimg
Results 1 to 10 of 10

Thread: Know When A Group of Functions Are Done

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2018
    Posts
    4

    Know When A Group of Functions Are Done

    Hello,

    Is there a way to determine when multiple function calls are done?
    For example, I have a function myFunc(). Regardless of whether I call it one time, 10 times or 50 times, when it is done I get an alert saying that all one, 10, or 50 function calls are done.

    Thank you

  2. #2
    Frenzied Member
    Join Date
    Jun 2012
    Posts
    1,099

    Re: Know When A Group of Functions Are Done

    You could creater a helper function with an argument of how often myFunc should be called (Count As Long)
    Then in an For i...Next you call myFunc and at the end of the helper function you bring your alert.

  3. #3
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    556

    Re: Know When A Group of Functions Are Done

    Place inside that function Static var, increase it +1 on each call and check its value.
    Code:
    sub main()
      for i = 1 to 100
        foo()
      next
    end fub
    
    function foo()
      static c as long
      c = c +1
      if (c = 50) msgbox "alert"
    end function

  4. #4
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    12,526

    Re: Know When A Group of Functions Are Done

    I'm not sure what the OP is asking looking for. VB Functions are blocking the function is done when it returns and moves to the next line of code. As for knowing when several calls are done that all depends on how and when you are calling the function but the simple answer is the same. It is done when it returns since the programmer is determining where and how many times to call the function then programmer would determine where to put the signal that it is complete. If it is being called in a loop then after the loop exits all the calls are done. if it is being called from multiple places at multiple times then you may need to use a increment counter and check when its value meets your requirement.

    Now this is of course assuming you are talking about native VB functions. If you are talking API that or other that runs as async then the code does not wait for it to complete and you have a different situation.

  5. #5
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    17,450

    Re: Know When A Group of Functions Are Done

    @DataMiser, the OP posted another thread regarding async callbacks and I think this thread is related to it... execute async function n times and inform app when all n occurrences have been called backed to the app via a callback routine. If I'm on the right track, think of sending out n URL requests and wanting to know when all n pages have been loaded.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  6. #6

    Thread Starter
    New Member
    Join Date
    Jul 2018
    Posts
    4

    Re: Know When A Group of Functions Are Done

    Quote Originally Posted by LaVolpe View Post
    @DataMiser, the OP posted another thread regarding async callbacks and I think this thread is related to it... execute async function n times and inform app when all n occurrences have been called backed to the app via a callback routine. If I'm on the right track, think of sending out n URL requests and wanting to know when all n pages have been loaded.
    Yup, the two are indeed related. Because VBA doesn't have a way to anticipate the async callback, I want to populate a dictionary with all the results of the asynchronous calls. What I want to do is then call a function to parse that data out once the dictionary is populated by the async calls.

    The current iteration I have now parses the data out while some async calls are still being made. It's hectic and causes my excel to crash. What I'm trying to do is separate the process in hopes it will be more manageable.

  7. #7
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,825

    Re: Know When A Group of Functions Are Done

    i have a sample, written by someone else, using async pings,

    i believe the code does what you are asking
    it has some limit on the number of async operations at one time, and tracks which are still active
    i will see if i can find it again
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  8. #8

    Thread Starter
    New Member
    Join Date
    Jul 2018
    Posts
    4

    Re: Know When A Group of Functions Are Done

    Quote Originally Posted by westconn1 View Post
    i have a sample, written by someone else, using async pings,

    i believe the code does what you are asking
    it has some limit on the number of async operations at one time, and tracks which are still active
    i will see if i can find it again
    Really hope you can. That would be great!

  9. #9
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,825

    Re: Know When A Group of Functions Are Done

    ok, i will look tonight, i remember now it uses waitforsingleobject, to know when each task is done
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  10. #10
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,825

    Re: Know When A Group of Functions Are Done

    a class module
    Code:
    Option Explicit
    
    
    
    Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
    End Type
    
    Private Type ip_option_information
        ttl             As Byte 'Byte     'Time To Live
        Tos             As Byte     'Type Of Service
        Flags           As Byte     'IP header flags
        OptionsSize     As Byte     'Size in bytes of options data
        OptionsData     As Long     'Pointer to options data
    End Type
    
    Private Type ICMP_ECHO_REPLY
        Address         As Long
        Status          As Long
        RoundTripTime   As Long
        datasize        As Long 'formerly integer
       'Reserved        As Integer
        DataPointer     As Long
        Options         As ip_option_information
        Data            As String * 250
    End Type
    
    Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
    Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long
    Private Declare Function inet_addr Lib "wsock32" (ByVal s As String) As Long
    
    Private Declare Function IcmpSendEcho2 Lib "icmp.dll" (ByVal IcmpHandle As Long, ByVal hEvent As Long, ByVal ApcRoutine As Any, ByVal ApcContext As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, ByVal ReplyBuffer As Long, ByVal ReplySize As Long, ByVal TimeOut As Long) As Long
    
    Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
    'Private Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long
    'Private Declare Function WaitForMultipleObjectsArray Lib "kernel32" Alias "WaitForMultipleObjects" (ByVal nCount As Long, lpHandles() As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long
    Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    
    
    Private Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    
    
    Private Const WAIT_OBJECT_0 As Long = 0
    Private Const WAIT_TIMEOUT As Long = &H102
    Private Const WAIT_ABANDONED = &H80
    Private Const WAIT_FAILED = -1&
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    
    Public Event PingSuccess(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
    Public Event PingFail(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
    
    Private mvarNumParalellActions As Long
    Private mvarListPingRunning As Boolean
    
    Public Property Let NumParalellActions(ByVal NewData As Long)
        mvarNumParalellActions = NewData
    End Property
    Public Property Get NumParalellActions() As Long
        NumParalellActions = mvarNumParalellActions
    End Property
    
    Public Property Get ListPingRunning() As Boolean
        ListPingRunning = mvarListPingRunning
    End Property
    
    Public Function PingHostSingle(sHostIP As String, TimeOut As Long) As Long
    Const sSendData As String = "TESTMESSAGE"
    Dim Buffer As ICMP_ECHO_REPLY
    Dim lhwndPort As Long
    Dim hEvent As Long
    Dim sd As SECURITY_ATTRIBUTES
    Dim WaitRes As Long
    Dim tm1 As Long, tm2 As Long
    
        '//needed for Create Event
        With sd
            .nLength = Len(sd) 'we pass the length of sd
            .lpSecurityDescriptor = 0
            .bInheritHandle = 0
        End With
    
        '//We create an Event-ID to be registered with IcmpSendEcho2 and WaitForMultipleObjects to wait for
        hEvent = CreateEvent(sd, True, False, "PINGV2")
    
        lhwndPort = IcmpCreateFile()    '//Standard for ICMP, create a handle
        
        Call IcmpSendEcho2(lhwndPort, hEvent, Nothing, 0, inet_addr(sHostIP), sSendData, Len(sSendData), 0, VarPtr(Buffer), Len(Buffer), 1000)
    
        '//Gere we start to wait
        tm1 = GetTickCount()
        Do
            WaitRes = WaitForSingleObject(hEvent, 5) ' WaitForMultipleObjects(1, hEvent, 1, 10)
            tm2 = GetTickCount
            DoEvents
            If (tm2 - tm1) < 1000 Then
                Select Case WaitRes
                    Case WAIT_ABANDONED, WAIT_FAILED
                        DoEvents
                        PingHostSingle = -2
                        Exit Do
                    Case WAIT_OBJECT_0
                        If Buffer.Status = 0 Then
                            PingHostSingle = Buffer.RoundTripTime
                        Else
                            PingHostSingle = -1
                        End If
                        Exit Do
    '//Cause were in a loop, this message will not work for us
    '                Case WAIT_TIMEOUT
                End Select
                DoEvents
            Else
                DoEvents
                PingHostSingle = -1
                Exit Do
            End If
        Loop While (1)
        '//And clear all created things
        ResetEvent hEvent
        IcmpCloseHandle lhwndPort
    End Function
    
    
    Public Function PingHostList(saIpAdresses() As String, TimeOutHost As Long, TimeOutAll As Long) As Boolean
    Dim NumAdresses As Long
    Dim laHandlesICMP() As Long
    Dim laEvents() As Long
    Dim laTimerStart() As Long
    Dim laTimerSop() As Long
    Dim laWaitResults() As Long
    Dim bUseResult() As Boolean
    Dim baEchoSend() As Boolean
    Dim aBuffers() As ICMP_ECHO_REPLY
    Dim bProcessed() As Integer
    Dim nProcessed As Long
    Dim nLoop As Long
    Dim baInitiated() As Boolean
    Dim TimerStart As Long
    Dim Timerstop As Long
    
    Dim Buffer As ICMP_ECHO_REPLY
    Dim sd As SECURITY_ATTRIBUTES
    Const sSendData As String = "PINGDATAMESSAGE"
    Dim WaitRes As Long
    
    Dim nStart As Long, nEnd As Long, BoundCtr As Long
    
        '//Prevent from reentry
        If mvarListPingRunning = True Then
            PingHostList = False
            Exit Function
        End If
        mvarListPingRunning = True
        NumAdresses = UBound(saIpAdresses)
    '//init the needed arrays
        ReDim laHandlesICMP(NumAdresses)
        ReDim laEvents(NumAdresses)
        ReDim laTimerStart(NumAdresses)
        ReDim laTimerSop(NumAdresses)
        ReDim laWaitResults(NumAdresses)
        ReDim baEchoSend(NumAdresses)
        ReDim aBuffers(NumAdresses)
        ReDim bProcessed(NumAdresses)
        
        '//needed for Create Event
        With sd
            .nLength = Len(sd) 'we pass the length of sd
            .lpSecurityDescriptor = 0
            .bInheritHandle = 0
        End With
        
        For nLoop = 0 To NumAdresses - 1
            '//We create an Event for WaitForMultipleObjects to wait for
            laEvents(nLoop) = CreateEvent(sd, True, False, "PINGV2C" & nLoop)
            laHandlesICMP(nLoop) = IcmpCreateFile()    '//Standard for ICMP
        Next
        TimerStart = GetTickCount
        nProcessed = 0  '//Reset Counter for processed hosts
        nStart = 0
        If NumAdresses > mvarNumParalellActions Then
            nEnd = mvarNumParalellActions
        Else
            nEnd = NumAdresses - 1
        End If
        BoundCtr = 0
        Do
            For nLoop = nStart To nEnd
                '//Did we already request an echo
                If baEchoSend(nLoop) = False Then
                    baEchoSend(nLoop) = True    '//Lock this adress, so we don't create a second Ping
                    Call IcmpSendEcho2(laHandlesICMP(nLoop), laEvents(nLoop), Nothing, 0, inet_addr(saIpAdresses(nLoop)), sSendData, Len(sSendData), 0, VarPtr(aBuffers(nLoop)), Len(aBuffers(nLoop)), TimeOutHost)
                End If
                If bProcessed(nLoop) = False Then
                    laWaitResults(nLoop) = WaitForSingleObject(laEvents(nLoop), 5) '//We wait only for 5 Millisecs, to give all the other IPs Time to answer
                    Select Case laWaitResults(nLoop)
                        Case WAIT_ABANDONED, WAIT_FAILED
                            DoEvents
                            bProcessed(nLoop) = -1
                            nProcessed = nProcessed + 1
                            BoundCtr = BoundCtr + 1
                        Case WAIT_OBJECT_0
                            bProcessed(nLoop) = 1
                            nProcessed = nProcessed + 1
                            BoundCtr = BoundCtr + 1
                            If aBuffers(nLoop).Status = 0 Then
                                '//Valid Info : So Host is reachable
                                RaiseEvent PingSuccess(saIpAdresses(nLoop), aBuffers(nLoop).RoundTripTime, nLoop)
                            Else
                                RaiseEvent PingFail(saIpAdresses(nLoop), -1, nLoop)
                            End If
        '//Cause were in a loop, this message will not work for us
    '                    Case WAIT_TIMEOUT
                            'bProcessed(nLoop) = -1
                    End Select
                    End If
                    DoEvents
                Next
            Timerstop = GetTickCount
            If (Timerstop - TimerStart) < TimeOutAll Then
                '
            Else
                DoEvents
                Debug.Print "TIMED OUT"
                Exit Do
            End If
            '//All done, no more Action needed
            If nProcessed >= NumAdresses - 1 Then
                Exit Do
            End If
            If nEnd < NumAdresses And BoundCtr >= mvarNumParalellActions Then
                nStart = nEnd + 1
                nEnd = nEnd + mvarNumParalellActions
                If nEnd > NumAdresses - 1 Then nEnd = NumAdresses - 1
                BoundCtr = 0
                Debug.Print "New bounds :"; nStart, nEnd, Time
            End If
        Loop While (1)
            
    '//IMPORTANT : UNregister all messages/Evemnts and open ICMP-handles
        For nLoop = 0 To NumAdresses - 1
            ResetEvent laEvents(nLoop)
            IcmpCloseHandle (laHandlesICMP(nLoop))
            If bProcessed(nLoop) <= 0 Then
                '//notify caller with the rest of the host, that we haven't hit
                RaiseEvent PingFail(saIpAdresses(nLoop), -1, nLoop)
            End If
        Next
    '//And we free up some memory
        Erase laHandlesICMP
        Erase laEvents
        Erase laTimerStart
        Erase laTimerSop
        Erase laWaitResults
        Erase baEchoSend
        Erase aBuffers
        Erase bProcessed
        mvarListPingRunning = False
    End Function
    
    
    Private Sub Class_Initialize()
        mvarNumParalellActions = 500
    End Sub
    the calling form (results went to a list box)
    Code:
    Private WithEvents m_clsPingBase As ClassPingBase
    Private m_bFirstRun As Boolean
    
    Private Sub btnPingAsync_Click()
    Dim saAdresses() As String, n As Integer
    Dim tm1 As Long, tm2 As Long, mystr As String
        
        btnPingAsync.Enabled = False
        ReDim saAdresses(LV_IPs.ListItems.Count)
        For n = 1 To LV_IPs.ListItems.Count
            '//Store value
            If LV_IPs.ListItems(n).SubItems(1) = "---" Then
                LV_IPs.ListItems(n).ListSubItems(1).Tag = -1
            Else
                If Len(LV_IPs.ListItems(n).SubItems(1)) Then
                    LV_IPs.ListItems(n).ListSubItems(1).Tag = LV_IPs.ListItems(n).ListSubItems(1).Text
                End If
            End If
            LV_IPs.ListItems(n).SubItems(1) = ""
            saAdresses(n - 1) = LV_IPs.ListItems(n).Text
        Next
        tm1 = GetTickCount()
        m_clsPingBase.NumParalellActions = 1000
        m_clsPingBase.PingHostList saAdresses, 100, (LV_IPs.ListItems.Count * 100) / 2
        btnPingAsync.Enabled = True
        tm2 = GetTickCount()
        m_bFirstRun = True
        Dim w, ns
        Set w = CreateObject("wscript.shell")
        For n = 1 To LV_IPs.ListItems.Count
        
        If Not LV_IPs.ListItems(n).SubItems(1) = "---" Then
            Set ns = w.exec("nslookup " & LV_IPs.ListItems(n))
            
            mystr = mystr & LV_IPs.ListItems(n) & vbTab & Replace(ns.stdout.readall, vbNewLine, vbTab) & vbNewLine
        End If
        Next
        
        Open App.Path & "\pinged.txt" For Output As 1
        Print #1, mystr
        Close 1
    '    MsgBox Format((tm2 - tm1) / 1000, "0.00") & " secs", , "Time needed"
    End Sub
    
    Private Sub m_clsPingBase_PingFail(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
        LV_IPs.ListItems(ArrayIndex + 1).SubItems(1) = "---"
        LV_IPs.ListItems.Item(ArrayIndex + 1).SmallIcon = 2
        If m_bFirstRun Then
            If LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).Tag <> -1 Then
                '//Notify state change
                LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).ReportIcon = 4
            End If
        End If
    End Sub
    
    Private Sub m_clsPingBase_PingSuccess(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
        LV_IPs.ListItems(ArrayIndex + 1).SubItems(1) = lNewStatus
        LV_IPs.ListItems(ArrayIndex + 1).EnsureVisible
        LV_IPs.ListItems.Item(ArrayIndex + 1).SmallIcon = 1
        If m_bFirstRun Then
            If LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).Tag = -1 Then
                '//Notify state change
                LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).ReportIcon = 3
            End If
        
        End If
    End Sub
    i hope you can figure something out from this, i have played with it and tested a bit, but i am certainly no expert with the code here, does appear to work correctly though
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width