Link to home
Start Free TrialLog in
Avatar of procyn00
procyn00

asked on

Using SendMessage To retrieve List Values

I need to retrieve the values from a listbox in another application. Its an front end for a game with a chat room built in. Currently i'm using my program to run through a log of the chat and add people to an ignore list automatically etc. I want to get it directly from the window.

I can send and retrieve text from a textbox in that window, how do i do it for the listbox? OR maybe i'm wrong and its not a listbox.

The program is named ARC, its located at arc.sierra.com please check it out and see if you can help me.

I'm willing to give out 700 points to get this done.
Avatar of bobbit31
bobbit31
Flag of United States of America image

ok, i've dl'd arc, which listbox do you want? the one listing the ppl in room?
Avatar of procyn00
procyn00

ASKER

at the least i'd like to get the list of users currently in the chat
Avatar of Ark
Hi
All you need is this listbox handle. Sorry, my connection is too slowly today to download ARC installer. Here is a code to retrive list items:

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
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B

Private Function GetListItems(ByVal hList As Long) As Variant
   Dim i As Long, nCount As Long, lItemLength As Long
   Dim sItem() As String
   nCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0&)
   For i = 0 To nCount - 1
       lItemLength = SendMessage(hList, LB_GETTEXTLEN, i, ByVal 0&)
       ReDim Preserve sItem(i)
       sItem(i) = String(lItemLength, 0)
       Call SendMessage(hList, LB_GETTEXT, i, ByVal sItem(i))
   Next i
   GetListItems = sItem
End Function

'========Just for checking=========
Private Sub Form_Load()
'Fill listbox with items
  For i = 1 To 20
      List1.AddItem "Item No." & i
  Next i
End Sub

Private Sub Command1_Click()
   Dim sListItems As Variant
'Retrive all items and print them into debug window
   sListItems = GetListItems(List1.hWnd)
   For i = 0 To UBound(sListItems)
       Debug.Print sListItems(i)
   Next i
End Sub

Cheers
When I try your code ARK changing to the listbox handle (524812 at this moment), it says Runtime error 9, subscript out of range.
Hearing...
At what string did you get error
it immediatly errors out with that.
I've already download 951K of installer,3 hours remain :). Wait a bit...

Cheers

i wish i could loan you some of my bandwidth =)
Hi
I've downloaded ARC installer and install it. But I can not get account as new user :( I launched ARC,choose Login/New User and got WS_ServerReq_NoServerSpecified error). Where can I specify the server?
I've examined ARC window and found that there are 2 controls like listboxes. One of them is pure listbox named "ColorListBox" (Right top), but another isn't pure listbox with no name and class names "USERLIST" (Right bottom). Which one do you need? I can not check - they are empty.

Cheers
Hi
Code for retrieving Upper listbox.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
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
Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B

Private Function GetListItems(ByVal hList As Long) As Variant
  Dim i As Long, nCount As Long, lItemLength As Long
  Dim sItem() As String
  nCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0&)
  For i = 0 To nCount - 1
      lItemLength = SendMessage(hList, LB_GETTEXTLEN, i, ByVal 0&)
      ReDim Preserve sItem(i)
      sItem(i) = String(lItemLength, 0)
      Call SendMessage(hList, LB_GETTEXT, i, ByVal sItem(i))
  Next i
  GetListItems = sItem
End Function

Private Sub Command1_Click()
  Dim sListItems As Variant
'Retrive all items and print them into debug window
  sListItems = GetListItems(FindWindowEx(FindWindow(vbNullString, "ArcMatch"), 0, "ListBox", "ColorListBox"))
  For i = 0 To UBound(sListItems)
      Debug.Print sListItems(i)
  Next i
End Sub

Cheers
Oh we are gettin so close :D I'm getting excited :P

Ok, with that code Ark...

I change it a bit to msgbox me ubound(slist..) it tells me the number of lines in the chat window. The chat window is called ListBox, ColorListBox too... How can we do this? It returns no values however.
OH.. as for the server not specified error.. i'm not sure what the problem is there.. the program is buggy as all hell thats why i wanna work on my own front end.
just a quick question for Ark:

how did you know the name of the listbox was "ColorListBox"?
probably spy++
OH... should mention too, the Userlist is most important to me.. next of importantce is the chat dialog.
nobody getting very far? :(
spy++ is the best choice to get class names... and hardcoded window HWND besides other useful things... ;)
Hi
I used EnumChildWinows API with parent window + GetClassName/GetWindowText API to get classnames/windowstitles from all windows. Do you need this code?

