如果您的程序需要24小时运行,不希望它由于某种原因而退出到系统下(比如网突然断了,而您有没有为所有访问网络的程序增加异常处理代码),特别是为公众服务的应用系统,那么您可以自己做一个守护程序,下面给你一个示例代码,少作修改既可以实现了。
'***********************************************
' 名称: 进程守护脚本
' 版本: 0.1
' 功能: 监视某个进程, 没有则启动
' 作者: 徐承禹 太原铁路局
' 编制时间: 2008.12.26
'***********************************************
Option Explicit
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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) 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
'所需要的一些定义
Dim ret As Long, lPid As Long
Dim Mode As MODULEENTRY32, Proc As PROCESSENTRY32
Dim hSnapshot As Long, hMSnapshot As Long
Dim sFilename As String
Private Sub Form_Load()
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Dim hWnd1 As Long
hWnd1 = FindWindow("Shell_traywnd", "")
'显示任务栏
'SetWindowPos hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW
'隐藏任务栏
SetWindowPos hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW
'App.TaskVisible = False '不要在任务管理内显示
Me.Hide
End Sub
Private Sub Timer1_Timer()
Dim isLive As Boolean
sFilename = App.Path & "/目的启动程序.exe" ' 要守护的进程
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, sFilename, vbTextCompare) > 0 Then 'Mode.szExePath=进程路径
isLive = True '找到目标进程
CloseHandle hMSnapshot
Exit Do
End If
End If
CloseHandle hMSnapshot
lPid = ProcessNext(hSnapshot, Proc)
Loop
CloseHandle hSnapshot
If Not isLive Then
ShellExecute 0, "", sFilename, "", "", 1 '如果目标进程不存在 则启动它
End If
End Sub
ok,现在您可以享受您的成果了,再也不怕您的程序会异常退出了。
'***********************************************
' 名称: 进程守护脚本
' 版本: 0.1
' 功能: 监视某个进程, 没有则启动
' 作者: 徐承禹 太原铁路局
' 编制时间: 2008.12.26
'***********************************************
Option Explicit
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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) 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
'所需要的一些定义
Dim ret As Long, lPid As Long
Dim Mode As MODULEENTRY32, Proc As PROCESSENTRY32
Dim hSnapshot As Long, hMSnapshot As Long
Dim sFilename As String
Private Sub Form_Load()
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Dim hWnd1 As Long
hWnd1 = FindWindow("Shell_traywnd", "")
'显示任务栏
'SetWindowPos hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW
'隐藏任务栏
SetWindowPos hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW
'App.TaskVisible = False '不要在任务管理内显示
Me.Hide
End Sub
Private Sub Timer1_Timer()
Dim isLive As Boolean
sFilename = App.Path & "/目的启动程序.exe" ' 要守护的进程
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, sFilename, vbTextCompare) > 0 Then 'Mode.szExePath=进程路径
isLive = True '找到目标进程
CloseHandle hMSnapshot
Exit Do
End If
End If
CloseHandle hMSnapshot
lPid = ProcessNext(hSnapshot, Proc)
Loop
CloseHandle hSnapshot
If Not isLive Then
ShellExecute 0, "", sFilename, "", "", 1 '如果目标进程不存在 则启动它
End If
End Sub
ok,现在您可以享受您的成果了,再也不怕您的程序会异常退出了。