Attribute VB_Name = "SystemApi"
Option Explicit
'**************************系統相關**************************
'*作者：謝建軍                                              *
'*創建日期：2002年11月18日  20：47                          *
'************************************************************
'*  1.GetWinPath                                            *
'*  2.Cwind(CloseMethod As ClsWinMthd)                      *
'*  3.SleepingFor(ByVal TimeVal As Integer)                 *
'*  4.ShowOrHideCursor(ByVal SorH As ShowOrHide)            *
'*  5.DisableCtrlAltDel(TorF As Boolean)                    *
'*  6.HideMe(TorF As Boolean)                               *
'*  7.ChgMosBut                                             *
'*  8.HideProcess(ToF As Boolean)                           *
'*  9.ChangDispTo(Byval X as integer,Byval Y as integer)    *
'*  10.GetDispXY(Byref X as integer,Byref Y as integer)     *
'*  11.GetKeyStateX(Byval cKeyCode as KeyCodeE)             *
'*  12.SetKeyState(ByVal cKeyCode As KeyCodeE, cOn As Boolean)
'*  13.Open any program or file with the relation program   *
'*  14.Get system current processes                         *
'************************************************************
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH As Integer = 260
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Type PROCESSENTRY32
    dwSize As Long '此結構大小
    cntUsage As Long '進程的引用數，如果為0，則次進程已停止
    th32ProcessID As Long '進程號
    th32DefaultHeapID As Long
    th32ModuleID As Long '此進程引用的模塊ID
    cntThreads As Long '此進程創建的線程數
    th32ParentProcessID As Long '父進程的ID
    pcPriClassBase As Long '這個進程創建的線程的基本優先權
    dwFlags As Long '保留
    szExeFile As String * MAX_PATH
End Type
Private Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        dmSpecVersion As Integer
        dmDriverVersion As Integer
        dmSize As Integer
        dmDriverExtra As Integer
        dmFields As Long
        dmOrientation As Integer
        dmPaperSize As Integer
        dmPaperLength As Integer
        dmPaperWidth As Integer
        dmScale As Integer
        dmCopies As Integer
        dmDefaultSource As Integer
        dmPrintQuality As Integer
        dmColor As Integer
        dmDuplex As Integer
        dmYResolution As Integer
        dmTTOption As Integer
        dmCollate As Integer
        dmFormName As String * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End Type
'Exit windows
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
'Get windows directory
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'Sleep For A few Seconds
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Hide or show Cursor
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'Get system information
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function SystemParametersInfoByVal Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long)
'System
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
'Change Mouse Button
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
'about getdispxy
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
'about changedisp
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long
'About GetKeyStateX
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'About SetKeyState
Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
'About Run
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
'About GetProcess
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private Const SPI_SETSCREENSAVEACTIVE As Long = 97&
Public Enum ClsWinMthd
  LogOff
  Reboot
  PowerOff
  LogOffForce
  RebootForce
  PowerOffForce
End Enum
Public Enum ShowOrHide
  Hide
  Show
End Enum
Public Enum KeyCodeE
  CapsLock = 20#
  NumLock = 144#
  ScrollLock = 145#
End Enum

Public Enum RunMode
    Auto = 0
    rOpen = 1
    rPrint = 2
    rExplore = 3
End Enum
Public Enum RunShowMode
    SW_HIDE = -1 '本來該=0
    SW_SHOWNORMAL = 1
    SW_SHOWMINIMIZED = 2
    SW_SHOWMAXIMIZED = 3
    SW_SHOWNOACTIVATE = 4
    SW_SHOW = 5
    SW_MINIMIZE = 6
    SW_SHOWMINNOACTIVE = 7
    SW_SHOWNA = 8
    SW_RESTORE = 9
End Enum

    
'************
'Exit Windows 98/95/Me
'************
Public Function Cwind(CloseMethod As ClsWinMthd) As Boolean
  Dim tCWin As Long
  Select Case CloseMethod
    Case LogOff
      tCWin = 0&
    Case Reboot
      tCWin = 2&
    Case PowerOff
      tCWin = 1&
    Case LogOffForce
      tCWin = 4&
    Case RebootForce
      tCWin = 2& Or 4&
    Case PowerOffForce
      tCWin = 1& Or 4&
    Case Else
      tCWin = 1&
  End Select
  If ExitWindowsEx(tCWin, 0) = 0 Then
    Cwind = False
  Else
    Cwind = True
  End If
End Function

'**********
'Get Windows Path
'**********
Public Function GetWinPath() As String
  
  Dim WinPathLength As Long, WinPath As String
  WinPathLength = 100
  WinPath = Space(WinPathLength)
  GetWindowsDirectory WinPath, WinPathLength
  WinPath = Left(Trim$(WinPath), Len(Trim$(WinPath)) - 1)
  GetWinPath = WinPath
End Function

'***********************
'Sleep For A few Seconds
'***********************
Public Function SleepingFor(ByVal TimeVal As Single) As Boolean
If TimeVal >= 0 Then
  Sleep CLng(TimeVal * 1000)
  SleepingFor = True
Else
  SleepingFor = False
End If
End Function

'***********************
'Show or hide cursor
'***********************
'windows維持著一個內部顯示計數；倘若bShow為TRUE，
'那么每調用一次這個函數，計數就會遞增1；反之，
'如bShow為FALSE，則計數遞減1。只有在這個計數大于或等于0的情況下，指針才會顯示出來
Public Function ShowOrHideCursor(ByVal SorH As ShowOrHide) As Boolean
  
  Dim tVal As Long
  Select Case SorH
    Case Show
      tVal = -1
      Do Until tVal >= 0
        tVal = ShowCursor(1)
        DoEvents
      Loop
      ShowOrHideCursor = True
    Case Hide
      tVal = 0
      Do Until tVal < 0
        tVal = ShowCursor(0)
        DoEvents
      Loop
      ShowOrHideCursor = True
    Case Else
      ShowOrHideCursor = False
  End Select