Cheers
Ark, did you see my post above that your code will tell me how many items are there but will not retrieve any?
> Do you need this code?

if you don't mind ;)

the only code i need is to be able to retrieve user names from the user box. i'll give out 700 points, or more over time.
procyn00, just a small question - why don't you set up a client/server relationship using something like winsock.

You can then get anything from anything anywhere anytime with just a few lines of code.
i can't download the prog.
inthedark, i understand very little about doing what your saying. i did figure however that they won't allow me to connect to their server. is there a way i can connect to their server and them have no idea its not their software if they dont' really try hard to tell?
Hello procyn00.
Sorry, I still can not run this app, so can not check it exactly. But my code works with standard VB listboxes. You wrote that you got correct number of users, so LB_GETCOUNT message works. Try following:

Private Function GetListItems(ByVal hList As Long) As Variant
 Dim i As Long, nCount As Long, lItemLength As Long
 Dim sItem() As String
 nCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0&)
 For i = 0 To nCount - 1
     lItemLength = SendMessage(hList, LB_GETTEXTLEN, i, ByVal 0&)
     ReDim Preserve sItem(i)
     sItem(i) = String(lItemLength, 0)
     Call SendMessage(hList, LB_GETTEXT, i, ByVal sItem(i))
     Debug.Print lItemLength, sItem(i) '<<<ADDED to check if LB_GETTEXTLENGTH & LB_GETTEXT messages works.
 Next i
 GetListItems = sItem
End Function

Cheers

does anyone elses computer freeze on them after having arcmatch open for > 15 min?  makes it VERY hard to test my code :(
For bobbit:
'====Bas module code=====
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Function GetWndClass(hWnd As Long) As String
  Dim k As Long, sName As String
  sName = Space$(128)
  k = GetClassName(hWnd, sName, 128)
  If k > 0 Then sName = Left$(sName, k) Else sName = "No class"
  GetWndClass = sName
End Function

Private Function GetWndText(hWnd As Long) As String
  Dim k As Long, sName As String
  sName = Space$(128)
  k = GetWindowText(hWnd, sName, 128)
  If k > 0 Then sName = Left$(sName, k) Else sName = "No name"
  GetWndText = sName
End Function

Public Function EnumChildWinProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
   Debug.Print hWnd, GetWndText(hWnd), GetWndClass(hWnd)
   EnumChildWinProc = 1
End Function

'====Form code====
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnumChildWindows& Lib "user32" (ByVal hParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long)

Private Sub Command1_Click()
   Dim hWin As Long
   hWin = FindWindow(vbNullString, "ArcMatch")
   EnumChildWindows hWin, AddressOf EnumChildWinProc, 0
End Sub

Cheers
procyn00, if you don't have the source code for the other app. your stuffed and you have to do it the hard way!

thanks ark!
Ark, your code still works perfect for all listboxes in all other programs i can find, however in this dang arc proggie it still will not return item length and value. Man i hate this front end :P

I'm no whiz at this stuff so this may sound stupid but could it be that the item is not text?
Ark,

I tried GetData (LB_GetData) and it does return data for each item. Whats this mean?
Also, i can remove items from the listbox.
Just a tip, if you have Visual Studio, then under the tools you should see SPY++.  Run this program and look under the View menu, I think, for the Find Window function.  This brings up a dialog with a little bullseye in the middle.  Drag the bullseye over on top of the list in question and SPY++ will display the Class name of the "window" (the list will be a window too).  You can do this on a standard VB listbox and compare the results.  It sounds pretty certain that this "listbox" isn't a standard listbox, so, perhaps, using standard methods for retrieving or setting data with the APIs will not work.
"...
so, perhaps, using standard methods for retrieving or setting data with the APIs will not work.
..."
i was thinking the same way: maybe const like LB_GETTEXT doesn't works on it.
Hi
ColorListBox is a pure ListBox, because it have predefined class name ("ListBox" - this name is reserved by Windows). So it SHOULD return text. The only reason is that these messages (LB_GETTEXTLENGTH & LB_GETTEXT) are subclassed by application and doesn't return value. May be only LB_GETTEXTLENGTH is subclassed? If so, try:

Dim lPos As Long
For i = 0 To nCount - 1
    lItemLength = 50 'increase this value if names are longer then 50 chars
    ReDim Preserve sItem(i)
    sItem(i) = String(lItemLength, 0)
    Call SendMessage(hList, LB_GETTEXT, i, ByVal sItem(i))
    lPos = Instr(1, sItem(i), Chr(0))
    If lPos > 1 Then
       sItem(i) = Left(sItem(i), lPos)
    End If    
    Debug.Print lItemLength, sItem(i) '<<<ADDED to check if LB_GETTEXTLENGTH & LB_GETTEXT messages
works.
Next

If this also doesn't work, i'm afraid we can not get values this way. All above is for ColorListBox. As for USERLIST, this is self-made ActiveX control and I donno its behavior. How does it look like? May be this is a container with other controls? For example, picturebox with labels/textboxes inside. Try to use spy or my method on it (see my code for enum child windows):

Private Sub Command1_Click()
  Dim hWin As Long
  hWin = FindWindowEx(FindWindow(vbNullString, "ArcMatch"), 0, "USERLIST", vbNullString)
  EnumChildWindows hWin, AddressOf EnumChildWinProc, 0
End Sub

Cheers

Well i still can't get it to return line values :( but... i see a lot of times in the spy++ window WM_PAINT... does this help??

You've done way more than i ever expected ark, let me know when you wanna give up and i'll give you your points.
Hello procyn00
>>i see a lot of times in the spy++ window WM_PAINT<< It's one of the most common message in Windows. It repaints window every time when, for example, you move mouse cursor over window.
I still can not get account, receiving same error (WS_ServerReq_NoServerSpecified). And I can not figure what kind of control USERLIST is because it's empty.

Try following code:

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal
lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal
lpString As String, ByVal cch As Long) As Long

