Solved

Using SendMessage To retrieve List Values

Posted on 2002-03-06
47
723 Views
Last Modified: 2007-12-19
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.
0
Comment
Question by:procyn00
  • 22
  • 13
  • 5
  • +3
47 Comments
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
ok, i've dl'd arc, which listbox do you want? the one listing the ppl in room?
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
at the least i'd like to get the list of users currently in the chat
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
When I try your code ARK changing to the listbox handle (524812 at this moment), it says Runtime error 9, subscript out of range.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
Hearing...
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
At what string did you get error
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
it immediatly errors out with that.
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
I've already download 951K of installer,3 hours remain :). Wait a bit...

Cheers

0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
i wish i could loan you some of my bandwidth =)
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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.
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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.
0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
just a quick question for Ark:

how did you know the name of the listbox was "ColorListBox"?
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
probably spy++
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
OH... should mention too, the Userlist is most important to me.. next of importantce is the chat dialog.
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
nobody getting very far? :(
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
spy++ is the best choice to get class names... and hardcoded window HWND besides other useful things... ;)
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
Hi
I used EnumChildWinows API with parent window + GetClassName/GetWindowText API to get classnames/windowstitles from all windows. Do you need this code?

Cheers
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
Ark, did you see my post above that your code will tell me how many items are there but will not retrieve any?
0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
> Do you need this code?

if you don't mind ;)

0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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.
0
 
LVL 17

Expert Comment

by:inthedark
Comment Utility
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.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
i can't download the prog.
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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?
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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

0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
does anyone elses computer freeze on them after having arcmatch open for > 15 min?  makes it VERY hard to test my code :(
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
0
 
LVL 17

Expert Comment

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

0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
thanks ark!
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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?
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
Ark,

I tried GetData (LB_GetData) and it does return data for each item. Whats this mean?
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
Also, i can remove items from the listbox.
0
 
LVL 18

Expert Comment

by:mdougan
Comment Utility
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.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
Comment Utility
"...
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.
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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

0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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.
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
Debug window prints

 6292102


Thats it
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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.
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
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
0
 
LVL 27

Accepted Solution

by:
Ark earned 300 total points
Comment Utility
Seems this is a programm which subclass (hook) listboxes and intercept all messages to this listbox. It was written in other language then VB. It's not safety to subclass another app from VB - you'll ususally received GPF since VB is single-threading model.
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
Thanks for points, procyn. Did you get the answer?

Cheers
0
 
LVL 1

Author Comment

by:procyn00
Comment Utility
no, never found an answer.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now