modshellwait.bas

Fix通用外接报表程序,读取fix中的实时数据 生成相关报表曲线

Attribute VB_Name = "ModShellWait"
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

'=====================检测进程是否运行===========================
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Type PROCESSENTRY32
    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

Const TH32CS_SNAPPROCESS = &H2

Const TH32CS_SNAPmodule = &H8

Private Type MODULEENTRY32
    dwSize As Long
    th32ModuleID As Long
    th32ProcessID As Long
    GlblcntUsage As Long
    ProccntUsage As Long
    modBaseAddr As Byte
    modBaseSize As Long
    hModule As Long
    szModule As String * 256
    szExePath As String * 1024
End Type

Function IsExeRuning(sFile As String) As Boolean
  Dim ret As Long, lPid As Long
  Dim isLive As Boolean
  Dim Mode As MODULEENTRY32, Proc As PROCESSENTRY32
  Dim hSnapshot As Long, hMSnapshot As Long
    
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
    Proc.dwSize = Len(Proc)
    Mode.dwSize = Len(Mode)
    
    lPid = ProcessFirst(hSnapshot, Proc)
    Do While lPid <> 0
        hMSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, Proc.th32ProcessID)
        Mode.szExePath = Space$(256)
        ret = Module32First(hMSnapshot, Mode)
        If ret > 0 Then
            If InStr(1, Mode.szExePath, sFile, vbTextCompare) > 0 Then 'Mode.szExePath=进程路径
                IsExeRuning = True '找到目标进程
                CloseHandle hMSnapshot
                Exit Do
            Else
                IsExeRuning = False
            End If
        End If
        CloseHandle hMSnapshot
        lPid = ProcessNext(hSnapshot, Proc)
        'Debug.Print lPid
    Loop
    CloseHandle hSnapshot
End Function
'=====================检测进程是否运行===========================

Function ShellWait(ProcessID As Long, Optional Timeout As Long = 5000) As Long
    Dim WaitHandle As Long
    WaitHandle = OpenProcess(SYNCHRONIZE, True, ProcessID)
    ShellWait = WaitForSingleObject(WaitHandle, Timeout)
    CloseHandle WaitHandle
End Function

    
Function CheckFileIsRun(sFile As String, Optional systemtype As String = "XP", Optional AutoRun As Boolean = True) As Boolean
    Dim hand1 As Long, hand2 As Long
    
    If systemtype = "XP" Then
        hand1 = Shell("cmd /c tasklist |find /c /i """ & GetFileExeName(sFile) & """ > c:\IsRun.txt", vbHide)
        hand2 = ShellWait(hand1)
        
        Open "c:\IsRun.txt" For Input As #1
            Line Input #1, s
        Close #1
        
        Kill "c:\IsRun.txt"
    Else
        If IsExeRuning(GetFileExeName(sFile)) = True Then
            s = "1"
        Else
            s = "0"
        End If
    End If

    If CInt(s) = 0 Then
        Call Shell(sFile, vbMinimizedNoFocus)
        If AutoRun Then
            CheckFileIsRun = False
        End If
    Else
        CheckFileIsRun = True
    End If
End Function

Function GetFileExeName(sFile As String) As String
    Dim i1 As Integer
    i1 = InStr(1, StrReverse(sFile), "\")
    If i1 = 0 Then
        GetFileExeName = sFile
    Else
        GetFileExeName = StrReverse(Mid(StrReverse(sFile), 1, i1 - 1))
    End If
End Function