' ================================================
' 安装程序控件V1.1
' 作者:Huang Guan
' 2005-2-1 14:50
' ================================================

' 获得系统目录路径
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
' 等待指定进程运行结束
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function
WaitForSingleObject Lib "kernel32" _
(
ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function
CloseHandle Lib "kernel32" _
(
ByVal hObject As Long) As Long
Private Const
INFINITE = -1&
Private Const SYNCHRONIZE = &H100000


Private Function GetSysDir() As String
Dim
TmpSysPath As String * 256, TmpLength As Byte
TmpLength = GetSystemDirectory(TmpSysPath, 256)
GetSysDir = Left(TmpSysPath, TmpLength)
End Function
Private Function
FileExist(ByVal FilePath As String) As Boolean
If
Dir(FilePath, vbNormal Or vbSystem Or vbHidden) <> "" Then
FileExist = True
Else
FileExist = False
End If
End Function
Private Function
RunAndWait(ByVal FilePath As String, Optional LongTime As Long = 0) As Boolean
Dim
pid As Long
Dim
ExitEvent As Long
Dim
hProcess As Long '进程句柄
pid = Shell(FilePath, vbNormalNoFocus)
hProcess = OpenProcess(SYNCHRONIZE,
False, pid)
If LongTime = 0 Then
ExitEvent = WaitForSingleObject(hProcess, INFINITE)
Else
ExitEvent = WaitForSingleObject(hProcess, LongTime)
End If
RunAndWait = ExitEvent
ExitEvent = CloseHandle(hProcess)
End Function

Public Sub
SetupCtrl(ByVal Files As String, ByVal ResID As String)
On Error GoTo ErrHandle
Dim arrCtrls() As String, TempFile() As Byte, arrRes() As String, SystemPath As String, FileNum As Integer
arrCtrls = Split(Files, "|")
arrRes = Split(ResID,
"|")
SystemPath = GetSysDir
For i = 0 To UBound(arrCtrls)
If FileExist(SystemPath & "\" & arrCtrls(i)) = False Then
TempFile = LoadResData(arrRes(i), "CUSTOM")
FileNum = FreeFile
Open SystemPath &
"\" & arrCtrls(i) For Binary Access Write As #FileNum '新建文件(把 Winsock等 控件复制到指定目录下)
Put #FileNum, , TempFile
Close #FileNum
RunAndWait "regsvr32 " & SystemPath & "\" & arrCtrls(i) & " /s", 0 '注册控件,无弹出对话框
End If
Next
Exit Sub
ErrHandle:
MsgBox Err.Description
End Sub


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!