Option Explicit
Private Const NORMAL_PRIORITY_CLASS = H20 如果进程位于前台，则基本值是9；如果在后台，则优先值为7
Private Const INFINITE = HFFFFFFFF
Private Const WAIT_TIMEOUT = H102
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
说明∶STARTUPINFO结构用在CreateProcess函数中指定为新进程建立的新窗口的主要属性。这一信息影响由CreateWindows函数建立的第一个窗口
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Private PatchFolder As String 补丁文件夹
Private Arry() As String 文件名数组
Private TotalPatch As Integer
Private Progress As Integer 安装进度
------------------------------------------------------------
浏览文件夹
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_BROWSEFORCOMPUTER = H1000
Private Const BIF_BROWSEFORPRINTER = H2000
Private Const BIF_BROWSEINCLUDEFILES = H4000
Private Const BIF_DONTGOBELOWDOMAIN = H2
Private Const BIF_EDITBOX = H10
Private Const BIF_RETURNFSANCESTORS = H8
Private Const BIF_RETURNONLYFSDIRS = H1
Private Const BIF_STATUSTEXT = H4
Private Const BIF_USENEWUI = H40
Private Const BIF_VALIDATE = H20
------------------------------------------------------------
窗口操作:
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_MAXIMIZE = 3
Private Const SW_RESTORE = 9
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_HOTKEY As Long = H312
-----------------------------------------------------------
Private Sub Command1_Click()
Call SelectFolder
End Sub
Private Sub Command3_Click()
Me.Caption = "正在安装补丁..."
ShowWindow Me.hwnd, SW_MINIMIZE 最小化
Timer1.Enabled = True
End Sub
Private Sub WaitForTerm(pinfo As PROCESS_INFORMATION)
Dim res
等待指定的进程进入空闲状态，,空闲(Idle)指的是进程准备处理一条消息、但目前暂时没有消息需要处理的一种状态
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
Call CloseHandle(pinfo.hThread) 关闭指定进程
Do
等待发出信号
res = WaitForSingleObject(pinfo.hProcess, 0)
If res WAIT_TIMEOUT Then 如果对象发出了信号
Exit Do
End If
DoEvents
Loop While True
Command1.Enabled = True
Call CloseHandle(pinfo.hProcess)
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Call SelectFolder
End Sub
Private Sub SelectFolder()
Dim I As Integer
PatchFolder = BrowseFolder(Me.hwnd)
If GetFileList(PatchFolder) = True Then
TotalPatch = UBound(Arry)
Label1.Caption = "文 件 夹: " PatchFolder Chr(13) _
"合计补丁: " TotalPatch " 个"
Else
MsgBox "该文件夹下没有发现补丁文件，请重新设置!", vbExclamation, "错误"
End If
End Sub
Function BrowseFolder(Optional hwnd As Long) As String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim folder As String
folder = String(255, vbNullChar)
With bi
.hOwner = hwnd
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI Or BIF_EDITBOX
.pidlRoot = 0
.lpszTitle = "请选择一个存放系统补丁文件夹:" vbNullChar
End With
pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
BrowseFolder = Left(folder, InStr(folder, vbNullChar) - 1)
Else
BrowseFolder = ""
End If
End Function
Function GetFileList(folder As String) As Boolean
Dim FSO As New FileSystemObject
Dim F As Object, FC As Object, Counts As Integer, F1 As Variant, F2 As String, LoadIt As Boolean
If folder "" Then
Set F = FSO.GetFolder(folder)
Set FC = F.Files
Counts = 0
ReDim Preserve Arry(0)
LoadIt = False
For Each F1 In FC
F2 = UCase(Right(F1.Name, 3))
If F2 = "EXE" Then
Counts = Counts + 1
ReDim Preserve Arry(Counts)
Arry(Counts) = folder "" F1.Name " /passive /norestart"
LoadIt = True
End If
Next
If UBound(Arry) = 0 Then LoadIt = False
If LoadIt Then GetFileList = True Else GetFileList = False
End If
End Function
Private Sub Timer1_Timer() 为窗口最小化，延迟500ms
Timer1.Enabled = False
Dim res
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags = 0
Dim I As Integer
For I = 1 To TotalPatch
Label1.Refresh
CreateProcess 函数，用于创建一个新的进程
res = CreateProcess(vbNullString, Arry(I), 0, 0, True, NORMAL_PRIORITY_CLASS, ByVal 0, vbNullString, sinfo, pinfo)
Progress = I
WaitForTerm pinfo 进入等待循环
Next I
Me.SetFocus
Me.Caption = "自动安装系统补丁"
Label1.Caption = "恭喜！全部补丁安装完毕！为了使补丁生效，建议重新启动计算机！"
ShowWindow Me.hwnd, SW_RESTORE 恢复窗口
End Sub
-----------------------
程序+原马:
http://
www.little-tube.com/upload/autopatch.rar