Private Function GetWndClass(hWnd As Long) As String
 Dim k As Long, sName As String
 sName = Space$(128)
 k = GetClassName(hWnd, sName, 128)
 If k > 0 Then sName = Left$(sName, k) Else sName = "No class"
 GetWndClass = sName
End Function

Private Function GetWndText(hWnd As Long) As String
 Dim k As Long, sName As String
 sName = Space$(128)
 k = GetWindowText(hWnd, sName, 128)
 If k > 0 Then sName = Left$(sName, k) Else sName = "No name"
 GetWndText = sName
End Function

Public Function EnumChildWinProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Debug.Print hWnd, GetWndText(hWnd), GetWndClass(hWnd)
  EnumChildWinProc = 1
End Function

'====Form code====
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal
lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal
hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function EnumChildWindows& Lib "user32" (ByVal hParent As Long, ByVal lpEnumFunc As
Long, ByVal lParam As Long)

Private Sub Command1_Click()
   Dim hWin As Long
   hWin = FindWindowEx(FindWindow(vbNullString, "ArcMatch"), 0, "USERLIST", vbNullString)
   Debug.Print hWin
   EnumChildWindows hWin, AddressOf EnumChildWinProc, 0
End Sub
'=======End code==========

and post here what you see in the debug window.

Cheers
Debug window prints

 6292102


Thats it
This mean that there is no childs...
Now I think that we can not get names due to interprocess memory communication failure. OK, try following:

'========mSharedMemory.bas===========
Option Explicit
'Some API (SendMessage for example) use pointers to structures to be filled
'with some data. If you're sending such message to window belong to your
'process - no problem. But if you try to send this message to different
'process GPF can occure, because structure address belong to calling process
'memory space and target process can not achive this address. Here is
'work around.
'For Win95/98/ME we can use File Mapping, because OS place mapped files
'into shareable memory space. But we can't use this trick for NT - NT map
'files into calling process memory area. In this case, we can use
'VirtualAllocEx function to reserve memory inside target process.

'=========Checking OS staff=============
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long

'========= Win95/98/ME Shared memory staff===============
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SECTION_QUERY = &H1
Const SECTION_MAP_WRITE = &H2
Const SECTION_MAP_READ = &H4
Const SECTION_MAP_EXECUTE = &H8
Const SECTION_EXTEND_SIZE = &H10
Const SECTION_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SECTION_QUERY Or SECTION_MAP_WRITE Or SECTION_MAP_READ Or SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Const FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS

'============NT Shared memory staff======================
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_VM_OPERATION = &H8
Const PROCESS_VM_READ = &H10
Const PROCESS_VM_WRITE = &H20
Const PROCESS_ALL_ACCESS = 0
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MEM_COMMIT = &H1000
Const MEM_RESERVE = &H2000
Const MEM_DECOMMIT = &H4000
Const MEM_RELEASE = &H8000
Const MEM_FREE = &H10000
Const MEM_PRIVATE = &H20000
Const MEM_MAPPED = &H40000
Const MEM_TOP_DOWN = &H100000

