?? modmain.bas
字號:
Attribute VB_Name = "modMain"
'****************************以下判斷CMPP進程是否在運行 *******************************
Const MAX_PATH& = 260
'Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
'Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_CLOSE = &H10
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 * MAX_PATH
End Type
Public Function ExecBackupResotre(ByVal strSQL As String, _
ByVal strConnectAccout As String, _
ByVal strConnectPassWord As String, _
Optional ByVal blnReturnRS As Boolean = False, _
Optional ByRef recResult As ADODB.Recordset) As Boolean
On Error GoTo ExecSQL_Err
Dim codCommand As ADODB.Command
Set codCommand = New ADODB.Command
Dim cntConnection As ADODB.Connection
Dim strConnectionString As String
Dim strParam As String
strParam = "Provider=SQLOLEDB.1;" & _
"Persist Security Info=True;" & _
"User ID=" & strConnectAccout & ";" & _
"Data Source=.;" & _
"Password=" & strConnectPassWord & ";"
Set cntConnection = New ADODB.Connection
cntConnection.Open strParam
With codCommand
.ActiveConnection = cntConnection
.CommandText = strSQL
.CommandType = adCmdText
If blnReturnRS Then
If recResult Is Nothing Then
Set recResult = New ADODB.Recordset
Else
If recResult.State = adStateOpen Then
recResult.Close
End If
End If
With recResult
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.MaxRecords = lngMaxRecords
.Open codCommand
End With
Else
Set recResult = .Execute
End If
End With
ExecSQL_Exit:
ExecBackupResotre = True
Exit Function
If Not cntConnection Is Nothing Then
Set cntConnection = Nothing
End If
ExecSQL_Err:
App.LogEvent Err.Description, vbLogEventTypeError
Err.Raise Err.Number, ".ExecSQL -> " & Err.Source, Err.Description
ExecBackupResotre = False
Resume ExecSQL_Exit
End Function
' Purpose : 判斷是否有指定的進程在工作
' Argument : blnReturnRS
' : strSQL
' : strCaller
' : recResult
' : lngMaxRecords
' Reture : True if successful otherwise False
' Authors : Andy Zheng
' Create Date : 20-Sep-1999
' Last Modification date: 02-Jun-2000
Public Function ExistProcess(myName As String) As Boolean
On Error Resume Next
Const PROCESS_ALL_ACCESS = 0
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim AppKill As Boolean
Dim appCount As Integer
Dim i As Integer
On Local Error GoTo Finish
appCount = 0
Const TH32CS_SNAPPROCESS As Long = 2&
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
ExistProcess = False
Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If LCase$(szExename) = LCase$(myName) Then
ExistProcess = True
Exit Do
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Finish:
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -