Форум на Исходниках.RU

Private Declare Function GetSystemDefaultLCID Lib "kernel32.dll" () As Long

Private Declare Function GetClassNameA Lib "user32" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

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 IsWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) 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

Private Const LVM_FIRST = &H1000

Private Const LVM_SETIMAGELIST = (LVM_FIRST + 3)

Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)

Private Const LVM_GETITEM = (LVM_FIRST + 5)

Private Const LVM_SETITEM = (LVM_FIRST + 6)

Private Const LVM_INSERTITEM = (LVM_FIRST + 7)

Private Const LVM_DELETEITEM = (LVM_FIRST + 8)

Private Const LVM_GETNEXTITEM = (LVM_FIRST + 12)

Private Const LVM_GETITEMRECT = (LVM_FIRST + 14)

Private Const LVM_SETITEMPOSITION = (LVM_FIRST + 15)

Private Const LVM_GETITEMPOSITION = (LVM_FIRST + 16)

Private Const LVM_HITTEST = (LVM_FIRST + 18)

Private Const LVM_ENSUREVISIBLE = (LVM_FIRST + 19)

Private Const LVM_SCROLL = (LVM_FIRST + 20)

Private Const LVM_ARRANGE = (LVM_FIRST + 22)

Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)

Private Const LVM_GETVIEWRECT = (LVM_FIRST + 34)

Private Const LVM_GETORIGIN = (LVM_FIRST + 41)

Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)

Private Const LVM_GETITEMTEXT = (LVM_FIRST + 45)

Private Const LVM_SETITEMPOSITION32 = (LVM_FIRST + 49)

Private Const LVM_GETWORKAREAS = (LVM_FIRST + 70)

Public Declare Function loword Lib "TLBINF32" (ByVal dWord As Long) As Integer

Public Declare Function hiword Lib "TLBINF32" (ByVal dWord As Long) As Integer

Public Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal Length As Long)

Public Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)

Type POINTAPI

X As Long

Y As Long

End Type

Private Enum AccessProtectionFlags

PAGE_NOACCESS = &H1

' PAGE_READONLY = &H2

PAGE_READWRITE = &H4

' PAGE_WRITECOPY = &H8

PAGE_EXECUTE = &H10

PAGE_EXECUTE_READ = &H20

PAGE_EXECUTE_READWRITE = &H40

' PAGE_EXECUTE_WRITECOPY = &H80

PAGE_GUARD = &H100

PAGE_NOCACHE = &H200

PAGE_WRITECOMBINE = &H400

End Enum

Private Enum VirtualAllocExTypes ' commented defs are for APIs other than VirtualAllocEx

MEM_COMMIT = &H1000

MEM_RESERVE = &H2000

MEM_DECOMMIT = &H4000

MEM_FREE = &H10000

MEM_RELEASE = &H8000&

' MEM_public = &H20000

' MEM_MAPPED = &H40000

MEM_RESET = &H80000 ' (Win2K oinly)

MEM_TOP_DOWN = &H100000

' MEM_WRITE_WATCH = &H200000 ' Win98 only

' MEM_PHYSICAL = &H400000 ' Win2K only

' MEM_4MB_PAGES = &H80000000 ' ??

' SEC_IMAGE = &H1000000

' MEM_IMAGE = SEC_IMAGE

' WRITE_WATCH_FLAG_RESET = &H1 ' Win98 only

End Enum

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000

Private Const CB_LVITEM As Long = 36 ' user-defined

' CodePage

Private Const CP_ACP = 0 ' ANSI code page

Private Enum ProcessAccessTypes

PROCESS_TERMINATE = (&H1)

PROCESS_CREATE_THREAD = (&H2)

PROCESS_SET_SESSIONID = (&H4)

PROCESS_VM_OPERATION = (&H8)

PROCESS_VM_READ = (&H10)

PROCESS_VM_WRITE = (&H20)

PROCESS_DUP_HANDLE = (&H40)

PROCESS_CREATE_PROCESS = (&H80)

PROCESS_SET_QUOTA = (&H100)

PROCESS_SET_INFORMATION = (&H200)

PROCESS_QUERY_INFORMATION = (&H400)

' STANDARD_RIGHTS_REQUIRED = &HF0000

SYNCHRONIZE = &H100000

PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

End Enum

Private Declare Function GetWindowThreadProcessId Lib "user32" _

(ByVal hWnd As Long, _

lpdwProcessId As Long) As Long

Private Declare Function OpenProcess Lib "Kernel32" _

(ByVal dwDesiredAccess As ProcessAccessTypes, _

ByVal bInheritHandle As Long, _

ByVal dwProcessId As Long) As Long

Private Declare Function GetCurrentProcessId Lib "Kernel32" () As Long

Private Declare Function VirtualAllocEx Lib "Kernel32" _

(ByVal hProcess As Long, _

ByVal lpAddress As Long, _

ByVal dwSize As Long, _

ByVal flAllocationType As VirtualAllocExTypes, _

ByVal flProtect As AccessProtectionFlags) As Long

Private Declare Function VirtualFreeEx Lib "Kernel32" _

(ByVal hProcess As Long, _

ByVal lpAddress As Long, _

ByVal dwSize As Long, _

ByVal dwFreeType As Long) As Long

Private Declare Function ReadProcessMemory Lib "Kernel32" _

(ByVal hProcess As Long, _

ByVal lpBaseAddress As Long, _

lpBuffer As Any, _

ByVal nSize As Long, _

lpNumberOfBytesRead As Long) As Long

Private Declare Function WriteProcessMemory Lib "Kernel32" _

