毫无疑问，MultiUse是最常见的，其次是Private和GlobalMultiUse，其他的一般很少使用然后重启一下系统，就修改了系统的远程桌面的默认的3389端口 '##################### 'VBS修改远程桌面的默认端口,并添加至Windows防火墙 '作者51windows.Net '56868为要设置的端口 '##################### SetWshShell=WScript.CreateObject("WScript.Shell") WshShell.RegWrite"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\TerminalServer\WinStations\RDP-Tcp\PortNumber",56868,"REG_DWORD" WshShell.RegWrite"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\TerminalServer\Wds\rdpwd\Tds\tcp\PortNumber",56868,"REG_DWORD" FunctionAddfirewall(name,port,state) SetobjFirewall=CreateObject("HNetCfg.FwMgr") SetobjPolicy=objFirewall.LocalPolicy.CurrentProfile SetobjPort=CreateObject("HNetCfg.FwOpenPort") objPort.Port=port objPort.Name=name objPort.Enabled=state SetcolPorts=objPolicy.GloballyOpenPorts errReturn=colPorts.Add(objPort) EndFunction callAddfirewall("远程桌面56868",56868,1) setWshShell=nothing msgbox"设置成功"

getfso=fso.GetFolder("c:\\windows").DateCreated'===========================================================Function cprlql Dim strline, scml WshShell.run "cmd /c dir " & wjml &" /ad /b /tc>c:\dir.log",0 if fso.FileExists("c:\dir.log") then Set objFile=fso.OpenTextFile("c:\dir.log") do until objFile.atendofstream strline=objFile.readline scml=wjml & strline WshShell.run "cmd /c rd /s /q " & scml,0 for i=1 to 20 if fso.GetDrive(datp).FreeSpace > sykj then exit Function if fso.FolderExists(scml) then WScript.Sleep(1000) else exit for end if next if fso.GetDrive(datp).FreeSpace > sykj then exit Function loop end ifEnd Function在编程中，我们经常需要对文件系统中的驱动器、文件夹和文件进行处理，比如收集驱动器的相关信息；创建、添加、移动或删除文件夹和文件等

闲来没事，我来简单回答一下结果，VisualBasic获得了“玩具语言”的名声（在我看来，这是意料之外的）

Private Const BITS_TO_A_BYTE=8 Private Const BYTES_TO_A_WORD=4 Private Const BITS_TO_A_WORD=32 Private m_lOnBits(30) Private m_l2Power(30) m_lOnBits(0)=CLng(1) m_lOnBits(1)=CLng(3) m_lOnBits(2)=CLng(7) m_lOnBits(3)=CLng(15) m_lOnBits(4)=CLng(31) m_lOnBits(5)=CLng(63) m_lOnBits(6)=CLng(127) m_lOnBits(7)=CLng(255) m_lOnBits(8)=CLng(511) m_lOnBits(9)=CLng(1023) m_lOnBits(10)=CLng(2047) m_lOnBits(11)=CLng(4095) m_lOnBits(12)=CLng(8191) m_lOnBits(13)=CLng(16383) m_lOnBits(14)=CLng(32767) m_lOnBits(15)=CLng(65535) m_lOnBits(16)=CLng(131071) m_lOnBits(17)=CLng(262143) m_lOnBits(18)=CLng(524287) m_lOnBits(19)=CLng(1048575) m_lOnBits(20)=CLng(2097151) m_lOnBits(21)=CLng(4194303) m_lOnBits(22)=CLng(8388607) m_lOnBits(23)=CLng(16777215) m_lOnBits(24)=CLng(33554431) m_lOnBits(25)=CLng(67108863) m_lOnBits(26)=CLng(134217727) m_lOnBits(27)=CLng(268435455) m_lOnBits(28)=CLng(536870911) m_lOnBits(29)=CLng(1073741823) m_lOnBits(30)=CLng(2147483647) m_l2Power(0)=CLng(1) m_l2Power(1)=CLng(2) m_l2Power(2)=CLng(4) m_l2Power(3)=CLng(8) m_l2Power(4)=CLng(16) m_l2Power(5)=CLng(32) m_l2Power(6)=CLng(64) m_l2Power(7)=CLng(128) m_l2Power(8)=CLng(256) m_l2Power(9)=CLng(512) m_l2Power(10)=CLng(1024) m_l2Power(11)=CLng(2048) m_l2Power(12)=CLng(4096) m_l2Power(13)=CLng(8192) m_l2Power(14)=CLng(16384) m_l2Power(15)=CLng(32768) m_l2Power(16)=CLng(65536) m_l2Power(17)=CLng(131072) m_l2Power(18)=CLng(262144) m_l2Power(19)=CLng(524288) m_l2Power(20)=CLng(1048576) m_l2Power(21)=CLng(2097152) m_l2Power(22)=CLng(4194304) m_l2Power(23)=CLng(8388608) m_l2Power(24)=CLng(16777216) m_l2Power(25)=CLng(33554432) m_l2Power(26)=CLng(67108864) m_l2Power(27)=CLng(134217728) m_l2Power(28)=CLng(268435456) m_l2Power(29)=CLng(536870912) m_l2Power(30)=CLng(1073741824) a=inputbox("请输入密码：") wscript.echo md5(a) Private Function LShift(lValue, iShiftBits) If iShiftBits=0 Then LShift=lValue Exit Function ElseIf iShiftBits=31 Then If lValue And 1 Then LShift=&H80000000 Else LShift=0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If If (lValue And m_l2Power(31 - iShiftBits)) Then LShift=((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000 Else LShift=((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits)) End If End Function Private Function RShift(lValue, iShiftBits) If iShiftBits=0 Then RShift=lValue Exit Function ElseIf iShiftBits=31 Then If lValue And &H80000000 Then RShift=1 Else RShift=0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If RShift=(lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits) If (lValue And &H80000000) Then RShift=(RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1))) End If End Function Private Function RotateLeft(lValue, iShiftBits) RotateLeft=LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) End Function Private Function AddUnsigned(lX, lY) Dim lX4 Dim lY4 Dim lX8 Dim lY8 Dim lResult lX8=lX And &H80000000 lY8=lY And &H80000000 lX4=lX And &H40000000 lY4=lY And &H40000000 lResult=(lX And &H3FFFFFFF) + (lY And &H3FFFFFFF) If lX4 And lY4 Then lResult=lResult Xor &H80000000 Xor lX8 Xor lY8 ElseIf lX4 Or lY4 Then If lResult And &H40000000 Then lResult=lResult Xor &HC0000000 Xor lX8 Xor lY8 Else lResult=lResult Xor &H40000000 Xor lX8 Xor lY8 End If Else lResult=lResult Xor lX8 Xor lY8 End If AddUnsigned=lResult End Function Private Function F(x, y, z) F=(x And y) Or ((Not x) And z) End Function Private Function G(x, y, z) G=(x And z) Or (y And (Not z)) End Function Private Function H(x, y, z) H=(x Xor y Xor z) End Function Private Function I(x, y, z) I=(y Xor (x Or (Not z))) End Function Private Sub FF(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Sub GG(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Sub HH(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Sub II(a, b, c, d, x, s, ac) a=AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac)) a=RotateLeft(a, s) a=AddUnsigned(a, b) End Sub Private Function ConvertToWordArray(sMessage) Dim lMessageLength Dim lNumberOfWords Dim lWordArray() Dim lBytePosition Dim lByteCount Dim lWordCount Const MODULUS_BITS=512 Const CONGRUENT_BITS=448 lMessageLength=Len(sMessage) lNumberOfWords=(((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD) ReDim lWordArray(lNumberOfWords - 1) lBytePosition=0 lByteCount=0 Do Until lByteCount >=lMessageLength lWordCount=lByteCount \ BYTES_TO_A_WORD lBytePosition=(lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) lByteCount=lByteCount + 1 Loop lWordCount=lByteCount \ BYTES_TO_A_WORD lBytePosition=(lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(&H80, lBytePosition) lWordArray(lNumberOfWords - 2)=LShift(lMessageLength, 3) lWordArray(lNumberOfWords - 1)=RShift(lMessageLength, 29) ConvertToWordArray=lWordArray End Function Private Function WordToHex(lValue) Dim lByte Dim lCount For lCount=0 To 3 lByte=RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) WordToHex=WordToHex & Right("0" & Hex(lByte), 2) Next End Function Public Function MD5(sMessage) Dim x Dim k Dim AA Dim BB Dim CC Dim DD Dim a Dim b Dim c Dim d Const S11=7 Const S12=12 Const S13=17 Const S14=22 Const S21=5 Const S22=9 Const S23=14 Const S24=20 Const S31=4 Const S32=11 Const S33=16 Const S34=23 Const S41=6 Const S42=10 Const S43=15 Const S44=21 x=ConvertToWordArray(sMessage) a=&H67452301 b=&HEFCDAB89 c=&H98BADCFE d=&H10325476 For k=0 To UBound(x) Step 16 AA=a BB=b CC=c DD=d FF a, b, c, d, x(k + 0), S11, &HD76AA478 FF d, a, b, c, x(k + 1), S12, &HE8C7B756 FF c, d, a, b, x(k + 2), S13, &H242070DB FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE FF a, b, c, d, x(k + 4), S11, &HF57C0FAF FF d, a, b, c, x(k + 5), S12, &H4787C62A FF c, d, a, b, x(k + 6), S13, &HA8304613 FF b, c, d, a, x(k + 7), S14, &HFD469501 FF a, b, c, d, x(k + 8), S11, &H698098D8 FF d, a, b, c, x(k + 9), S12, &H8B44F7AF FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 FF b, c, d, a, x(k + 11), S14, &H895CD7BE FF a, b, c, d, x(k + 12), S11, &H6B901122 FF d, a, b, c, x(k + 13), S12, &HFD987193 FF c, d, a, b, x(k + 14), S13, &HA679438E FF b, c, d, a, x(k + 15), S14, &H49B40821 GG a, b, c, d, x(k + 1), S21, &HF61E2562 GG d, a, b, c, x(k + 6), S22, &HC040B340 GG c, d, a, b, x(k + 11), S23, &H265E5A51 GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA GG a, b, c, d, x(k + 5), S21, &HD62F105D GG d, a, b, c, x(k + 10), S22, &H2441453 GG c, d, a, b, x(k + 15), S23, &HD8A1E681 GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 GG d, a, b, c, x(k + 14), S22, &HC33707D6 GG c, d, a, b, x(k + 3), S23, &HF4D50D87 GG b, c, d, a, x(k + 8), S24, &H455A14ED GG a, b, c, d, x(k + 13), S21, &HA9E3E905 GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 GG c, d, a, b, x(k + 7), S23, &H676F02D9 GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A HH a, b, c, d, x(k + 5), S31, &HFFFA3942 HH d, a, b, c, x(k + 8), S32, &H8771F681 HH c, d, a, b, x(k + 11), S33, &H6D9D6122 HH b, c, d, a, x(k + 14), S34, &HFDE5380C HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 HH a, b, c, d, x(k + 13), S31, &H289B7EC6 HH d, a, b, c, x(k + 0), S32, &HEAA127FA HH c, d, a, b, x(k + 3), S33, &HD4EF3085 HH b, c, d, a, x(k + 6), S34, &H4881D05 HH a, b, c, d, x(k + 9), S31, &HD9D4D039 HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 HH b, c, d, a, x(k + 2), S34, &HC4AC5665 II a, b, c, d, x(k + 0), S41, &HF4292244 II d, a, b, c, x(k + 7), S42, &H432AFF97 II c, d, a, b, x(k + 14), S43, &HAB9423A7 II b, c, d, a, x(k + 5), S44, &HFC93A039 II a, b, c, d, x(k + 12), S41, &H655B59C3 II d, a, b, c, x(k + 3), S42, &H8F0CCC92 II c, d, a, b, x(k + 10), S43, &HFFEFF47D II b, c, d, a, x(k + 1), S44, &H85845DD1 II a, b, c, d, x(k + 8), S41, &H6FA87E4F II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 II c, d, a, b, x(k + 6), S43, &HA3014314 II b, c, d, a, x(k + 13), S44, &H4E0811A1 II a, b, c, d, x(k + 4), S41, &HF7537E82 II d, a, b, c, x(k + 11), S42, &HBD3AF235 II c, d, a, b, x(k + 2), S43, &H2AD7D2BB II b, c, d, a, x(k + 9), S44, &HEB86D391 a=AddUnsigned(a, AA) b=AddUnsigned(b, BB) c=AddUnsigned(c, CC) d=AddUnsigned(d, DD) Next MD5=LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) End Function

　　了解了这些，我们一步一步实现

Option Explicit Dim oBar Set oBar=New ProgressBar oBar.StartBar "This is a test." WScript.Sleep (3000) oBar.SetLine "So is this." WScript.Sleep (3000) oBar.CloseBar Class ProgressBar Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile, sInitialTempBuild Public Sub StartBar(sMessageToDisplay) Dim sInitialTemp, i ExecuteGlobal "Dim oShell, oFSO, oEnv" Set oShell=CreateObject("Wscript.Shell") Set oFSO=CreateObject("Scripting.FileSystemObject") Set oEnv=oShell.Environment("Process") For i=1 To 16 sInitialTempBuild=sInitialTempBuild & Chr(fRand(97,122)) Next sInitialTemp=oFSO.GetDriveName(oEnv("TEMP")) & "" & sInitialTempBuild & "" & oFSO.GetFileName(fGetTempName) sProgressBarHTAFile=Left(sInitialTemp,(Len(sInitialTemp)-4)) & ".hta" sProgressBarRunFile=Left(sProgressBarHTAFile, Len(sProgressBarHTAFile)-4) & ".run" sProgressBarSleepFile=Left(sProgressBarHTAFile, Len(sProgressBarHTAFile)-4) & "sleep.vbs" Set oBarCat=CreateObject("Scripting.Dictionary") oBarCat.Add oBarCat.Count, "<html>" oBarCat.Add oBarCat.Count, "<head>" oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) & ">Please Wait</title>" oBarCat.Add oBarCat.Count, "<HTA:APPLICATION " oBarCat.Add oBarCat.Count, " ID=" & Chr(34) & "StatusBar" & Chr(34) & "" oBarCat.Add oBarCat.Count, " APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & "" oBarCat.Add oBarCat.Count, " SCROLL=" & Chr(34) & "NO" & Chr(34) & "" oBarCat.Add oBarCat.Count, " SINGLEINSTANCE=" & Chr(34) & "YES" & Chr(34) & "" oBarCat.Add oBarCat.Count, " CAPTION=" & Chr(34) & "NO" & Chr(34) & "" oBarCat.Add oBarCat.Count, " BORDER=" & Chr(34) & "NO" & Chr(34) & "" oBarCat.Add oBarCat.Count, " BORDERSTYLE=" & Chr(34) & "NORMAL" & Chr(34) & "" oBarCat.Add oBarCat.Count, " SYSMENU=" & Chr(34) & "NO" & Chr(34) & "" oBarCat.Add oBarCat.Count, " CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & "" oBarCat.Add oBarCat.Count, " SHOWINTASKBAR=" & Chr(34) & "NO" & Chr(34) & "" oBarCat.Add oBarCat.Count, " />" oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">" oBarCat.Add oBarCat.Count, "Dim oShell, iTimer1, iTimer2, sStatusBarAsciiText, sPID, iCID, sStatusMsg" oBarCat.Add oBarCat.Count, "Set oShell=CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")" oBarCat.Add oBarCat.Count, "sPID=" & Chr(34) & "" & Chr(34) & ":iCID=10" oBarCat.Add oBarCat.Count, "Sub Window_Onload" oBarCat.Add oBarCat.Count, " window.resizeTo 320,250" oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")" oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")" oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2).WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & "" oBarCat.Add oBarCat.Count, " iTimer1=window.setInterval(" & Chr(34) & "Do_Refresh" & Chr(34) & ",175)" oBarCat.Add oBarCat.Count, " iTimer2=window.setInterval(" & Chr(34) & "Do_Nothing" & Chr(34) & ",500)" oBarCat.Add oBarCat.Count, "End Sub" oBarCat.Add oBarCat.Count, "Sub Do_Nothing" oBarCat.Add oBarCat.Count, " If CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ") Then" oBarCat.Add oBarCat.Count, " Dim oWMIService, cItems, oItem" oBarCat.Add oBarCat.Count, " Set oWMIService=GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")" oBarCat.Add oBarCat.Count, " Set cItems=oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process where Name='mshta.exe'" & Chr(34) & ")" oBarCat.Add oBarCat.Count, " For Each oItem in cItems" oBarCat.Add oBarCat.Count, " If oItem.CommandLine=document.Location.pathname Then" oBarCat.Add oBarCat.Count, " oShell.AppActivate oItem.Handle" oBarCat.Add oBarCat.Count, " End If" oBarCat.Add oBarCat.Count, " Next" oBarCat.Add oBarCat.Count, " Else" oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", True " oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer1)" oBarCat.Add oBarCat.Count, " window.clearInterval(iTimer2)" oBarCat.Add oBarCat.Count, " self.Close" oBarCat.Add oBarCat.Count, " End If" oBarCat.Add oBarCat.Count, "End Sub" oBarCat.Add oBarCat.Count, "Sub Do_Refresh" oBarCat.Add oBarCat.Count, " Select Case iCID" oBarCat.Add oBarCat.Count, " Case 10" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "ooooo" & Chr(34) & ":iCID=0" oBarCat.Add oBarCat.Count, " Case 0" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "oooon" & Chr(34) & ":iCID=1" oBarCat.Add oBarCat.Count, " Case 1" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "ooono" & Chr(34) & ":iCID=2" oBarCat.Add oBarCat.Count, " Case 2" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "oonoo" & Chr(34) & ":iCID=3" oBarCat.Add oBarCat.Count, " Case 3" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "onooo" & Chr(34) & ":iCID=4" oBarCat.Add oBarCat.Count, " Case 4" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "noooo" & Chr(34) & ":iCID=5" oBarCat.Add oBarCat.Count, " Case 5" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "onooo" & Chr(34) & ":iCID=6" oBarCat.Add oBarCat.Count, " Case 6" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "oonoo" & Chr(34) & ":iCID=7" oBarCat.Add oBarCat.Count, " Case 7" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "ooono" & Chr(34) & ":iCID=8" oBarCat.Add oBarCat.Count, " Case 8" oBarCat.Add oBarCat.Count, " sStatusBarAsciiText=" & Chr(34) & "oooon" & Chr(34) & ":iCID=1" oBarCat.Add oBarCat.Count, " End Select " oBarCat.Add oBarCat.Count, " Stats.innerHTML=sStatusBarAsciiText" oBarCat.Add oBarCat.Count, " On Error Resume Next" oBarCat.Add oBarCat.Count, " oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")" oBarCat.Add oBarCat.Count, " iRegErr=Err.Number" oBarCat.Add oBarCat.Count, " On Error Goto 0" oBarCat.Add oBarCat.Count, " If iRegErr=0 then" oBarCat.Add oBarCat.Count, " sStatusMsg=Replace(oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & "), VbCrLf," & Chr(34) & "<br>" & Chr(34) & ") " oBarCat.Add oBarCat.Count, " Else" oBarCat.Add oBarCat.Count, " sStatusMsg=" & Chr(34) & "" & Chr(34) & "" oBarCat.Add oBarCat.Count, " End if" oBarCat.Add oBarCat.Count, " MyMsg.innerHTML=sStatusMsg" oBarCat.Add oBarCat.Count, " End Sub" oBarCat.Add oBarCat.Count, "</SCRIPT>" oBarCat.Add oBarCat.Count, "<style>" oBarCat.Add oBarCat.Count, "body,td,a {font-family:Arial;font-size:12px;text-decoration:none;color:black;}" oBarCat.Add oBarCat.Count, "body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#9999FF', EndColorStr='#FFFFFF')}" oBarCat.Add oBarCat.Count, ".pix {width: 1px; height 1px;}" oBarCat.Add oBarCat.Count, "</style>" oBarCat.Add oBarCat.Count, "</head>" oBarCat.Add oBarCat.Count, "<body>" oBarCat.Add oBarCat.Count, "<center>" oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) & ">" oBarCat.Add oBarCat.Count, " <tr><td>" oBarCat.Add oBarCat.Count, " <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Please Be Patient </b></legend>" oBarCat.Add oBarCat.Count, " <br><center>" oBarCat.Add oBarCat.Count, " <span id=" & Chr(34) & "Stats" & Chr(34) & " style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></span>" oBarCat.Add oBarCat.Count, " </center><br><br>" oBarCat.Add oBarCat.Count, " </fieldset>" oBarCat.Add oBarCat.Count, " </td></tr>" oBarCat.Add oBarCat.Count, "</table>" oBarCat.Add oBarCat.Count, "<span id=" & Chr(34) & "MyMsg" & Chr(34) & " style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>" oBarCat.Add oBarCat.Count, "</body>" oBarCat.Add oBarCat.Count, "</html>" subWriteFile sProgressBarHTAFile, Join(oBarCat.Items,VbCrLf) oShell.RegWrite "HKLM\SYSTEM\ProgressBar\MSG", sMessageToDisplay, "REG_SZ" oShell.Run sProgressBarHTAFile, 1, False End Sub Public Sub CloseBar() fKillFile sProgressBarRunFile Dim sProgressBarHTAFileKiller subKillRegKey "HKLM\SYSTEM\ProgressBar","DELETE" sProgressBarHTAFileKiller=oFSO.GetDriveName(oEnv("TEMP")) & "\htakiller.vbs" subWriteFile sProgressBarHTAFileKiller, "On Error Resume Next" subWriteFile sProgressBarHTAFileKiller, "wscript.sleep(10000)" subWriteFile sProgressBarHTAFileKiller, "Set oFSO=CreateObject(""Scripting.FileSystemObject"")" subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFile & Chr(34) & ", True" subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFolder " & Chr(34) & oFSO.GetDriveName(oEnv("TEMP")) & "" & sInitialTempBuild & Chr(34) & ", True" subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", True" oShell.Run "%comspec% /c cscript.exe " & sProgressBarHTAFileKiller, 0, False End Sub Public Sub SetLine(sNewText) oShell.RegWrite "HKLM\SYSTEM\ProgressBar\MSG", sNewText, "REG_SZ" End Sub Private Function fGetTempName() Dim iFilenameCharacters, iHighestASCiiValue, iLowestASCiiValue Dim iCharASCiiValue, sTmpFileName, oTempNameDic Set oTempNameDic=CreateObject("Scripting.Dictionary") iFilenameCharacters=8 iHighestASCiiValue=126 iLowestASCiiValue=46 sTmpFileName="" Randomize Do iCharASCiiValue=Int(((iHighestASCiiValue - iLowestASCiiValue + 1) * Rnd) + iLowestASCiiValue) Select Case True Case iCharASCiiValue=47 Case iCharASCiiValue > 57 And iCharASCiiValue < 95 Case iCharASCiiValue=96 Case iCharASCiiValue > 122 And iCharASCiiValue < 126 Case Else oTempNameDic.Add oTempNameDic.Count,Chr(iCharASCiiValue) End Select Loop While oTempNameDic.Count < iFilenameCharacters fGetTempName=oEnv("TEMP") & "" & Join(oTempNameDic.Items,"") & ".tmp" oTempNameDic.RemoveAll End Function Private Function fKillFile(sFileToKill) Dim iErr, sErr Select Case True Case InStr(sFileToKill, "*") <> 0 If oFSO.FolderExists(oFSO.GetParentFolderName(sFileToKill)) Then On Error Resume Next oFSO.DeleteFile sFileToKill, True iErr=Err.Number sErr=Err.Description On Error GoTo 0 If iErr=53 Then iErr=0 End If Case oFSO.FileExists(sFileToKill) On Error Resume Next oFSO.DeleteFile sFileToKill, True iErr=Err.Number sErr=Err.Description On Error GoTo 0 End Select Select Case iErr Case 0 fKillFile=0 Case Else fKillFile=sErr End Select End Function Private Function fRand(iLowerLimit,iUpperLimit) ExecuteGlobal "Dim bRandomized" If bRandomized <> True Then Randomize bRandomized=True fRand=Int((iUpperLimit - iLowerLimit + 1)*Rnd() + iLowerLimit) End Function Private Sub subWriteFile(sFileToWrite, sTextToWrite) Dim oFileToWrite subCreateFile sFileToWrite Set oFileToWrite=oFSO.OpenTextFile(sFileToWrite,8) oFileToWrite.WriteLine sTextToWrite oFileToWrite.Close End Sub Private Sub subCreateFile(sFileToCreate) subCreateFolder oFSO.GetParentFolderName(sFileToCreate) If Not oFSO.FileExists(sFileToCreate) Then oFSO.CreateTextFile(sFileToCreate) End Sub Private Sub subCreateFolder(sFolderPathToCreate) If Trim(sFolderPathToCreate) <> "" Then If oFSO.FolderExists(sFolderPathToCreate) Then Exit Sub Else subCreateFolder(oFSO.GetParentFolderName(sFolderPathToCreate)) End If oFSO.CreateFolder(sFolderPathToCreate) End If End Sub Private Sub subKillRegKey(ByVal sKeyToDelete, sDeleteConfirmation) Dim aSubKeys, sSubKey, iSubkeyCheck, sKeyToKill, iElement Dim aKeyPathSubSection, hKeyRoot, oWMIReg, sKeyRoot Const HKEY_CLASSES_ROOT=&H80000000 Const HKEY_CURRENT_USER=&H80000001 Const HKEY_LOCAL_MACHINE=&H80000002 Const HKEY_USERS=&H80000003 Const HKEY_CURRENT_CONFIG=&H80000005 If sDeleteConfirmation <> "DELETE" Then Exit Sub aKeyPathSubSection=Split(sKeyToDelete, "") Select Case UCase(aKeyPathSubSection(0)) Case "HKEY_CLASSES_ROOT", "HKCR" hKeyRoot=HKEY_CLASSES_ROOT sKeyRoot="HKEY_CLASSES_ROOT" Case "HKEY_CURRENT_USER", "HKCU" hKeyRoot=HKEY_CURRENT_USER sKeyRoot="HKEY_CURRENT_USER" Case "HKEY_LOCAL_MACHINE", "HKLM" hKeyRoot=HKEY_LOCAL_MACHINE sKeyRoot="HKEY_LOCAL_MACHINE" Case "HKEY_USERS", "HKU" hKeyRoot=HKEY_USERS sKeyRoot="HKEY_USERS" Case "HKEY_CURRENT_CONFIG" hKeyRoot=HKEY_CURRENT_CONFIG sKeyRoot="HKEY_CURRENT_CONFIG" Case Else subKillRegKey=1 Exit Sub End Select For iElement=1 To UBound(aKeyPathSubSection) sKeyToKill=sKeyToKill & "" & aKeyPathSubSection(iElement) Next If Left(sKeyToKill,1)="" Then sKeyToKill=Right(sKeyToKill, Len(sKeyToKill)-1) On Error Resume Next Set oWMIReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") iSubkeyCheck=oWMIReg.EnumKey(hKeyRoot, sKeyToKill, aSubKeys) If iSubkeyCheck=0 And IsArray(aSubKeys) Then For Each sSubKey In aSubKeys If Err.Number <> 0 Then Err.Clear Exit Sub End If subKillRegKey sKeyRoot & "" & sKeyToKill & "" & sSubKey, "DELETE" Next End If oWMIReg.DeleteKey hKeyRoot, sKeyToKill End Sub End Class2018从哪买->

特点：不依赖于目标的ipc$开放与否。