Help ?!?!

Just added a new module to one of my projects which came from pscode.com , to make clickable links in a rtb. And allthough it does its job... and does what it is supposed to. Whenever i run the project from "debug" mode, and stop/or close the running instance, it closes vb as well....... anyone have any idea why this is happening?? the code in the module is as follows...

Code:

---

Option Explicit

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_NOTIFY = &H4E
Public Const WM_LBUTTONDOWN = &H201
Public Const EM_GETEVENTMASK = WM_USER + 59
Public Const EM_GETTEXTRANGE = WM_USER + 75

Public Const EM_SETEVENTMASK = WM_USER + 69
Public Const EM_AUTOURLDETECT = WM_USER + 91
Public Const EN_LINK = &H70B

Public Const ENM_LINK = &H4000000
Public Const SW_SHOWNORMAL = 1

Type tagNMHDR
    hwndFrom As Long
    idFrom  As Long
    code    As Long
End Type

Type CHARRANGE
    cpMin As Long
    cpMax As Long
End Type

Type ENLINK
    nmhdr  As tagNMHDR
    msg    As Long
    wParam As Long
    lParam As Long
    chrg  As CHARRANGE
End Type

Type TEXTRANGE
    chrg      As CHARRANGE
    lpstrText As Long
End Type

Public glnglpOriginalWndProc As Long
Public glngOriginalhWnd As Long

Function RichTextBoxSubProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim udtNMHDR              As tagNMHDR
Dim udtENLINK              As ENLINK
Dim udtTEXTRANGE          As TEXTRANGE
Dim strBuffer              As String * 128
Dim strOperation          As String
Dim strFileName            As String
Dim strDefaultDirectory    As String
Dim lngHInstanceExecutable As Long
Dim lngWin32apiResultCode  As Long
 
 
 If uMsg = WM_NOTIFY Then
    RtlMoveMemory udtNMHDR, ByVal lParam, Len(udtNMHDR)
    If udtNMHDR.hwndFrom = Form1.RichTextBox1.hwnd And udtNMHDR.code = EN_LINK Then
        RtlMoveMemory udtENLINK, ByVal lParam, Len(udtENLINK)
        If udtENLINK.msg = WM_LBUTTONDOWN Then
            strBuffer = ""
           
            With udtTEXTRANGE
                .chrg.cpMin = udtENLINK.chrg.cpMin
                .chrg.cpMax = udtENLINK.chrg.cpMax
                .lpstrText = StrPtr(strBuffer)
            End With
 
            With Form1.RichTextBox1
                lngWin32apiResultCode = SendMessage(.hwnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE)
            End With

            RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer)
            strOperation = "open"
            strFileName = strBuffer
            lngHInstanceExecutable = ShellExecute(Form1.hwnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL)

        End If
    End If
End If
 
RichTextBoxSubProc = CallWindowProc(glnglpOriginalWndProc, hwnd, uMsg, wParam, lParam)

End Function

---

Thanks in advance for any help you may be able to provide

Just in case it is needed..... here is the code to call the mod into action...

Code:

---

Private Sub Form_Load()

Dim lngEventMask  As Long
Dim lngWin32apiResultCode As Long

With RichTextBox1
   
    .Text = ""
    lngEventMask = SendMessage(.hwnd, EM_GETEVENTMASK, 0, ByVal CLng(0))
   
    If lngEventMask Xor ENM_LINK Then
        lngEventMask = lngEventMask Or ENM_LINK
    End If

    lngWin32apiResultCode = SendMessage(.hwnd, EM_SETEVENTMASK, 0, ByVal CLng(lngEventMask))
    lngWin32apiResultCode = SendMessage(.hwnd, EM_AUTOURLDETECT, CLng(1), ByVal CLng(0))
    .Text = "hello this is a test." & vbCrLf & "this is a link http://www.google.com" & " here." & vbCrLf & _
        "http://www.microsoft.com/" & vbNewLine & "mailto:[email protected]" & vbNewLine & "ftp://ftp.microsoft.com/" & vbCrLf & " this is the end."

End With

glngOriginalhWnd = Me.hwnd

glnglpOriginalWndProc = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)

End Sub

---

Yes, because you are subclassing. When you subclass, you should never end the program from the VBs END button. Always use the Unload Routine to do your clear ups.

Quote:

---

Originally Posted by some1uk03

Yes, because you are subclassing. When you subclass, you should never end the program from the VBs END button. Always use the Unload Routine to do your clear ups.

---

As someluk03 pointed out above, you should also unsubclass the form before you unload your form, if not done sooner.

ok any chance someone could give me a example of such?
i have at the form unload function

Code:

---

Private Sub Form_Unload(Cancel As Integer)

Dim lngWin32apiResultCode As Long

lngWin32apiResultCode = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, glnglpOriginalWndProc)

End Sub

---

Ok, you are unsubclassing the form on unload, you shouldn't get any crashes if you run your project and close it normally (i.e., pressing the X close button or pressing Alt+F4).

When uncompiled, and if any of the following occurs before the form is unsubclassed...

1. If you get an error or pause the code in the RichTextBoxSubProc function, you will crash.

2. If you get an error anywhere else and get that debug error window popup, if you click the End button, you will crash. Even if you hit the Debug button, you will probably crash.

3. If you use an END statement in your code before the form is unsubclassed, crash.

4. If you close your project by pressing the blue square End button on the IDE toolbar, crash.

So you can see, that subclassing in IDE is risky, always has been. There are some advanced classes and tools out there to help make subclassing in IDE about 99% safe.

ah ok, indeed sounds pretty hazardous lol,i have had a few crashes that i cleared up from it before it would close everything but is still doing the same thing without any errors, i guess it kinda makes sense though, thanks for the quick and cortueous reply, .... i guess the next question would be... is there any way to do link detection in a rtb safely then?

Recommendation: Toggle subclassing. Since you are comfortable that the hyperlinks are working, don't subclass until you want to test that functionality again. Before you compile the application to an exe ensure you toggle subclassing on.

1. In your form's declaration section, add this: Dim bSubclass As Boolean
2. Tweak your Form_Load to

Code:

---

bSubclass = False ' change to True to activate subclassing; when activated hope no errors & don't hit End

' your other code
...

If bSubclass Then
  glngOriginalhWnd = Me.hwnd
  glnglpOriginalWndProc = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)
End If

....

---

3. Your Form_Unload...

Code:

---

If bSubclass Then
    bSubclass = False
    SetWindowLong glngOriginalhWnd, GWL_WNDPROC, glnglpOriginalWndProc
End If

---