'==========Memory access constants===========
Private Const PAGE_NOACCESS = &H1&
Private Const PAGE_READONLY = &H2&
Private Const PAGE_READWRITE = &H4&
Private Const PAGE_WRITECOPY = &H8&
Private Const PAGE_EXECUTE = &H10&
Private Const PAGE_EXECUTE_READ = &H20&
Private Const PAGE_EXECUTE_READWRITE = &H40&
Private Const PAGE_EXECUTE_WRITECOPY = &H80&
Private Const PAGE_GUARD = &H100&
Private Const PAGE_NOCACHE = &H200&

Public Function GetMemShared95(ByVal memSize As Long, hFile As Long) As Long
    hFile = CreateFileMapping(&HFFFFFFFF, 0, PAGE_READWRITE, 0, memSize, vbNullString)
    GetMemShared95 = MapViewOfFile(hFile, FILE_MAP_ALL_ACCESS, 0, 0, 0)
End Function

Public Sub FreeMemShared95(ByVal hFile As Long, ByVal lpMem As Long)
    UnmapViewOfFile lpMem
    CloseHandle hFile
End Sub

Public Function GetMemSharedNT(ByVal pid As Long, ByVal memSize As Long, hProcess As Long) As Long
    hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
    GetMemSharedNT = VirtualAllocEx(ByVal hProcess, ByVal 0&, ByVal memSize, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
End Function

Public Sub FreeMemSharedNT(ByVal hProcess As Long, ByVal MemAddress As Long, ByVal memSize As Long)
   Call VirtualFreeEx(hProcess, ByVal MemAddress, memSize, MEM_RELEASE)
   CloseHandle hProcess
End Sub

Public Function IsWindowsNT() As Boolean
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Function
   If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
End Function

'================mGetValues.bas=============

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
hWnd As Long) As Long
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)
Private Declare Function CopyStringA Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
Public Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long


Const LB_GETTEXTLEN = &H18A
Const LB_GETTEXT = &H189
Const LB_GETCOUNT = &H18B

Const MAX_NAME = 256

Public Function GetListItems(ByVal hList As Long) As Variant
   Dim i As Long, nCount As Long
   Dim pid As Long, tid As Long, lpSysShared As Long
   Dim hProcess As Long, lWritten As Long, hFileMapping As Long
   Dim sItem() As String, sTemp As String
   nCount = SendMessage(hList, LB_GETCOUNT, 0, ByVal 0&)
   if nCount=0 Then Exit Function
   ReDim sItem(nCount)
   tid = GetWindowThreadProcessId(hList, pid)
   sTemp = String(MAX_NAME, 0)
   If IsWindowsNT Then
      lpSysShared = GetMemSharedNT(pid, MAX_NAME, hProcess)
      WriteProcessMemory hProcess, ByVal lpSysShared, ByVal sTemp, MAX_NAME, lWritten
      For i = 0 To nCount - 1
          SendMessage h, LB_GETTEXT, i, ByVal lpSysShared
          sItem(i) = StrFromPtrA(lpSysShared)
'Not sure here, may be sItem(i) = StrFromPtrW(lpSysShared)
      Next i
      FreeMemSharedNT hProcess, lpSysShared, MAX_NAME
   Else
      lpSysShared = GetMemShared95(MAX_NAME, hFileMapping)
      CopyMemory ByVal lpSysShared, ByVal sTemp, MAX_NAME
      For i = 0 To nCount - 1
          SendMessage h, LB_GETTEXT, i, ByVal lpSysShared
          sItem(i) = StrFromPtrA(lpSysShared)
      Next i
      FreeMemShared95 hFileMapping, lpSysShared
   End If
   GetListItems = sItem
End Function

Private Function StrFromPtrA(ByVal lpszA As Long, Optional nSize As Long = 0) As String
   Dim s As String, bTrim As Boolean
   If nSize = 0 Then
      nSize = lstrlenA(lpszA)
      bTrim = True
   End If
   s = String(nSize, Chr$(0))
   CopyStringA s, ByVal lpszA
   If bTrim Then s = TrimNULL(s)
   StrFromPtrA = s
End Function

