Link to home
Start Free TrialLog in
Avatar of usachrisk1983
usachrisk1983Flag for United States of America

asked on

Visual Basic 6 : Getting Data from anothers Applications ListView

I have a 3rd party application that I need to read the ListView of.  I have read various pages around the net and have basically gotten the code to do it and have pasted it below.  My problem is that the results after the first one come with the characters from it's previous.  I know that sounds confusing, so I've included an example:

Example Scenario: Application has ListView with Pineapple, Orange, and Apple as the only items.  My application below calls to get those items, when I debug.print the reults, I get:

Pineapple
Orangeple
Appleeple

The Code:

'===== MSHAREDMEMORY.BAS =====
Option Explicit
'=========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

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&

'============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

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

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

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


'===== MAINMODULE.BAS (RELEVANT PARTS) =====
Option Explicit

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) 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
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
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)
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

Private Const LVM_FIRST = &H1000
Private Const LVM_GETTITEMCOUNT& = (LVM_FIRST + 4)
Private Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)

Private Const LVM_GETITEMA = (LVM_FIRST + 5)
Private Const LVM_GETITEMW = (LVM_FIRST + 75)
Private Const LVIF_TEXT = &H1

Private Const LVM_GETITEMTEXTA = (LVM_FIRST + 45)
Private Const LVM_GETITEMTEXTW = (LVM_FIRST + 115)

Public Type LV_ITEM
    mask As Long
    iItem As Long
    iSubItem As Long
    state As Long
    stateMask As Long
    lpszText As Long 'LPCSTR
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

Type LV_TEXT
    sItemText As String * 80
End Type

Private Sub Main()
 
 Dim i As Integer
 For i = 1 To 10: Debug.Print "": Next

  'various lines of code to get the hwnd of the listview.
 
   Dim sItems As Variant
   
   sItems = GetListViewItems(hListView)
   For i = 0 To UBound(sItems)
       Debug.Print "=>" & sItems(i)
   Next i
 
End Sub

Public Function GetListViewItems(ByVal hLV As Long) As Variant
   Dim pid As Long, tid As Long
   Dim hProcess As Long, nCount As Long, lWritten As Long, i As Long
   Dim lpSysShared As Long, hFileMapping As Long, dwSize As Long
   Dim lpSysShared2 As Long, hFileMapping2 As Long
   Dim sLVItems() As String
   Dim li As LV_ITEM
   Dim lt As LV_TEXT
   If hLV = 0 Then Exit Function
   tid = GetWindowThreadProcessId(hLV, pid)
   nCount = SendMessage(hLV, LVM_GETTITEMCOUNT, 0, 0&)
   If nCount = 0 Then Exit Function
   ReDim sLVItems(nCount - 1)
   li.cchTextMax = 80
   dwSize = Len(li)
   If IsWindowsNT Then
      lpSysShared = GetMemSharedNT(pid, dwSize, hProcess)
      lpSysShared2 = GetMemSharedNT(pid, LenB(lt), hProcess)
      For i = 0 To nCount - 1
          li.lpszText = lpSysShared2
          li.cchTextMax = 80
          li.iItem = i
          li.mask = LVIF_TEXT
          WriteProcessMemory hProcess, ByVal lpSysShared, li, dwSize, lWritten
          WriteProcessMemory hProcess, ByVal lpSysShared2, lt, LenB(lt), lWritten
          Call SendMessage(hLV, LVM_GETITEMW, 0, ByVal lpSysShared)
          Call ReadProcessMemory(hProcess, ByVal lpSysShared2, lt, LenB(lt), lWritten)
          sLVItems(i) = StrConv(lt.sItemText, vbFromUnicode)
      Next i
      FreeMemSharedNT hProcess, lpSysShared, dwSize
      FreeMemSharedNT hProcess, lpSysShared2, LenB(lt)
   Else
      lpSysShared = GetMemShared95(dwSize, hFileMapping)
      lpSysShared2 = GetMemShared95(Len(lt), hFileMapping2)
      li.lpszText = lpSysShared2
      CopyMemory ByVal lpSysShared, li, dwSize
      CopyMemory ByVal lpSysShared2, lt, Len(lt)
      For i = 0 To nCount - 1
          Call SendMessage(hLV, LVM_GETITEMTEXTA, i, ByVal lpSysShared)
          CopyMemory lt, ByVal lpSysShared2, Len(lt)
          sLVItems(i) = TrimNull(lt.sItemText)
      Next i
      FreeMemShared95 hFileMapping, lpSysShared
      FreeMemShared95 hFileMapping2, lpSysShared2
   End If
   GetListViewItems = sLVItems
End Function

Public Function TrimNull(startstr As String) As String
   Dim pos As Integer
   pos = InStr(startstr, Chr$(0))
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
   TrimNull = startstr
End Function

'===== END OF CODE =====



Does anyone have any suggetions on where I can clear the string so that the next value doesn't take over?
Avatar of dsulkar
dsulkar

Just a thought, went throught the code and it looks good, couple of questions why strconv and what do you get when you add this code after this line at the end of Function GetListViewItems

   GetListViewItems = sLVItems

      For i = 0 To nCount - 1
          Debug.Print "=>" & sLVItems(i)
      Next i

Just wanted to see if the values are getting changed after the function sends them back.
Avatar of usachrisk1983

ASKER

Hi Dsulkar -

When I added your debug statement to the end of the function, I got the same results.

Chris.
OK at least we know that it happened before the results got passed back. Is there any way you could send me the project so I could debug it myself? As long as this is not a very big project.
dsulkar@csitechnologies.com
Sent.  I'd prefer to keep all discussions surrounding it in this EE forum though, so that it's easier for other people to see what we've done, and comment if necessary.
SOLUTION
Avatar of Arthur_Wood
Arthur_Wood
Flag of United States of America 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
AW: Any suggestions on a fix?
ASKER CERTIFIED SOLUTION
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
That might work - give it a shot.

AW
Wow, that's got me 99% of the way.  The remainder of the characters now after the line in the list box is filled with ascii character 134 (looks like a cross).  For future reference, I fixed it by adding the following statement in GetListViewItems BEFORE the GetListViewItems = sLVItems:

'= CODE BEGIN ='
   For i = 0 To nCount - 1
    If InStr(sLVItems(i), Chr(134)) > 0 Then sLVItems(i) = Mid(sLVItems(i), 1, InStr(sLVItems(i), Chr(134)) - 2)
   Next i
'= CODE END ='

I've pasted the new module below:

Public Function GetListViewItems(ByVal hLV As Long) As Variant
   Dim pid As Long, tid As Long
   Dim hProcess As Long, nCount As Long, lWritten As Long, i As Long
   Dim lpSysShared As Long, hFileMapping As Long, dwSize As Long
   Dim lpSysShared2 As Long, hFileMapping2 As Long
   Dim sLVItems() As String
   Dim li As LV_ITEM
   Dim lt As LV_TEXT
   If hLV = 0 Then Exit Function
   tid = GetWindowThreadProcessId(hLV, pid)
   nCount = SendMessage(hLV, LVM_GETTITEMCOUNT, 0, 0&)
   If nCount = 0 Then Exit Function
   ReDim sLVItems(nCount - 1)
   li.cchTextMax = 80
   dwSize = Len(li)
   If IsWindowsNT Then
      lpSysShared = GetMemSharedNT(pid, dwSize, hProcess)
      lpSysShared2 = GetMemSharedNT(pid, LenB(lt), hProcess)
      For i = 0 To nCount - 1
          li.lpszText = lpSysShared2
          li.cchTextMax = 80
          li.iItem = i
          li.mask = LVIF_TEXT
          lt.sItemText = ""
          WriteProcessMemory hProcess, ByVal lpSysShared, li, dwSize, lWritten
          WriteProcessMemory hProcess, ByVal lpSysShared2, lt, LenB(lt), lWritten
          Call SendMessage(hLV, LVM_GETITEMW, 0, ByVal lpSysShared)
          Call ReadProcessMemory(hProcess, ByVal lpSysShared2, lt, LenB(lt), lWritten)
          'MsgBox lWritten
          sLVItems(i) = StrConv(lt.sItemText, vbFromUnicode)
      Next i
      FreeMemSharedNT hProcess, lpSysShared, dwSize
      FreeMemSharedNT hProcess, lpSysShared2, LenB(lt)
   Else
      lpSysShared = GetMemShared95(dwSize, hFileMapping)
      lpSysShared2 = GetMemShared95(Len(lt), hFileMapping2)
      li.lpszText = lpSysShared2
      CopyMemory ByVal lpSysShared, li, dwSize
      CopyMemory ByVal lpSysShared2, lt, Len(lt)
      For i = 0 To nCount - 1
          Call SendMessage(hLV, LVM_GETITEMTEXTA, i, ByVal lpSysShared)
          CopyMemory lt, ByVal lpSysShared2, Len(lt)
          sLVItems(i) = TrimNull(lt.sItemText)
      Next i
      FreeMemShared95 hFileMapping, lpSysShared
      FreeMemShared95 hFileMapping2, lpSysShared2
   End If
   
   For i = 0 To nCount - 1
    If InStr(sLVItems(i), Chr(134)) > 0 Then sLVItems(i) = Mid(sLVItems(i), 1, InStr(sLVItems(i), Chr(134)) - 2)
   Next i
   
   GetListViewItems = sLVItems
   
End Function
Adding 50 points (total = 300) to share with AW.
Glad to be of assistance.

AW