[VB]GUI Easy Sysprep 1.1 源代码[1 自动封装主程序源代码]

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode 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 Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Dim pidNotepad As Long
Dim hProcess As Long

Dim SystemDrive As String
Dim WinDir As String
Dim LogoPath As String
Dim IcoPath1 As String
Dim IcoPath2 As String
Dim LinkPath1 As String
Dim LinkPath2 As String
Dim BmpPath As String
Dim RegPath As String
Dim ServPath As String

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 'Maintenance String For PSS usage
OsName As String '操作系统的名称
End Type

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 Sub Command1_Click(Index As Integer)
'外接程序路径读取
' 设置“CancelError”为 True
CommonDialog1(Index).CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog1(Index).Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1(Index).Filter = "所有程序 (*.*)|*.*|应用程序 (*.exe)|*.exe|MS-DOS 批处理文件 (*.bat)|*.bat| Windows NT 命令脚本 (*.cmd)|*.cmd"
' 指定缺省的过滤器
CommonDialog1(Index).FilterIndex = 2
' 显示“打开”对话框
CommonDialog1(Index).ShowOpen
' 显示选定文件的名字
Text1(Index).Text = CommonDialog1(Index).FileName
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Public Sub Write_ESP_Config()
Dim i As Integer
Open WinDir & "config.esp" For Output As #1
Close #1
'AllUsrRun
'是否自动弹出光盘
If Check5.Value = 1 Then
Open WinDir & "config.esp" For Append As #1
Print #1, "True"
Close #1
Else
Open WinDir & "config.esp" For Append As #1
Print #1, "False"
Close #1
End If
'写AllUsrRun外接程序配置
For i = 0 To 2
Open WinDir & "config.esp" For Append As #1
Print #1, Text1(i).Text
If Check1(i).Value = 1 Then
   Print #1, "True"
Else
   Print #1, "False"
End If
If Check2(i).Value = 1 Then
   Print #1, "True"
Else
   Print #1, "False"
End If
Close #1
Next
'配置IP
Open WinDir & "config.esp" For Append As #1
Print #1, Text3.Text
Print #1, Text4.Text
Print #1, Text5.Text
Print #1, Text6.Text
Print #1, Text14.Text
Close #1
'是否注入注册表
If Check3.Value = 1 Then
Open WinDir & "config.esp" For Append As #1
   Print #1, "True"
   Print #1, RegPath
Close #1
Else
Open WinDir & "config.esp" For Append As #1
   Print #1, "False"
   Print #1, ""
Close #1
End If
'是否加入自动清除AutoRun病毒的功能
If Check14.Value = 1 Then
Open WinDir & "config.esp" For Append As #1
   Print #1, "True"
Close #1
Else
Open WinDir & "config.esp" For Append As #1
   Print #1, "False"
Close #1
End If
'GUIRunOnce
'写GUIRunOnce外接程序配置
For i = 3 To 5
Open WinDir & "config.esp" For Append As #1
Print #1, Text1(i).Text
If Check1(i).Value = 1 Then
   Print #1, "True"
Else
   Print #1, "False"
End If
If Check2(i).Value = 1 Then
   Print #1, "True"
Else
   Print #1, "False"
End If
Close #1
Next
'是否加入第一次进系统运行服务优化程序
If Check4.Value = 1 Then
Open WinDir & "config.esp" For Append As #1
   Print #1, "True"
   Print #1, ServPath
Close #1
Else
Open WinDir & "config.esp" For Append As #1
   Print #1, "False"
   Print #1, ""
Close #1
End If
End Sub

Private Sub Command11_Click()
If Option3.Value = True Then
' 设置“CancelError”为 True
CommonDialog10.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog10.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog10.Filter = "所有程序 (*.*)|*.*|应用程序 (*.exe)|*.exe|MS-DOS 批处理文件 (*.bat)|*.bat| Windows NT 命令脚本 (*.cmd)|*.cmd"
' 指定缺省的过滤器
CommonDialog10.FilterIndex = 2
' 显示“打开”对话框
CommonDialog10.ShowOpen
' 显示选定文件的名字
LinkPath2 = CommonDialog10.FileName
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End If
If Option4.Value = True Then
LinkPath2 = InputBox("您要链接的网站地址:", "链接")
End If
End Sub