End Function
'*******************
'Disable Or Enable CTRL+ALT+DEL
'*******************
Public Function DisableCtrlAltDel(TorF As Boolean) As Boolean
  
  Dim Retval As Long, bold As Boolean
  On Error GoTo eee
eee:
  Retval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, TorF, bold, 0&)
  If Retval = 1& Then
    DisableCtrlAltDel = True
  Else
    DisableCtrlAltDel = False
  End If
End Function
'*******************
'Disable or Enable Program Name Be show in the window when Hit Ctrl+Alt+Del
'*******************
Public Function HideMe(TorF As Boolean)
  
  If TorF Then
    RegisterServiceProcess GetCurrentProcessId, 1&
  Else
    RegisterServiceProcess GetCurrentProcessId, 0& '顯示
  End If
End Function
'******************
'Change Mouse Button
'******************
Public Function ChgMosBut(TorF As Boolean) '
  SwapMouseButton TorF
End Function
'******************
'Frist :隱藏進程
'******************
Public Function HideProcess(ToF As Boolean)
  
  If ToF Then
    RegisterServiceProcess GetCurrentProcessId, 1&
  Else
    RegisterServiceProcess GetCurrentProcessId, 0& 'Show Process Name In The Processes List When Hit Ctrl+Alt+Del
  End If
End Function
'******************
'Change Display
'******************
Public Function ChangDispTo(ByVal X As Integer, ByVal Y As Integer) As Boolean
  Dim dm As DEVMODE
  dm.dmSize = Len(dm)
  dm.dmDriverExtra = 0
  dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
  dm.dmPelsWidth = X
  dm.dmPelsHeight = Y
  ChangDispTo = ChangeDisplaySettings(dm, 0) = 1
End Function
'******************
'Get Display Property
'******************
Public Sub GetDispXY(ByRef X As Integer, ByRef Y As Integer)
    X = GetSystemMetrics(SM_CXSCREEN)
    Y = GetSystemMetrics(SM_CYSCREEN)
End Sub
'******************
'Get Key State
'******************
Public Function GetKeyStateX(ByVal cKeyCode As KeyCodeE) As Boolean
  Dim bkVal(255) As Byte
  If GetKeyboardState(bkVal(0)) <> 0 Then
    GetKeyStateX = (bkVal(cKeyCode) And 1) = 1
  End If
End Function
'******************
'Set Key State
'******************
Public Function SetKeyState(ByVal cKeyCode As KeyCodeE, cOn As Boolean) As Boolean
  Dim bkVal(255) As Byte
  If GetKeyboardState(bkVal(0)) <> 0 Then
    bkVal(cKeyCode) = IIf(cOn, 1, 0)
    SetKeyState = SetKeyboardState(bkVal(0)) <> 0
  End If
End Function
'******************
'Open any program or file with the relation program
'******************
Public Function Run(ByVal cFileName As String, Optional ByVal chWnd As Long, Optional ByVal cRunMode As RunMode, _
                Optional ByVal cParameter As String, Optional ByVal cRunPath As String, _
                Optional ByVal cRunShowMode As RunShowMode) As Boolean
    On Error GoTo lEnd
    If cRunPath = "" Then
        Dim tSz() As String, tI As Integer
        tSz = Split(cFileName, "\", -1, vbTextCompare)
        For tI = 0 To UBound(tSz) - 1
            cRunPath = cRunPath + tSz(tI) + "\"
        Next
    End If
    If cRunShowMode = 0 Then
        cRunShowMode = SW_SHOWNORMAL
    Else
        If cRunShowMode = -1 Then cRunShowMode = 0
    End If
    Dim tRunMode As String
    Select Case cRunMode
    Case Auto: tRunMode = vbNullString
    Case rOpen: tRunMode = "open"
    Case rPrint: tRunMode = "print"
    Case rExplore: tRunMode = "explore"
    End Select
    Run = ShellExecute(chWnd, tRunMode, cFileName, cParameter, cRunPath, CLng(cRunShowMode)) <> 0
lEnd:
End Function

'**********************
'得到系統當前進程信息
'**********************
Public Function GetProcess(ByRef pArr() As String) As Integer
    Dim hSnapShot As Long, tProcess As PROCESSENTRY32, tRetVal As Long, tCount As Integer
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&) '獲取進程快照句柄
    
    '設置此結構的大小
    tProcess.dwSize = Len(tProcess)
    '得到第一個進程的系統快照
    tRetVal = Process32First(hSnapShot, tProcess)
    tCount = 0
    Do While (tRetVal And tCount <= UBound(pArr)) '枚舉系統進程
        pArr(tCount) = "進程ID:" & GetFixStr(tProcess.th32ProcessID, 4, "0") & " 線程數:" & GetFixStr(tProcess.cntThreads, 2, "0") & " 父進程ID:" & GetFixStr(tProcess.th32ParentProcessID, 4, "0") & " 文件名:" & Left$(tProcess.szExeFile, IIf(InStr(1, tProcess.szExeFile, Chr$(0)) > 0, InStr(1, tProcess.szExeFile, Chr$(0)) - 1, 0))
        tRetVal = Process32Next(hSnapShot, tProcess)
        tCount = tCount + 1
    Loop
    CloseHandle hSnapShot '關閉句柄
    GetProcess = tCount '返回進程總數
End Function