VB6 get text from richtextbox

Can anyone give me a sample of VB6 code to get plaintext from a richtextbox in another application (which I do not have the source) into a buffer in my program. I then have to search this buffer for certain phrases.
I have used Sendmessage(hwnd, WM_GETTEXT, length, strtmp) which works for an hour or so but eventually crashes probably because the lenght is way over 64K and usually over 100k.
I see that I am supposed to use Sendmessage with EM_STREAMOUT. I haven't been able to get this to work and all the examples I can find are in C.
Thanks for any help.
aonecomputersAsked:
Who is Participating?
 
DarkoLordConnect With a Mentor Commented:
Hi! Try this (credits to "Frans C")... (replace RichTextBox1.hwnd with the correct hwnd)

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400
Private Const EM_STREAMIN = (WM_USER + 73)
Private Const EM_STREAMOUT = (WM_USER + 74)
Private Const SF_TEXT = &H1
Private Const SF_RTF = &H2
Private Const SF_UNICODE = &H10         ' Unicode data of some kind

Private Type EDITSTREAM
    dwCookie As Long
    dwError As Long
    pfnCallback As Long
End Type

Private Sub Command1_Click()
Dim es As EDITSTREAM
Dim retval As Long
    es.dwCookie = 55 'put your own data in here, it is passed to the callback function
    es.pfnCallback = GetAddress(AddressOf EditStreamCallback)
    retval = SendMessage(RichTextBox1.hwnd, EM_STREAMOUT, SF_RTF, es)
End Sub


In a bas module:

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function EditStreamCallback(ByVal dwCookie As Long, ByVal pbBuff As Long, ByVal cb As Long, ByVal pcb As Long) As Long
Dim bArr() As Byte
Dim strBuff As String

    ReDim bArr(cb - 1)
    CopyMemory bArr(0), ByVal pbBuff, cb
    ' the data is in the byte array
    ' do with it what you want
    ' probably you want to save it to a file,
    ' but for the example I put it in a string
    strBuff = StrConv(bArr, vbUnicode)
End Function

Public Function GetAddress(ByVal lAddress As Long) As Long
    GetAddress = lAddress
End Function
0
 
anvCommented:
can u select the contents of the RT box of other application...?

how do u manage to refer to that control when u dont have source of that application?

0
 
zzzzzoocCommented:
>>but eventually crashes probably because the lenght is way over 64K and usually over 100k.
It shouldn't crash.. a string can contain about 2 billion characters (about 1 billion if in Unicode).

Form1:
-------------
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Sub Command1_Click()
    Dim strBuffer As String
    If WindowGetText(RichTextBox1.hwnd, strBuffer) = True Then
        'Just MsgBox the first 10 characters...
        Call MsgBox(Left$(strBuffer, 10) & "...", , "Length: " & Len(strBuffer))
    End If
End Sub
Private Sub Form_Load()
    'Fill RichTextBox with A LOT of text (may take a while)...
    RichTextBox1.Text = String(1000000, "0")
End Sub
Private Function WindowGetText(ByVal lngHandle As Long, ByRef strBuffer As String) As Boolean
    Dim lngLen As Long
    lngLen = SendMessage(lngHandle, WM_GETTEXTLENGTH, 0, 0)
    If lngLen > 0 Then
        strBuffer = String(lngLen, vbNullChar)
        If SendMessage(lngHandle, WM_GETTEXT, lngLen, ByVal strBuffer) = 0 Then
            WindowGetText = True
        End If
    End If
End Function
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.