Private Sub Command12_Click()
' 设置“CancelError”为 True
CommonDialog12.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog12.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog12.Filter = "所有程序 (*.*)|*.*|位图文件 (*.bmp)|*.bmp"
' 指定缺省的过滤器
CommonDialog12.FilterIndex = 2
' 显示“打开”对话框
CommonDialog12.ShowOpen
' 显示选定文件的名字
BmpPath = CommonDialog12.FileName
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Private Sub Command13_Click()
ShellExecute Me.hwnd, "open", WinDir & "system32devmgmt.msc", vbNullString, vbNullString, 0
End Sub

Private Sub Command14_Click()
Me.Enabled = False
'写ESP配置文件
Call Write_ESP_Config
'注入用户名和公司名
Call OEM_Full_Org
'注入OEM信息和OEM Logo
Call OEM_Info_Logo
'注入开始菜单OEM信息
Call OEM_StartMenu
'注入IE浏览器OEM信息
Call OEM_IE
'修改部署图片和部署分辨率
Call Resolution
'封装
Call Encapsulation
MsgBox "封装结束！", vbOKOnly, "Easy Sysprep V1.1"
'是否使用DllCache备份
If Check13.Value = 1 Then
MsgBox "您选择了使用DllCache，请在随后弹出的窗口中选中“重启后自动启动并恢复和自我删除”，然后点击“备份”即可！", vbOKOnly, "Easy Sysprep V1.1"
Shell WinDir & "system32DLLCache.exe", vbNormalFocus
End If
End
End Sub

Private Sub Command15_Click()
End
End Sub

Private Sub Command2_Click()
' 设置“CancelError”为 True
CommonDialog11.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog11.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog11.Filter = "所有程序 (*.*)|*.*|图标文件 (*.ico)|*.ico"
' 指定缺省的过滤器
CommonDialog11.FilterIndex = 2
' 显示“打开”对话框
CommonDialog11.ShowOpen
' 显示选定文件的名字
IcoPath2 = CommonDialog11.FileName
Picture3.Picture = LoadPicture(IcoPath2)
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Private Sub Command3_Click()
' 设置“CancelError”为 True
CommonDialog2.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog2.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog2.Filter = "所有程序 (*.*)|*.*|注册表项 (*.reg)|*.reg"
' 指定缺省的过滤器
CommonDialog2.FilterIndex = 2
' 显示“打开”对话框
CommonDialog2.ShowOpen
' 显示选定文件的名字
RegPath = CommonDialog2.FileName
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Private Sub Command4_Click()
' 设置“CancelError”为 True
CommonDialog3.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog3.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog3.Filter = "所有程序 (*.*)|*.*|应用程序 (*.exe)|*.exe"
' 指定缺省的过滤器
CommonDialog3.FilterIndex = 2
' 显示“打开”对话框
CommonDialog3.ShowOpen
' 显示选定文件的名字
ServPath = CommonDialog3.FileName
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Private Sub Command7_Click()
' 设置“CancelError”为 True
CommonDialog7.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog7.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog7.Filter = "所有程序 (*.*)|*.*|位图文件 (*.bmp)|*.bmp"
' 指定缺省的过滤器
CommonDialog7.FilterIndex = 2
' 显示“打开”对话框
CommonDialog7.ShowOpen
' 显示选定文件的名字
LogoPath = CommonDialog7.FileName
Picture1.Picture = LoadPicture(LogoPath)
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Private Sub Command8_Click()
' 设置“CancelError”为 True
CommonDialog7.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog7.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog7.Filter = "所有程序 (*.*)|*.*|图标文件 (*.ico)|*.ico"
' 指定缺省的过滤器
CommonDialog7.FilterIndex = 2
' 显示“打开”对话框
CommonDialog7.ShowOpen
' 显示选定文件的名字
IcoPath1 = CommonDialog7.FileName
Picture2.Picture = LoadPicture(IcoPath1)
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub

Private Sub Command9_Click()
If Option1.Value = True Then
' 设置“CancelError”为 True
CommonDialog8.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog8.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog8.Filter = "所有程序 (*.*)|*.*|应用程序 (*.exe)|*.exe|MS-DOS 批处理文件 (*.bat)|*.bat| Windows NT 命令脚本 (*.cmd)|*.cmd"
' 指定缺省的过滤器
CommonDialog8.FilterIndex = 2
' 显示“打开”对话框
CommonDialog8.ShowOpen
' 显示选定文件的名字
LinkPath1 = CommonDialog8.FileName
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End If
If Option2.Value = True Then
LinkPath1 = InputBox("您要链接的网站地址:", "链接")
End If
End Sub

Private Sub Form_Load()
'获取操作系统类型和版本
Dim Ver As OSVERSIONINFO
Ver = GetWindowsVersion()
Label5.Caption = Ver.OsName
'移动到屏幕中央
Call Move_to_Center
'初始化变量
SystemDrive = Environ("systemdrive")
WinDir = Environ("windir")
LinkPath1 = "sysdm.cpl"
LinkPath2 = "sysdm.cpl"
RegPath = WinDir & "REG_Optimize.reg"
ServPath = WinDir & "Serv_Optimize.exe"
'初始化列表框
Combo1.AddItem "800x600,32位色", 0
Combo1.AddItem "1024x768,32位色", 1
End Sub

Public Sub OEM_Full_Org()
'OEM_用户名和公司名
Dim FullName As String, OrgName As String
Dim str As String
'FullName
FullName = Text7.Text
'If FullName <> "" Then
' Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersion" & Chr(34) & " " & "/v RegisteredOwner /d " & FullName & " /f", vbHide
'End If
'OrgName
OrgName = Text8.Text
'If OrgName <> "" Then
' Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersion" & Chr(34) & " " & "/v RegisteredOrganization /d " & OrgName & " /f", vbHide
'End If
If Dir(SystemDrive & "sysprepsysprep.inf") = "" Then Exit Sub
Name SystemDrive & "sysprepsysprep.inf" As SystemDrive & "sysprepsysprep.inf.bak"
Open SystemDrive & "sysprepsysprep.inf.bak" For Input As #4
Open SystemDrive & "sysprepsysprep.inf" For Output As #5
While Not EOF(4)
Line Input #4, str
If Mid(Trim(str), 1, 8) = "FullName" And FullName <> "" Then
   Print #5, "FullName=" & Chr(34) & FullName & Chr(34)
ElseIf Mid(Trim(str), 1, 7) = "OrgName" And OrgName <> "" Then
   Print #5, "OrgName=" & Chr(34) & OrgName & Chr(34)
Else
   Print #5, str
End If
Wend
Close #4
Close #5
Kill SystemDrive & "sysprepsysprep.inf.bak"
End Sub

Public Sub OEM_Info_Logo()
'OEM_信息和Logo
Dim Manufacturer As String, Model As String
Dim m As Integer, n As Integer, i As Integer, s As String, c As String
'信息－>制造商、电脑型号
Manufacturer = Text9.Text
Model = Text10.Text
If Manufacturer = "" And Model = "" Then Exit Sub
s = Text11.Text
m = 1
n = Len(s)
Text2.Text = "line" & LTrim$(str$(m)) & " = "
For i = 1 To n
c = Mid$(s, i, 1)
Text2.Text = Text2.Text & c
If c = Chr(10) Then
   m = m + 1
   Text2.Text = Text2.Text & "line" & LTrim$(str$(m)) & " = "
End If
Next
Open WinDir & "system32oeminfo.ini" For Output As #2
Print #2, "[General]"
Print #2, "Manufacturer=" & Manufacturer
Print #2, "Model=" & Model
Print #2, "[Support Information]"
Print #2, Text2.Text
Close #2
'Logo
If Dir(WinDir & "system32oemlogo.bmp") <> "" Then
Kill WinDir & "system32oemlogo.bmp"
End If
If LogoPath <> "" Then
FileCopy LogoPath, WinDir & "system32oemlogo.bmp"
End If
End Sub

Private Function GetWindowsVersion() As OSVERSIONINFO
'获得 Windows 操作系统的版本
'OSVERSIONINFO 结构中的 osName 返回操作系统的名称
Dim Ver As OSVERSIONINFO
Ver.dwOSVersionInfoSize = 148
GetVersionEx Ver
With Ver
Select Case .dwPlatformId
Case 1
Select Case .dwMinorVersion
   Case 0
     .OsName = "Windows 95"
   Case 10
     .OsName = "Windows 98"
   Case 90
   .OsName = "Windows Mellinnium"
