[VB]GUI Easy Sysprep 1.1 源代码[2 AllUsrRun.exe 源代码]

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

'Private Declare Function CDdoor Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Dim WinDir As String
Dim SystemDrive As String

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()
Dim ExeName(3) As String
Dim Hide(3) As String
Dim KillIt(3) As String
Dim CDOpen As String
Dim IP As String
Dim Mask As String
Dim GateWay As String
Dim pDNS As String
Dim sDNS As String
Dim reg As String, RegPath As String
Dim autorun As String

Me.Visible = False
SystemDrive = Environ("systemdrive")
WinDir = Environ("windir")

'读取参数
Open WinDir & "config.esp" For Input As #1
Line Input #1, CDOpen
For i = 1 To 3
Line Input #1, ExeName(i)
Line Input #1, Hide(i)
Line Input #1, KillIt(i)
Next
Line Input #1, IP
Line Input #1, Mask
Line Input #1, GateWay
Line Input #1, pDNS
Line Input #1, sDNS
Line Input #1, reg
Line Input #1, RegPath
Line Input #1, autorun
Close #1
'运行外接程序
For i = 1 To 3
If ExeName(i) <> "" And Dir(ExeName(i)) <> "" And (LCase(Right(ExeName(i), 3)) = "exe" Or LCase(Right(ExeName(i), 3)) = "bat" Or LCase(Right(ExeName(i), 3)) = "cmd") Then
   If Hide(i) = "True" Then
     pidNotepad = Shell(ExeName(i), vbHide)
   Else
     pidNotepad = Shell(ExeName(i), vbNormalFocus)
   End If
   hProcess = OpenProcess(PROCESS_QUERY_INformATION, False, pidNotepad)
   Do
     GetExitCodeProcess hProcess, lngExitCode
     DoEvents
   Loop While lngExitCode = STILL_ACTIVE
   If KillIt(i) = "True" Then
     Kill ExeName(i)
   End If
End If
Next
'部署
Call Sysprep
'修改启动等待时间
Shell WinDir & "system32bootcfg.exe /timeout 5", vbHide
'弹出光盘
'If CDOpen = "True" Then
' CDdoor "set CDAudio door open", 0, 0, 0
'End If
'导入注册表
If reg = "True" And Dir(RegPath) <> "" Then
Shell WinDir & "regedit.exe /S " & RegPath, vbHide
End If
'清理AutoRun
If autorun = "True" Then
Call KillAutoRun
End If
'修改IP
If IP <> "" And Mask <> "" Then
Call Move_to_Center
Me.Visible = True
Call IP_Config(IP, Mask, GateWay, pDNS, sDNS)
End If
End
End Sub

Public Sub IP_Config(ByVal IP As String, ByVal Mask As String, ByVal GateWay As String, ByVal pDNS As String, ByVal sDNS As String)
Dim Earth As String
Dim i As Integer, s(5) As String, c As String, tmp As String
'初始化变量
Earth = "本地连接"
ProgressBar1.Min = 0
ProgressBar1.Max = 6
ProgressBar1.Value = 0
'随机数x调整
s(1) = IP
s(2) = Mask
s(3) = GateWay
s(4) = pDNS
s(5) = sDNS
'随机种子
Randomize
For i = 1 To 5
tmp = ""
For j = 1 To Len(s(i))
   c = Mid(s(i), j, 1)
   If c = "x" Or c = "X" Then
     tmp = tmp & Str$(Int((254 - 2 + 1) * Rnd) + 2)
   Else
     tmp = tmp & c
   End If
Next
s(i) = tmp
Next
IP = s(1)
Mask = s(2)
GateWay = s(3)
pDNS = s(4)
sDNS = s(5)
'执行
'IP、子网掩码
s(1) = "netsh interface ip set address name=" & Earth & " source=static addr=" & IP & " mask=" & Mask
'网关
s(2) = "netsh interface ip set address name=" & Earth & " gateway=" & GateWay & " gwmetric=0"
'主DNS
s(3) = "netsh interface ip set dns name=" & Earth & " source=static addr=" & pDNS & " register=PRIMARY"
'副DNS
s(4) = "netsh interface ip add dns name=" & Earth & " addr=" & sDNS
'WINS
s(5) = "netsh interface ip set wins name=" & Earth & " source=static addr=none"
'开始设置
ProgressBar1.Value = ProgressBar1.Value + 1
For i = 1 To 5
pidNotepad = Shell(s(i), vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INformATION, False, pidNotepad)
Do
     GetExitCodeProcess hProcess, lngExitCode
     DoEvents
Loop While lngExitCode = STILL_ACTIVE
ProgressBar1.Value = ProgressBar1.Value + 1
Next
End Sub

Public Sub KillAutoRun()
Dim AvArray(30) As String
Dim Path As String
Dim i As Integer
Dim j As Integer
AvArray(1) = "rose.exe"
AvArray(2) = "sxs.exe"
AvArray(3) = "tfidma.exe"
AvArray(4) = "severe.exe"
AvArray(5) = "oso.exe"
AvArray(6) = "conime.exe"
AvArray(7) = "teuyen.exe"
AvArray(8) = "mpnxyl.exe"
AvArray(9) = "gfosdg.exe"
AvArray(10) = "hnunkl.exe"
AvArray(11) = "SVOHOST.exe"
AvArray(12) = "temp1.exe"
AvArray(13) = "temp2.exe"
AvArray(14) = "memsub.exe"
AvArray(15) = "shelltask.exe"
AvArray(16) = "svchost.exe"
AvArray(17) = "rundll32.exe"
AvArray(18) = "baba.exe"
AvArray(19) = "ndtstat.exe"
AvArray(20) = "msccrt.exe"
AvArray(21) = "wgs3.exe"
AvArray(22) = "wms3.exe"
AvArray(23) = "wsttrs.exe"
AvArray(24) = "mppds.exe"
AvArray(25) = "winform.exe"
AvArray(26) = "mppdys.exe"
AvArray(27) = "htpatch.exe"
AvArray(28) = "cmdbcs.exe"
AvArray(29) = "twunk32.exe"
AvArray(30) = "autorun.inf"
For i = 67 To 90
On Error GoTo Jump:
Dir Chr(i) & ":"
For j = 1 To 30
   Path = Chr(i) & ":" & AvArray(j)
   If Dir(Path) <> "" Then
     Shell "attrib " & Path & " -h -s -r -a"
     Kill Path
   End If
Next
Jump:
Next
End Sub

Public Sub Sysprep()
pidNotepad = Shell(WinDir & "system32setup.exe -newsetup -mini", vbNormalFocus)
hProcess = OpenProcess(PROCESS_QUERY_INformATION, False, pidNotepad)
Do
GetExitCodeProcess hProcess, lngExitCode
DoEvents
Loop While lngExitCode = STILL_ACTIVE

Shell "reg delete HKEY_LOCAL_MACHINESYSTEMsetup /v cmdline /f", vbHide

SetAttr SystemDrive & "ntldr", vbNormal
Kill SystemDrive & "ntldr"

SetAttr SystemDrive & "ntldrXP", vbNormal
Name SystemDrive & "ntldrXP" As SystemDrive & "ntldr"
SetAttr SystemDrive & "ntldr", vbHidden + vbSystem + vbReadOnly

SetAttr SystemDrive & "boot.ini", vbNormal
Kill SystemDrive & "boot.ini"

SetAttr SystemDrive & "bootXP.ini", vbNormal
Name SystemDrive & "bootXP.ini" As SystemDrive & "boot.ini"
SetAttr SystemDrive & "boot.ini", vbHidden + vbSystem + vbReadOnly
End Sub