Private Function StrFromPtrW(ByVal lpszW As Long, Optional nSize As Long = 0) As String
   Dim s As String, bTrim As Boolean
   If nSize = 0 Then
      nSize = lstrlenW(lpszW)
      bTrim = True
   End If
   s = String(nSize, Chr$(0))
   CopyMemory ByVal StrPtr(s), ByVal lpszW, nSize
   If bTrim Then s = TrimNULL(s)
   StrFromPtrW = s
End Function

Private Function TrimNULL(ByVal str As String) As String
    If InStr(str, Chr$(0)) > 0& Then
        TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
    Else
        TrimNULL = str
    End If
End Function

'===========Form code=====
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String)

Private Sub Command1_Click()
 Dim sListItems As Variant
'Retrive all items and print them into debug window
 sListItems = GetListItems(FindWindowEx(FindWindow(vbNullString, "ArcMatch"), 0, "ListBox", "ColorListBox"))
 For i = 0 To UBound(sListItems)
     Debug.Print sListItems(i)
 Next i
End Sub

Cheers
i still can't get itemlength or the item value.

A few things i did...

SendMessage h, LB_GETTEXT, i, ByVal lpSysShared
I changed the h to hList, same with other area with h instead of hList.

Tried
sItem(i) = StrFromPtrA(lpSysShared)
And
sItem(i) = StrFromPtrW(lpSysShared)

Changed
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any,
ByVal cBytes As Long)
hWnd As Long) As Long

to

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any,
ByVal cBytes As Long)

NOt sure exactly what that lines supposed to be
tried
ByVal hWnd As Long)
too
Also wanted to point out, i still get the correct number of lines. And i've been changing

FindWindowEx(FindWindow(vbNullString, "ArcMatch"), 0, "ListBox", "ColorListBox"))

FindWindowEx(FindWindow(vbNullString, "ArcMatch - Lobby"), 0, "ListBox", "ColorListBox"))

Because the window caption changes to that when you join the lobby.
Additionally...

A guy named ragnar, who will not help me at all made a program that reads from the arc chat window... from his dll that he made i found this

Position     Type     Length     String
77     Char     40     !This program cannot be run in DOS mode.
1104     Char     14     ARCChat Server
1159     Char     10     Ragnarsoft
3624     DLL     11     archook.dll
3666     Char     10     DllMain@12
3677     Char     17     GetMsgHookProc@12
3695     Char     18     listboxsubclass@16
4314     Function     11     RegCloseKey
4330     Function     13     RegOpenKeyExA
4346     Function     11     CloseHandle
4362     Function     11     FreeLibrary
4378     Function     14     CallNextHookEx
4398     Function     15     CallWindowProcA
4418     Function     11     FindWindowA
4434     Function     13     FindWindowExA
4450     Function     12     PostMessageA
4466     Function     12     SendMessageA
4482     Function     14     SetWindowLongA
4508     DLL     12     ADVAPI32.DLL
4532     DLL     12     KERNEL32.dll
4576     DLL     10     USER32.dll
4702     Unichar     15     VS_VERSION_INFO
4794     Unichar     14     StringFileInfo
4868     Unichar     30     Ragnar <ragnar@starshadow.com>
4938     Unichar     11     FileVersion
4982     Unichar     14     ProductVersion
5030     Unichar     11     CompanyName
5056     Unichar     10     Ragnarsoft
5086     Unichar     15     FileDescription
5120     Unichar     22     Helper DLL for arccopy
5174     Unichar     12     InternalName
5222     Unichar     16     OriginalFilename    
5256     Unichar     11     archook.dll    
5286     Unichar     11     ProductName    
5312     Unichar     14     ARC Chat Tools    
5368     Unichar     37     http://paradise.promotech.net/~ragnar     
5450     Unichar     11     VarFileInfo    
5482     Unichar     11     Translation    
5659     Char     23     1 1'1.1;1B1I1V1^1e1u1{1    
5705     Char     15     "2""232J2[2f2q2y2"    
5745     Char     11     424A4V4b4n4    
5789     Char     27     5 5$5(5     5054585<5@5D5S5[5e5
5861     Char     21     "7""7*727:7B7J7R7Z7b7j7"

You can download that dll @ http://paradise.promotech.net/~ragnar/archook.dll
ASKER CERTIFIED SOLUTION
Avatar of Ark
Ark
Flag of Russian Federation image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks for points, procyn. Did you get the answer?

Cheers
no, never found an answer.