VBS GetModuleFileNameEx в VBS скрипте

Тема в разделе "Visual Basic 6 / Сценарии VBScript, JScript", создана пользователем soy, 13 ноя 2015.

  1. soy
    Оффлайн

    soy Новый пользователь

    Сообщения:
    5
    Симпатии:
    4
    Здравствуйте! Проблема вообщем вот в чем: необходимо вернуть путь к файлу по имени процесса.
    Проблема с API GetModuleFileNameEx - не возвращает путь к файлу процесса. Возможно не правильное декларирование? А возможно что-то еще... Буду очень признателен если поможете!
    код:
    Код (vb.net):
    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
     
     
    Последнее редактирование модератором: 13 ноя 2015
    лис.хвост нравится это.
  2. soy
    Оффлайн

    soy Новый пользователь

    Сообщения:
    5
    Симпатии:
    4
    решил сам
    кому интересно вместо mName = String(256, " ") надо mName = Wrap.StrPtr(Wrap.Space(255),"s"), и после вызова ret = Wrap.GetModuleFileNameExA(hProc, 0, mName, MAX_PATH), поставить mName = Wrap.StrGet(mName, "s")
    ТЕМА_ЗАКРЫТА
     
    Heler, Dragokas и лис.хвост нравится это.
  3. soy
    Оффлайн

    soy Новый пользователь

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

    Сергей Активный пользователь

    Сообщения:
    252
    Симпатии:
    120
    У меня задача с родни этой.
    Надо получить путь к файлу имея Caption его открытого окна
     
  5. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.476
    Симпатии:
    4.305
    Сергей, я знаю, что Вы пишите в основном на VB6, поэтому давайте не путать языки. У них в этом плане существенные отличия.
    Если Вас интересует ответ на Ваш вопрос, создайте новую тему с соответствующим префиксом. Спасибо.

    soy, Ваша функция FolderExists относится к языку VB6 и не будет работать здесь, так как в VBS нет функции Dir.
    Есть аналог в составе Scripting.FileSystemObject.
     
    Kиpилл нравится это.
  6. soy
    Оффлайн

    soy Новый пользователь

    Сообщения:
    5
    Симпатии:
    4
    (ссылка удалена, т.к. стала недействительной)
    может это? а хендл можно поймать с помощью FindWindow
    или вот еще
    Найти любое окно :: Информатика и информационные технологии в образовании - методика, уроки, внеклассные мероприятия
     
    Последнее редактирование модератором: 1 май 2016
  7. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.476
    Симпатии:
    4.305
    @soy, на будущее, код лучше перепубликовывать на этот форум хотя бы потому что ссылки не вечные, вот как пример выше.
    Либо через EnumWindows, если Вам известна только часть надписи заголовка окна.
     
    Последнее редактирование: 1 май 2016

Поделиться этой страницей