soy
Новый пользователь
- Сообщения
- 5
- Реакции
- 4
Здравствуйте! Проблема вообщем вот в чем: необходимо вернуть путь к файлу по имени процесса.
Проблема с API GetModuleFileNameEx - не возвращает путь к файлу процесса. Возможно не правильное декларирование? А возможно что-то еще... Буду очень признателен если поможете!
код:
Проблема с API GetModuleFileNameEx - не возвращает путь к файлу процесса. Возможно не правильное декларирование? А возможно что-то еще... Буду очень признателен если поможете!
код:
VB.NET / VBA:
Const SW_SHOWNORMAL = 1
Const SW_MINIMIZE = 6
Const TH32CS_SNAPHEAPLIST = 1
Const TH32CS_SNAPPROCESS = 2
Const TH32CS_SNAPTHREAD = 4
Const TH32CS_SNAPMODULE = 8
Const TH32CS_SNAPALL = 15
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH = 260
Const PROCESS_QUERY_INFORMATION = 1024
Const PROCESS_VM_READ = 16
WM_SETTEXT = 12
GPTR = 64
'Type PROCESSENTRY32
' dwSize
' cntUsage
' th32ProcessID
' th32DefaultHeapID
' th32ModuleID
' cntThreads
' th32ParentProcessID
' pcPriClassBase
' dwFlags
' szExeFile$ * MAX_PATH
'End Type
' Смещения членов структуры PROCESSENTRY32:
dwSize = 0
cntUsage = 4
th32ProcessID = 8
th32DefaultHeapID = 12
th32ModuleID = 16
cntThreads = 20
th32ParentProcessID = 24
pcPriClassBase = 28
dwFlags = 32
szExeFile = 36
Wrap.Register "kernel32", "CreateToolhelp32Snapshot", "i=uu", "r=h"
Wrap.Register "kernel32", "Process32First", "i=hp", "r=l"
Wrap.Register "kernel32", "OpenProcess", "i=llu", "r=h"
Wrap.Register "kernel32", "Process32Next", "i=hp", "r=l"
Wrap.Register "kernel32", "CloseHandle", "i=h", "r=l"
Wrap.Register "psapi", "GetModuleFileNameExA", "i=hhsu", "r=l"
Wrap.Register "kernel32", "GlobalAlloc", "i=uu", "r=p"
Wrap.Register "kernel32", "GlobalFree", "i=p", "r=p"
Size = 9 * 4 + MAX_PATH
Struct = Wrap.GlobalAlloc(GPTR, Size)
Wrap.NumPut Size, Struct, dwSize, "u"
dim PathProg,NameProc,pAppData
PathProg = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
pAppData = WScript.CreateObject("WScript.Shell").SpecialFolders("AppData")
if PathProg = pAppData & "\Opera Software\User" then
PathProg = pAppData & "\Opera Software\User"
elseif PathProg = Left(pAppData, Len(pAppData) - InStr(1, pAppData, "AppData") + Len("AppData") - 1) & "\Local\Google\Chrome\User" then
PathProg = Left(pAppData, Len(pAppData) - InStr(1, pAppData, "AppData") + Len("AppData") - 1) & "\Local\Google\Chrome\User"
end if
NameProc = FindFileOnMask(PathProg & "\", "exe")
if FindProcByName(NameProc,PathProg & "\" & NameProc) then
msgbox "запущен"
else
msgbox "Не запущен"
end if
Function FindFileOnMask(s, sMask)
Dim oFld, v, i,oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFld = oFSO.GetFolder(s)
For Each v In oFld.Files
If LCase(oFSO.GetExtensionName(s & "\" & v.Name)) = sMask Then
FindFileOnMask = v.Name
Exit For
End If
Next
End Function
Function FindProcByName(ProcName,nPathEXE)
Dim hSnapshot, r, rClose, hProc, ProcessName, FindProc, ProcessFound, ret, mName, ProcessID '104
'**********************************************************************
FindProc = ProcName
hSnapshot = Wrap.CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0)
r = Wrap.Process32First(hSnapshot, Struct)
Do While r
ProcessName = Struct + szExeFile
ProcessName = Wrap.StrGet(ProcessName, "s")
If StrComp(ProcessName, FindProc, 1) = 0 Then
msgbox "ProcessName " & ProcessName
ProcessFound = True
ProcessID = Wrap.NumGet(Struct, th32ProcessID, "u")
hProc = Wrap.OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, ProcessID)'124
mName = String(256, " ")
ret = Wrap.GetModuleFileNameExA(hProc, 0, mName, MAX_PATH)
If InStr(1, mName, nPathEXE) Then
FindProcByName = True
Exit Do
Else
FindProcByName = False
End If
End If
r = Wrap.Process32Next(hSnapshot, Struct)
Loop
Wrap.CloseHandle hSnapshot
Wrap.GlobalFree Struct
End Function
Public Function FolderExists(ByVal strPathName)
On Error Resume Next
Dim DirectoryFound
Const errPathNotFound = 76
On Error GoTo 0
DirectoryFound = Dir(strPathName, 16 Or 2)
If (Len(DirectoryFound) = 0 Or Err = errPathNotFound) Then
FolderExists = False
Else
FolderExists = True
End If
End Function
Последнее редактирование модератором: