module1.bas

来自「Billing Internet Cafe」· BAS 代码 · 共 57 行

Attribute VB_Name = "Module1"
Option Explicit

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260


Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Function GetPID(hExeName As String) As PROCESSENTRY32
    Dim hSnapShot As Long, uProcess As PROCESSENTRY32, R As Long
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    R = Process32First(hSnapShot, uProcess)
    Do While R
        If InStr(1, LCase(uProcess.szExeFile), LCase(hExeName), vbTextCompare) > 0 Then
           GetPID = uProcess
           CloseHandle hSnapShot
           Exit Do
        End If
        R = Process32Next(hSnapShot, uProcess)
    Loop
    CloseHandle hSnapShot
End Function
Function getCurUser() As String
On Error Resume Next
    Dim strString As String
    strString = String(255, Chr(0))
    GetUserName strString, 255
    getCurUser = Left(strString, InStr(1, strString, Chr(0)) - 1)
End Function

Function myAppName() As String
If Right(LCase(App.EXEName), 4) = ".exe" Then
   myAppName = App.EXEName
Else
   myAppName = App.EXEName & ".exe"
End If
End Function