自動導入注冊表的,帶檢測: On Error Resume Next dim msg,fso,shell Set fso = Wscript.createobject("scripting.filesystemobject") set wshshell = wscript.CreateObject("wscript.shell") set shell = wscript.createobject("wscript.shell") IF (fso.FileExists("e:\勁樂團\reg.reg")) Then shell.run "c:\windows\Regedit.exe /s e:\勁樂團\reg.reg " shell.run "e:\勁樂團\O2Jam.exe" Else
msg=msgbox("注冊表未導入,游戲可能無法啟動,如無法進游戲請叫網管~",1,"出問題啦!!") shell.run "e:\勁樂團\O2Jam.exe" end if
不帶檢測的:
On Error Resume Next Dim oShell,fso Set oShell = WScript.CreateObject("WScript.Shell") set fso = CreateObject("Scripting.filesystemobject") oShell.Run "regedit /s 9you.reg" oShell.Run "d:\網絡游戲\勁樂團\O2Jam.exe"
自動加載虛擬光驅的:
Dim oShell Set oshell= WScript.CreateObject("WScript.Shell") oShell.Run "c:\progra~1\daemon~1\daemon.exe -mount 0,D:\lan\戰地2\BF2CD1mini.mds" wscript.sleep 5000 oShell.Run "D:\lan\戰地2\BF2.exe"
Wsh.run "Z:\大富翁七\rich7.exe" Set WSH = Nothing WScript.quit
//每次開機的時候自動導入注冊表和程序 Option Explicit Dim Folder
Folder = "d:\aaa" '設置你要執行的文件夾
Dim Wsh,fso Set Wsh = WScript.CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Dim f,fc,f1,ext Set f = fso.GetFolder(Folder) Set fc = f.Files For Each f1 in fc ext = LCase(fso.GetExtensionName(f1)) Select Case ext Case "exe" wsh.run f1,,true Case "reg" wsh.run "Regedit /s " f1,,true end Select Next
Dim Fso,Listfile,objListfile Listfile = "" '設置配置文件路徑,如果配置文件和腳本放在一起,請保持原樣
If Listfile = "" Then Listfile = "Listfile.ini" Set Fso = CreateObject("Scripting.FileSystemObject") On Error Resume Next Set objListfile = Fso.OpenTextFile(Listfile,1) If Err Then err.Clear Msgbox "沒有找到配置文件 "Listfile,16,"錯誤" WScript.quit End If On Error GoTo 0
Dim flnum,fdnum,t1,t2,tm flnum=0 fdnum=0 t1 = timer()
Dim Myline,LineArr,ListArr Do While objListfile.AtEndOfStream > True Myline = LCase(Replace(objListfile.ReadLine,"==","=")) If Left(Myline,1) = "/" Then 'objListfile.SkipLine ElseIf CheckLine(Myline) = 2 Then LineArr = Split(Myline,"=") 'DoFolder = LineArr(1) ListArr = Split(LineArr(2),";") 'MsgBox LineArr(0) If LineArr(0) = "目錄" Then DelFolder LineArr(1),ListArr If LineArr(0) = "文件" Then DelFile LineArr(1),ListArr End If Loop
Sub DelFolder(Folder,ListArr) Dim objFolder,subFolders,subFolder Set objFolder=Fso.Getfolder(Folder) Set subFolders=objFolder.subFolders For Each subFolder In subFolders If Not InArray(LIstArr,LCase(subFolder.name)) Then On Error Resume Next subfolder.Delete(True) If Err Then err.Clear Msgbox "不能刪除目錄,請檢查 "subFolder,16,"錯誤" Else fdnum = fdnum + 1 End If On Error GoTo 0 End If Next End Sub
Sub DelFile(Folder,ListArr) Dim objFolder,Files,File Set objFolder=Fso.Getfolder(Folder) Set Files=objFolder.Files For Each File In Files If Not InArray(LIstArr,LCase(File.name)) Then On Error Resume Next File.Delete(True) If Err Then err.Clear Msgbox "不能刪除文件,請檢查 "File,16,"錯誤" Else flnum = flnum + 1 End If On Error GoTo 0 End If Next End Sub
Function CheckLine(strLine) Dim LineRegExp,Matches Set LineRegExp = New RegExp LineRegExp.Pattern = ".=." LineRegExp.Global = True Set Matches = LineRegExp.Execute(strLine) CheckLine = Matches.count End Function
Function InArray(Myarray,StrIn) Dim StrTemp InArray = True For Each StrTemp In Myarray If StrIn = StrTemp Then Exit Function Exit For End If Next InArray = False End Function
Set fso = CreateObject("Scripting.FileSystemObject") Set WshSysEnv = wsShell.Environment("PROCESS") SystemRoot = WshSysEnv("WINDIR") !將域用戶或租添加到本地組
Set objGroup = GetObject("WinNT://./Administrators") Set objUser = GetObject("WinNT://testnet/Engineers") objGroup.Add(objUser.ADsPath)
!修改本地管理員密碼
Set objcnlar = GetObject("WinNT://./administrator, user") objcnla.SetPassword "P@ssW0rd" objcnla.SetInfo
!彈出 YES or NO 的對話框,不同的選擇執行不同的代碼
intAnswer = Msgbox("Do you want to delete these files?", vbYesNo, "Delete Files") If intAnswer = vbYes Then Msgbox "You answered yes." Else Msgbox "You answered no." End If
!運行CMD命令行命令
set obshell=wscript.createobject("wscript.shell") obshell.run ("ipconfig"),,true 如果要運行的命令中包含雙引號,可使用chr(34)代替
!忽略代碼錯誤繼續執行
On Error Resume Next 放置于代碼的最開頭,當代碼運行出錯后并不停止跳出而是繼續執行下一條。適當應用會很有效果。 !破解下載限制 DIM WSH
SET WSH=WSCRIPT.CreateObject("WSCRIPT.SHELL") WSH.POPUP("本程序的作用是解決無法下載的問題") WSH.POPUP("特別是在注冊表禁用的情況下破解") WSH.POPUP("由曾誠制作") WSH.Regwrite"HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1803",0,"REG_DWORD" WSH.POPUP("現在您可以下載程序了!")
!讀本機“計算機名”
'ReadComputerName.vbs Dim ReadComputerName Set ReadComputerName=WScript.CreateObject("WScript.Shell") Dim ComputerName,RegPath RegPath="HKLM\System\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName" ComputerName=ReadComputerName.RegRead(RegPath) MsgBox("計算機名為"ComputerName)
!隱藏快捷方式圖標上的小箭頭
'Hidden.vbs Dim HiddenArrowIcon Set HiddenArrowIcon=WScript.CreateObject("WScript.Shell") Dim RegPath1,RegPath2 RegPath1="HKCR\lnkfile\IsShortCut" RegPath2="HKCR\piffile\IsShortCut" HiddenArrowIcon.RegDelete(RegPath1) HiddenArrowIcon.RegDelete(RegPath2)
!改造“開始”菜單
'ChangeStartMenu.vbs Dim ChangeStartMenu Set ChangeStartMenu=WScript.CreateObject("WScript.Shell") RegPath="HKCR\Software\Microsoft\Windows\CurrentVersion\Policies\" Type_Name="REG_DWORD" Key_Data=1
該程序能在開機時自動運行。 'AddAutoRunProgram.vbs '假設該程序在c:\myfile文件夾中,文件名為autorun.exe Dim AutoRunProgram Set AutoRunProgram=WScript.CreateObject("WScript.Shell") RegPath="HKLM\Software\Microsoft\Windows\CurrentVersion\Run\" Type_Name="REG_SZ" Key_Name="AutoRun" Key_Data="C:\Myfile\autorun.exe" '該自啟動程序的全路徑文件名 AutoRunProgram.Write RegPathKey_Name,Key_Data,Type_Name '在啟動組中添加自啟動程序autorun.exe MsgBox("Success!") 一、給注冊表編輯器解鎖
用記事本編輯如下內容:
DIM WSH SET WSH=WSCRIPT.CreateObject("WSCRIPT.SHELL") '擊活WScript.Shell對象 WSH.POPUP("解鎖注冊表編輯器!") '顯示彈出信息“解鎖注冊表編輯器!” WSH.Regwrite"HKCU\Software\Microsoft\Windows\CurrentVersion \Policies\System\DisableRegistryTools",0,"REG_DWORD" '給注冊表編輯器解鎖 WSH.POPUP("注冊表解鎖成功!") '顯示彈出信息“注冊表解鎖成功!” 保存為以.vbs為擴展名的文件,使用時雙擊即可。
二、關閉Win NT/2000的默認共享
用記事本編輯如下內容:
Dim WSHShell'定義變量 set WSHShell=CreateObject("WScript.shell") '創建一個能與操作系統溝通的對象WSHShell Dim fso,dc Set fso=CreateObject("Scripting.FileSystemObject")'創建文件系統對象 set dc=fso.Drives '獲取所有驅動器盤符 For Each d in dc Dim str WSHShell.run("net share"d.driveletter "$ /delete")'關閉所有驅動器的隱藏共享 next WSHShell.run("net share admin$ /delete") WSHShell.run("net share ipc$ /delete")'關閉admin$和ipc$管道共享
strComputer= "." Set objWMIService = GetObject("winmgmts:" _ "{impersonationLevel=impersonate,(Backup)}!\\" _ strComputer "\root\cimv2") dim mylogs(3) mylogs(1)="application" mylogs(2)="system" mylogs(3)="security" for Each logs in mylogs Set colLogFiles=objWMIService.ExecQuery _ ("Select * from Win32_NTEventLogFile where LogFileName='"logs"'") For Each objLogfile in colLogFiles objLogFile.ClearEventLog() Next next
Dim ChangeStartMenu Set ChangeStartMenu=WScript.CreateObject("WScript.Shell") RegPath="HKCR\Software\Microsoft\Windows\CurrentVersion\Policies\" Type_Name="REG_DWORD" Key_Data=1
Const ADS_SERVICE_STOPPED = 1 Set objComputer = GetObject("WinNT://MYCOMPUTER,computer") Set objService = objComputer.GetObject("Service","MYSERVICE") If (objService.Status = ADS_SERVICE_STOPPED) Then objService.Start End If
//檢查Search目錄中的特定文件中的特定字符并將結果放入Result.txt中 Set objNetwork = CreateObject("Wscript.Network") strComputer = objNetwork.ComputerName
Set objWMIService = GetObject("winmgmts:" "{impersonationLevel=impersonate}!\" strComputer " ootcimv2") Set colFiles = objWMIService.ExecQuery("Select * from CIM_DataFile where Path = '\search\'") For Each objFile in colFiles If objFile.Extension = "log" Then FileName = objFile.Name Wscript.Echo FileName End IF Next
Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile("input.txt",ForReading) InputLine = objFile.ReadLine objFile.Close
set objFile = objFSO.OpenTextFile(FileName,ForReading) Do Until objFile.AtEndOfStream SearchLine = objFile.ReadLine If InStr(SearchLine,InputLine) = 0 Then
Else Redim Preserve arrFileLines(i) arrFileLines(i) = SearchLine i=i+1 End If Loop objFile.Close
Set objFile = objFSO.OpenTextFile("result.txt", ForAppending) For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1 objFile.WriteLine arrFileLines(l) Next objFile.Close
Set colGroups = GetObject("WinNT://" strComputer "") colGroups.Filter = Array("group") For Each objGroup In colGroups For Each objUser in objGroup.Members If objUser.name = StrUser Then If objGroup.Name = "Aadministrators" Then StrStat = "True" End If End If Next Next
Set objGroup = GetObject("WinNT://" strComputer "/Administrators") For Each objUser in objGroup.Members If objUser.Name = "Administrator" OR objUser.Name = "NetShowServices" Then If objUser.Name = "Administrator" AND StrStat = " True " Then objUser.SetPassword "55555555" End If Else objGroup.Remove(objUser.ADsPath) End If Next