Valhalla Legends Forums Archive | Battle.net Bot Development | URL Autodetection.

AuthorMessageTime
FyRe
I was wondering if there is a clean way to do AutoDetectURL.  I've looked over the net for a long time.  I only found a few samples and I created a very messy AutoDetection.

This is when the form loads: Form_Load()
[code]    '// auto detect urls
   With rtbChat
       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))
   End With
   With rtbWhisper
       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))
   End With
   glngOriginalhWnd = Me.HWnd
   glnglpOriginalWndProc = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)[/code]

This is in the Declares mod.
[code]'AutoDetectURL
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_AUTOURLDETECT = (WM_USER + 91)
Public Const EM_SETEVENTMASK = WM_USER + 69
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
Public 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 = frmMain.rtbChat.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 frmMain.rtbChat
                   lngWin32apiResultCode = SendMessage(.HWnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE)
               End With
               RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer)
               strOperation = "open"
               strFileName = strBuffer
               lngHInstanceExecutable = ShellExecute(frmMain.HWnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL)
           End If
       ElseIf udtNMHDR.hwndFrom = frmMain.rtbWhisper.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 frmMain.rtbWhisper
               lngWin32apiResultCode = SendMessage(.HWnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE)
           End With
           RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer)
           strOperation = "open"
           strFileName = strBuffer
           lngHInstanceExecutable = ShellExecute(frmMain.HWnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL)
       End If
   End If
End If
RichTextBoxSubProc = CallWindowProc(glnglpOriginalWndProc, HWnd, uMsg, wParam, lParam)
End Function[/code]

When the Program closes:
[code]    'Autodetecturl Unload
   Dim lngWin32apiResultCode As Long
   lngWin32apiResultCode = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, glnglpOriginalWndProc)
[/code]

Sorry, for such a big message.  I know this code is messy and bad coding.  I'm just asking for suggestions and anything simpler ;)

Thanks.
February 28, 2003, 6:25 AM
JaMi
how do you declare your SetWindowLong ?
February 28, 2003, 9:41 AM
Spht
[quote]how do you declare your SetWindowLong ?[/quote]

That's a standard Win32 API function.

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
February 28, 2003, 9:53 AM
Camel
if you ever need to look up an api call, you can use the "api text viewer" that comes with visual studio
if you have just vb and not vs, you can usually find it as the first or second result on www.google.com :)
February 28, 2003, 1:06 PM
FyRe
[code]Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
[/code]

Sorry, thought I added everything.
February 28, 2003, 5:00 PM
haZe
There is a much smaller and simplified version at
http://pscode.com/vb/scripts/ShowCodeAsText.asp?txtCodeId=36414&lngWId=1
February 28, 2003, 6:15 PM

Search