VBS GetModuleFileNameEx в VBS скрипте

soy

soy

Новый пользователь
Сообщения
5
Реакции
4
Здравствуйте! Проблема вообщем вот в чем: необходимо вернуть путь к файлу по имени процесса.
Проблема с 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
 
Последнее редактирование модератором:
Мне интересно, сам в vbs не особо, в основном пишу на vb, но слышал про wmi. Поэтому задача - избавится от лишних библ в программе (dynwrapx.dll) и написать код без использования их. Необходимо в цикле сканировать процессы на наличие определенного EXE, который запущен из определенного места. В случае если пользователь "случайно" процесс убивает, то скрипт запускает его снова. За "убийством" процесса vbs следит программа. Выше приведенный скрипт как раз для этого, но там dynwrapx.dll, что ни есть хорошо. Буду признателен любой помощи! Заранее спасибо!
 
Сергей, я знаю, что Вы пишите в основном на VB6, поэтому давайте не путать языки. У них в этом плане существенные отличия.
Если Вас интересует ответ на Ваш вопрос, создайте новую тему с соответствующим префиксом. Спасибо.

soy, Ваша функция FolderExists относится к языку VB6 и не будет работать здесь, так как в VBS нет функции Dir.
Есть аналог в составе Scripting.FileSystemObject.
 
Сергей написал(а):
У меня задача с родни этой.
Надо получить путь к файлу имея Caption его открытого окна
Нажмите для раскрытия...
(ссылка удалена, т.к. стала недействительной)
может это? а хендл можно поймать с помощью FindWindow
или вот еще
Найти любое окно :: Информатика и информационные технологии в образовании - методика, уроки, внеклассные мероприятия
 
Последнее редактирование модератором:
soy написал(а):
(ссылка удалена, т.к. стала недействительной)
Нажмите для раскрытия...
The requested URL /Article316.htm was not found on this server.
Нажмите для раскрытия...
@soy, на будущее, код лучше перепубликовывать на этот форум хотя бы потому что ссылки не вечные, вот как пример выше.
soy написал(а):
может это? а хендл можно поймать с помощью FindWindow
Нажмите для раскрытия...
Либо через EnumWindows, если Вам известна только часть надписи заголовка окна.
 
Последнее редактирование:
Назад
Сверху Снизу