(ByVal hProcess As Long, _

ByVal lpBaseAddress As Long, _

lpBuffer As Any, _

ByVal nSize As Long, _

lpNumberOfBytesWritten As Long) As Long

Private Declare Function lstrlenA Lib "Kernel32" (ByRef lpstring As Long) As Long

Private Declare Function MultiByteToWideChar Lib "Kernel32" _

(ByVal CodePage As Long, _

ByVal dwFlags As Long, _

lpMultiByteStr As Any, _

ByVal cchMultiByte As Long, _

lpWideCharStr As Any, _

ByVal cchWideChar As Long) As Long

Private Const SIZEOF_INT64 As Long = 8

Private Type INT64

LoPart As Long

HiPart As Long

End Type

Private Type lvItem64 ' was LV_ITEM

mask As Long

iItem As Long

iSubItem As Long

state As Long

stateMask As Long

pszText As Long 'INT64 ' if String, must be pre-allocated

cchTextMax As Long

iImage As Long

lParam64 As Long

'#If (WIN32_IE >= &H300) Then

iIndent As Long

'#End If

iGroup As Long

cColumns As Long

puColumns As INT64

alignment2 As Long

piColFmt As INT64

alignment3 As Long

End Type

Public LVhWnd As Long

Dim LangNonUnicodeName_ As String

Public Function Find_LV_TskMngr() As Long

Dim ret As Long, sClassText As String * 100, tWnd As Long

Dim hHandle As Long

If GetLangNameByCultureCode = "RU" Then

hHandle = FindWindow("#32770", "Диспетчер задач Windows")

ElseIf GetLangNameByCultureCode = "EN" Then

hHandle = FindWindow("#32770", "Windows Task Manager")

End If

If hHandle <> 0 Then

tWnd = FindWindowEx(hHandle, 0, "#32770", vbNullString) 'menu

LVhWnd = FindWindowEx(tWnd, 0, "SysListView32", vbNullString)

ret = GetClassNameA(LVhWnd, sClassText, 100)

If Left(sClassText, ret) = "SysListView32" Then Find_LV_TskMngr = LVhWnd

End If

End Function

Function GetLangNameByCultureCode() As String

Dim Lang$, CultureCode As Long

CultureCode = GetSystemDefaultLCID Mod &H10000

Select Case CultureCode

Case &H419&

'Lang = "ru-RU"

Lang = "RU"

Case &H409&

'Lang = "en-US"

Lang = "EN"

Case Else

Lang = "unknown"

End Select

GetLangNameByCultureCode = Lang

End Function

Private Function ListView_GetItemCount(hWnd As Long) As Long

On Local Error Resume Next

ListView_GetItemCount = SendMessage(hWnd, LVM_GETITEMCOUNT, ByVal 0&, ByVal 0&)

End Function

Public Function GetLVItemTextEx64(hwndLV As Long) As Boolean

Dim i As Long, ItemCount As Long, PID As Long, ProcessHandle As Long, Dummy As Long, Item As lvItem64, hProcess As Long, sL As String, retv

Dim lpMem As Long, pCh As Long, abText(CB_MAXLVITEMTEXT) As Byte, pItem As INT64

GetLVItemTextEx64 = False

hProcess = hwndLV

If hProcess = 0 Then Exit Function

If GetWindowThreadProcessId(hProcess, PID) = 0 Then Exit Function

ProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)

If ProcessHandle = 0 Then Exit Function

pCh = VirtualAllocEx(ProcessHandle, 0, CB_MAXLVITEMTEXT, MEM_COMMIT, PAGE_EXECUTE_READWRITE)

lpMem = VirtualAllocEx(ProcessHandle, 0, Len(Item), MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)

If lpMem Then

ItemCount = ListView_GetItemCount(hwndLV)

For i = 0 To ItemCount - 1

Item.mask = LVIF_TEXT

Item.iItem = i

Item.iSubItem = 0

Item.pszText = VarPtr(CInt64(pCh))'Win64

Item.cchTextMax = CB_MAXLVITEMTEXT

WriteProcessMemory ProcessHandle, lpMem, Item, LenB(Item), Dummy

Call WriteProcessMemory(ProcessHandle, Item.pszText, ByVal abText(0), CB_MAXLVITEMTEXT, retv)

retv = SendMessage(hwndLV, LVM_GETITEMTEXT, i, ByVal lpMem)

If ReadProcessMemory(ProcessHandle, Item.pszText, ByVal VarPtr(abText(0)), CB_MAXLVITEMTEXT, Dummy) > 0 Then

sL = GetStrFromPtrA(VarPtr(abText(0)))

Debug.Print sL' тут лезут одинаковые крякозябры

End If

VirtualFreeEx ProcessHandle, pCh, 0, MEM_RELEASE

VirtualFreeEx ProcessHandle, lpMem, 0, MEM_RELEASE

CloseHandle ProcessHandle

End If

End Function

Private Function GetStrFromPtrA(lpszA As Long) As String

On Local Error Resume Next

Dim nChars As Long

nChars = lstrlenA(ByVal lpszA)

If nChars Then

GetStrFromPtrA = Space$(nChars)

Call MultiByteToWideChar(CP_ACP, 0, ByVal lpszA, nChars, ByVal StrPtr(GetStrFromPtrA), nChars)

End If

End Function

Private Function CInt64(ByVal vCur As Currency) As INT64

vCur = (CCur(vCur) * 0.0001@)

Call CopyMemory(CInt64, vCur, SIZEOF_INT64)

End Function