www.pudn.com > ownfirewall > RunProc.bas

Attribute VB_Name = "RunProc" 
Option Explicit 
 
Public Const MAX_PATH = 260 
Public Const BIF_RETURNONLYFSDIRS = &H1 
 
Public Const SHGFI_DISPLAYNAME = &H200 
Public Const SHGFI_EXETYPE = &H2000 
Public Const SHGFI_SYSICONINDEX = &H4000  'system icon index 
Public Const SHGFI_LARGEICON = &H0        'large icon 
Public Const SHGFI_SMALLICON = &H1        'small icon 
Public Const ILD_TRANSPARENT = &H1        'display transparent 
Public Const SHGFI_SHELLICONSIZE = &H4 
Public Const SHGFI_TYPENAME = &H400 
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or _ 
             SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or _ 
             SHGFI_DISPLAYNAME Or SHGFI_EXETYPE 
 
Public Type SHFILEINFO 
   hIcon          As Long 
   iIcon          As Long 
   dwAttributes   As Long 
   szDisplayName  As String * MAX_PATH 
   szTypeName     As String * 80 
End Type 
 
Public shinfo As SHFILEINFO 
 
Type ProcEntry 
  dwSize As Long 
  cntUsage As Long 
  th32ProcessID As Long 
  th32DefaultHeapID As Long 
  th32ModuleID As Long 
  cntThreads As Long 
  th32ParentProcessID As Long 
  pcPriClassBase As Long 
  dwFlags As Long 
  szExeFile As String * 260 
End Type 
 
Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As ProcEntry) As Long 
Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As ProcEntry) As Long 
 
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long 
 
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long 
Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long) 
 
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long 
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long 
 
'Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long 
 
Public Declare Function ImageList_Draw Lib "comctl32.dll" _ 
   (ByVal himl&, _ 
    ByVal i&, _ 
    ByVal hDCDest&, _ 
    ByVal x&, _ 
    ByVal y&, _ 
    ByVal flags&) As Long 
 
Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _ 
   (ByVal pszPath As String, _ 
    ByVal dwFileAttributes As Long, _ 
    psfi As SHFILEINFO, _ 
    ByVal cbSizeFileInfo As Long, _ 
    ByVal uFlags As Long) As Long 
 
Public mvarCompanyName As String 
Public mvarFileDescription As String 
Public mvarFileVersion As String 
Public mvarInternalName As String 
Public mvarLegalCopyright As String 
Public mvarOriginalFileName As String 
Public mvarProductName As String 
Public mvarProductVersion As String 
Public mvarFileName As String 
Public Procs(200) As ProcEntry 
 
 
Function FindFileInfo(strFileName As String) As Long 
'On Error GoTo GetFileVersionData_Error 
Dim sInfo As String, lSizeof As Long 
Dim lResult As Long, intDel As Integer 
Dim lHandle As Long 
'Dim ftime As SYSTEMTIME 
'Dim filedata As WIN32_FIND_DATA 
Dim intStrip As Integer 
'Dim SHFI As SHFILEINFO 
Dim lSizeSHFI As Long 
Dim lFlags As Long 
  mvarCompanyName = "" 
  mvarFileDescription = "" 
  mvarFileVersion = "" 
  mvarInternalName = "" 
  mvarLegalCopyright = "" 
  mvarOriginalFileName = "" 
  mvarProductName = "" 
  mvarProductVersion = "" 
  mvarFileName = "" 
  If strFileName <> "" Then 
    ' Get CompanyName, FileDescription, FileVersion, InternalName 
    ' LegalCopyright, OriginalFilename, ProductName, ProductVersion 
    lHandle = 0 
    lSizeof = GetFileVersionInfoSize(strFileName, lHandle) 
    If lSizeof > 0 Then 
      sInfo = String$(lSizeof, 0) 
      lResult = GetFileVersionInfo(ByVal strFileName, 0&, ByVal lSizeof, ByVal sInfo) 
      If lResult Then 
        intDel = InStr(sInfo, "CompanyName") 
        If intDel > 0 Then 
          intDel = intDel + 12 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarCompanyName = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "FileDescription") 
        If intDel > 0 Then 
          intDel = intDel + 16 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarFileDescription = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "FileVersion") 
        If intDel > 0 Then 
          intDel = intDel + 12 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarFileVersion = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "InternalName") 
        If intDel > 0 Then 
          intDel = intDel + 16 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarInternalName = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "LegalCopyright") 
        If intDel > 0 Then 
          intDel = intDel + 16 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarLegalCopyright = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "OriginalFilename") 
        If intDel > 0 Then 
          intDel = intDel + 20 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarOriginalFileName = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "ProductName") 
        If intDel > 0 Then 
          intDel = intDel + 12 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarProductName = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
        intDel = InStr(sInfo, "ProductVersion") 
        If intDel > 0 Then 
          intDel = intDel + 16 
          intStrip = InStr(intDel, sInfo, vbNullChar) 
          mvarProductVersion = Mid$(sInfo, intDel, intStrip - intDel) 
        End If 
      End If 
    End If 
    FindFileInfo = 1 
  Else 
    FindFileInfo = 0 
  End If 
End Function