End Select
Case 2
Select Case .dwMajorVersion
   Case 3
     .OsName = "Windows NT 3.51"
   Case 4
     .OsName = "Windows NT 4.0"
   Case 5
     If .dwMinorVersion = 0 Then
     .OsName = "Windows 2000" & " " & .szCSDVersion
     ElseIf .dwMinorVersion = 1 Then
     .OsName = "Windows XP" & " " & .szCSDVersion
     Else
     .OsName = "Windows Server 2003" & " " & .szCSDVersion
     End If
End Select
Case Else
.OsName = "Failed"
End Select
End With
GetWindowsVersion = Ver
End Function

Public Sub OEM_StartMenu()
'OEM_开始菜单OEM按钮
Dim Command As String
Dim InfoTip As String
Command = Text12.Text
InfoTip = Text13.Text
If Command <> "" Then
Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionExplorerStartMenuStartPanelShowOEMLink" & Chr(34) & " " & "/v NoOEMLinkInstalled /t REG_DWORD /d 00000000 /f", vbHide
Shell "reg add" & " " & Chr(34) & "HKEY_CLASSES_ROOTCLSID{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}InstanceInitPropertyBag" & Chr(34) & " " & "/v Command /d " & Command & " /f", vbHide
Shell "reg add" & " " & Chr(34) & "HKEY_CLASSES_ROOTCLSID{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}" & Chr(34) & " " & "/ve /d " & InfoTip & " /f", vbHide
Shell "reg add" & " " & Chr(34) & "HKEY_CLASSES_ROOTCLSID{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}" & Chr(34) & " " & "/v InfoTip /d " & InfoTip & " /f", vbHide
If IcoPath1 <> "" Then
   FileCopy IcoPath1, WinDir & "system32OemLinkIcon.ico"
   Shell "reg add" & " " & Chr(34) & "HKEY_CLASSES_ROOTCLSID{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}DefaultIcon" & Chr(34) & " " & "/ve /d OemLinkIcon.ico /f", vbHide
End If
Shell "reg add" & " " & Chr(34) & "HKEY_CLASSES_ROOTCLSID{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}InstanceInitPropertyBag" & Chr(34) & " " & "/v Param1 /d " & LinkPath1 & " /f"
End If
End Sub

Public Sub OEM_IE()
'OEM_IE浏览器OEM按钮
Dim IEInfo
IEInfo = Text15.Text
If IcoPath2 <> "" Then
FileCopy IcoPath2, WinDir & "system32oemlinkicon2.ico"
Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftInternet ExplorerExtensions{6096E38F-5AC1-4391-8EC4-75DFA92FB32F}" & Chr(34) & " " & "/v HotIcon /d %windir%\system32\oemlinkicon2.ico /f", vbHide
Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftInternet ExplorerExtensions{6096E38F-5AC1-4391-8EC4-75DFA92FB32F}" & Chr(34) & " " & "/v Icon /d %windir%\system32\oemlinkicon2.ico /f", vbHide
Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftInternet ExplorerExtensions{6096E38F-5AC1-4391-8EC4-75DFA92FB32F}" & Chr(34) & " " & "/v CLSID /d {1FBA04EE-3024-11D2-8F1F-0000F87ABD16} /f", vbHide
Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftInternet ExplorerExtensions{6096E38F-5AC1-4391-8EC4-75DFA92FB32F}" & Chr(34) & " " & "/v " & Chr(34) & "Default Visible" & Chr(34) & " /d YES /f", vbHide
   If IEInfo <> "" Then
     Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftInternet ExplorerExtensions{6096E38F-5AC1-4391-8EC4-75DFA92FB32F}" & Chr(34) & " " & "/v ButtonText /d " & IEInfo & " /f", vbHide
   End If
Shell "reg add" & " " & Chr(34) & "HKEY_LOCAL_MACHINESOFTWAREMicrosoftInternet ExplorerExtensions{6096E38F-5AC1-4391-8EC4-75DFA92FB32F}" & Chr(34) & " " & "/v Exec /d " & LinkPath2 & " /f", vbHide
End If
End Sub