ActiveX exe... (exe problem) [SOLVED]

[CVMichael]

Hi...

I've made an ActiveX exe called MikeClasses, currentrly with one class in it, and a test progam to test my ActiveX.

The problem is that when I compile the ActiveX and run my test program, the CPU goes to 95% and it does nothing... (And my test program DOES have a reference to the AcriveX exe)

But... when I run the ActiveX from another instance of VB, it works perfectly... (This time, my test program has a reference to the MikeClasses.VBP project)

Anyone had this problem that knows how to fix it ?
How can I get it to work when the ActiveX is compiled ?

Thanks

[mlewis]

Try writing a simple Log() function (or use the App object's built in logging function) and putting calls to the log code in your class. Log when you enter and exit functions, when you enter loops, and so on. Then compile and run the program and use the generated log to figure out where its getting stuck. Once you have that nailed down, post the code and I'll take a look [or just figure it out on your own if its simple].

[CVMichael]

Ok.... it's a bit odd, because it does not make sense to get stuck in the exe and not in the VB environment...

Anyways... I did the log thing, and I found the function where it stops...

Private Type WordType
    Word As String
    Occ As Integer
End Type
 
Private Function ExtractKeywords(ByRef Str As String) As String
    Dim AR() As String, WA() As WordType, IND As Variant
    Dim K As Long, Keywords As String
    
    If Str = "" Then Exit Function
SEvent 18
    AR = Split(Str, " ")
    For Each IND In AR
        If CStr(IND) <> "" Then
            On Error GoTo Err_Resize
            For K = 0 To UBound(WA)
                If StrComp(IND, WA(K).Word, vbTextCompare) = 0 Then Exit For
            Next K
            
            If K > UBound(WA) Then
                If WA(UBound(WA)).Word <> "" Then ReDim Preserve WA(UBound(WA) + 1)
                WA(UBound(WA)).Word = IND
            Else
                WA(K).Occ = WA(K).Occ + 1
            End If
            On Error GoTo 0
        End If
    Next IND
SEvent 19
    Erase AR
    
    QuickSort WA, LBound(WA), UBound(WA)
SEvent 20
    For K = UBound(WA) To LBound(WA) Step -1
        Keywords = Keywords & " " & WA(K).Word
    Next K
SEvent 21
    ExtractKeywords = Keywords
    Exit Function
Err_Resize:
    If Err.Number = 9 Then
        ReDim WA(0)
        Resume Next
    End If
End Function

The SEvent # is the function that writes the log.... it goes up to event 18, it never reaches 19...

But... i really don't understand... it works perfectly in VB environment...

[mlewis]

OK.. try dropping in a few MsgBox calls at various points, like inside your loop, in the error handler, etc. and watch the behavior of the function. Try and figure out if its getting in an infinite loop, or stuck in the error handler, or what.

[CVMichael]

I've added more events to log, it's a bit more confuzing now...

Private Function ExtractKeywords(ByRef Str As String) As String
    Dim AR() As String, WA() As WordType, Q As Long
    Dim K As Long, Keywords As String
    
    If Str = "" Then Exit Function
SEvent 18
    AR = Split(Str, " ")
SEvent 19
SEvent UBound(AR)
    For Q = 0 To UBound(AR)
SEvent 40
        If CStr(AR(Q)) <> "" Then
            On Error GoTo Err_Resize
SEvent 41
            For K = 0 To UBound(WA)
SEvent 50
SEvent UBound(WA)
                If StrComp(AR(Q), WA(K).Word, vbTextCompare) = 0 Then
SEvent 60
                    Exit For
                End If
SEvent 51
            Next K
SEvent 42
            If K > UBound(WA) Then
                If WA(UBound(WA)).Word <> "" Then ReDim Preserve WA(UBound(WA) + 1)
                WA(UBound(WA)).Word = AR(Q)
            Else
                WA(K).Occ = WA(K).Occ + 1
            End If
SEvent 43
            On Error GoTo 0
        End If
SEvent 44
    Next Q
SEvent 20
    Erase AR
    
    QuickSort WA, LBound(WA), UBound(WA)
SEvent 21
    For K = UBound(WA) To LBound(WA) Step -1
        Keywords = Keywords & " " & WA(K).Word
    Next K
SEvent 22
    ExtractKeywords = Keywords
    
    Exit Function
Err_Resize:
SEvent 30
    If Err.Number = 9 Then
        ReDim WA(0)
SEvent 31
        Resume Next
    End If
End Function

And this is the output I get...

EVENT ID: 18
EVENT ID: 19
EVENT ID: 342
EVENT ID: 40
EVENT ID: 41
EVENT ID: 30
EVENT ID: 31
EVENT ID: 50
EVENT ID: 0
EVENT ID: 51
EVENT ID: 50
EVENT ID: 0
EVENT ID: 51
EVENT ID: 50
EVENT ID: 0
EVENT ID: 51
EVENT ID: 50
EVENT ID: 0
EVENT ID: 51
EVENT ID: 50
EVENT ID: 0
EVENT ID: 51
EVENT ID: 50
EVENT ID: 0
EVENT ID: 51

And it reapeats this to the infinite... (until I Ctrl+Alt+Del and stop the exe)

EVENT ID: 50
EVENT ID: 0
EVENT ID: 51

Now when you have a for loop "For K = 0 To 0" isn't it supposed to STOP !!!

What's going on ???

[mlewis]

Strange... are you compiling with something like "remove array bounds checks" or some other optimizations? Sometimes those can cause odd behavior..

[CVMichael]

I fixed it !!!

And no... no optimizations... I've left the defaults actually (i've only changed the ActiveX exe to "Thread per Object" setting, that's the only setting i've changed.

I declared a long variable UB and I assigned the upper bound before the for loop. That fixed the problem, now my exe runs the same way as if in the VB environment.

But.... this was the strangest problem I've ever had since I program in VB (for 5 years)

Private Function ExtractKeywords(ByRef Str As String) As String
    Dim AR() As String, WA() As WordType, Q As Long, UB As Long
    Dim K As Long, Keywords As String
    
    If Str = "" Then Exit Function
    
    AR = Split(Str, " ")
    
    For Q = 0 To UBound(AR)
        If CStr(AR(Q)) <> "" Then
            On Error GoTo Err_Resize
            
            UB = UBound(WA)
            For K = 0 To UB
                If StrComp(AR(Q), WA(K).Word, vbTextCompare) = 0 Then Exit For
            Next K
            
            If K > UBound(WA) Then
                If WA(UBound(WA)).Word <> "" Then ReDim Preserve WA(UBound(WA) + 1)
                WA(UBound(WA)).Word = AR(Q)
            Else
                WA(K).Occ = WA(K).Occ + 1
            End If
            
            On Error GoTo 0
        End If
    Next Q
 
' the rest of the code.....

Thanks for your help, mlewis