Common VBS code is worth a look _vbs

Remove this link from the System Start menu:

Copy Code code as follows:

Windows Registry Editor Version 5.00

[Hkey_classes_root\clsid\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}]
@=-
"InfoTip" =-

[Hkey_classes_root\clsid\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}\defaulticon]
@=-

[Hkey_classes_root\clsid\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}\instance\initpropertybag]
"Command" =-
"Param1" =-

VBS script implements defragmentation disk fragmentation function

Set WshShell = WScript.CreateObject ("Wscript.Shell")

Dim FSO, D, DC
Set fso = CreateObject ("Scripting.FileSystemObject")
Set DC = fso. Drives
For each D in DC
If D.drivetype = 2 Then
return = Wshshell.run ("Defrag" & D & "F", 1, TRUE)
End If
Next

Set WshShell = Nothing

Scheduled task calls the VBS script periodically

Copy Code code as follows:

Option Explicit
On Error Resume Next

' The file type of the build list
Const Slistfiletype = "Wmv,rm,wma"

' The relative path where the file is located
Const sshowpath= "."

' Constant definition of sort type
Const iorderfieldfilename = 0
Const Iorderfieldfileext = 1
Const iorderfieldfilesize = 2
Const Iorderfieldfiletype = 3
Const iorderfieldfiledate = 4

' Sort the inverse constant definition
Const IORDERASC = 0
Const IORDERDESC = 1

' Number of files generated in the list
Const ISHOWCOUNT = 20


' The date Format function displayed
Function Cndate2 (Date1,intdatestyle)
Dim strdate,ddate1
Strdate=cstr (Date1)
If Isdate (strdate) Then
If Left (CStr (strdate), 1) = "0" Then
Ddate1=cdate ("+cstr" (strdate))
Else
Ddate1=cdate (strdate)
End If
Else
Ddate1=now ()
End If
Select Case Intdatestyle
Case 1:
Cndate2 = Cstr (year (dDate1)) + "-" +cstr (Month (dDate1)) + "-" +cstr (Day (dDate1))
Case 2:
Cndate2 = Cstr (Month (dDate1)) + "-" +cstr (Day (dDate1))
Case 3:
Cndate2 = Cstr (Month (dDate1)) + "Month" +cstr (Day (dDate1)) + "Days"
Case 4:
Cndate2 = CStr (year (dDate1)) + "Years" + Cstr (Month (dDate1)) + "Month" +cstr (Day (dDate1)) + "Days"
End Select
End Function


Function ListFile (Strfiletype,intcompare,intorder,intshowcount)
Dim Slistfile
Dim FSO, F, F1, FC, S,ftype,fcount,i,j,k
Dim T1,T2,T3,T4,T5
Dim Imonth,iday
Slistfile = ""
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. GetFolder (Sshowpath)
Set FC = F.files
Fcount = Fc.count
ReDim Arrfiles (fcount,5)
ReDim ArrFiles2 (fcount,5)
I=0
' Sort
For each F1 in FC
Ftype = Right (F1.name,len (f1.name)-instrrev (F1.name, "."))
Arrfiles (i,0) = F1.name
Arrfiles (i,1) = Ftype
Arrfiles (i,2) = F1.size
Arrfiles (i,3) = F1.type
Arrfiles (i,4) = F1. DateLastModified
I=i+1
Next
For I=0 to Fcount-1
For J=i+1 to Fcount-1
Select Case Intcompare
Case Iorderfieldfilename,iorderfieldfileext,iorderfieldfiletype:
If arrfiles (I,intcompare) >arrfiles (j,intcompare) Then
T1 = arrfiles (i,0)
T2 = arrfiles (i,1)
T3 = Arrfiles (i,2)
T4 = Arrfiles (i,3)
T5 = Arrfiles (i,4)

Arrfiles (i,0) = Arrfiles (j,0)
Arrfiles (i,1) = Arrfiles (j,1)
Arrfiles (i,2) = Arrfiles (j,2)
Arrfiles (i,3) = Arrfiles (j,3)
Arrfiles (i,4) = Arrfiles (j,4)

Arrfiles (j,0) = T1
Arrfiles (j,1) = t2
Arrfiles (j,2) = T3
Arrfiles (j,3) = T4
Arrfiles (j,4) = T5
End If
Case Iorderfieldfilesize:
If CDbl (Arrfiles (I,intcompare)) >cdbl (Arrfiles (j,intcompare)) Then
T1 = arrfiles (i,0)
T2 = arrfiles (i,1)
T3 = Arrfiles (i,2)
T4 = Arrfiles (i,3)
T5 = Arrfiles (i,4)

Arrfiles (i,0) = Arrfiles (j,0)
Arrfiles (i,1) = Arrfiles (j,1)
Arrfiles (i,2) = Arrfiles (j,2)
Arrfiles (i,3) = Arrfiles (j,3)
Arrfiles (i,4) = Arrfiles (j,4)

Arrfiles (j,0) = T1
Arrfiles (j,1) = t2
Arrfiles (j,2) = T3
Arrfiles (j,3) = T4
Arrfiles (j,4) = T5
End If
Case Iorderfieldfiledate:
If Cdate (Arrfiles (I,intcompare)) >cdate (Arrfiles (j,intcompare)) Then
T1 = arrfiles (i,0)
T2 = arrfiles (i,1)
T3 = Arrfiles (i,2)
T4 = Arrfiles (i,3)
T5 = Arrfiles (i,4)

Arrfiles (i,0) = Arrfiles (j,0)
Arrfiles (i,1) = Arrfiles (j,1)
Arrfiles (i,2) = Arrfiles (j,2)
Arrfiles (i,3) = Arrfiles (j,3)
Arrfiles (i,4) = Arrfiles (j,4)

Arrfiles (j,0) = T1
Arrfiles (j,1) = t2
Arrfiles (j,2) = T3
Arrfiles (j,3) = T4
Arrfiles (j,4) = T5
End If
End Select
Next
Next
' Build list
Slistfile = Slistfile + ("<table cellpadding=0 cellspacing=0 width=100% align=center class=" "PageListTable" "style=" " Behavior:url (IMAGES/SORT2.HTC); ">")
Slistfile = Slistfile + ("<thead><tr class=pagelisttitletr><td class=pagelisttitletd>")
Slistfile = Slistfile + ("name")
Slistfile = Slistfile + ("</td><td class=pagelisttitletd>")
Slistfile = Slistfile + ("media")
Slistfile = Slistfile + ("</td><td class=pagelisttitletd>")
Slistfile = Slistfile + ("size")
Slistfile = Slistfile + ("</td><td class=pagelisttitletd>")
Slistfile = Slistfile + ("type")
Slistfile = Slistfile + ("</td><td class=pagelisttitletd id=updatetime>")
Slistfile = Slistfile + ("Update Time")
Slistfile = Slistfile + ("</td></Tr></THEAD>")
Dim iloopstart,iloofend,iloopstep
If Intorder = 0 Then
Iloopstart = 0
Iloofend = fcount-1
Iloopstep = 1
Else
Iloopstart = fcount-1
Iloofend = 0
Iloopstep =-1
End If
Dim Icount,stdstyleclass
icount = 1
For J=iloopstart to Iloofend step iloopstep
If InStr (Strfiletype,arrfiles (j,1)) >0 and Icount<=intshowcount Then
Stdstyleclass = "Pagelisttd" +cstr ((icount mod 2) +1)
Slistfile = Slistfile + ("<tr class=pagelisttr><td class=" +stdstyleclass+ ">")
Slistfile = Slistfile + ("<a href= "& Sshowpath &"/"& CStr (Arrfiles (j,0)) &" > "& Arrfiles (j,0) &" </a> ")
If DateDiff ("H", Arrfiles (j,4), now) <=24 then
Slistfile = Slistfile + "End If
Slistfile = Slistfile + "</td><td class=" +stdstyleclass+ ">"
Slistfile = Slistfile + ("<a href=" & Sshowpath & "/" & CStr (Arrfiles (j,0)) & ">")
' Generate Chinese prompts according to filename rules
Select Case Left (Arrfiles (j,0), 3)
Case "SC2":
Slistfile = Slistfile + "<font color= #AA0000 > Sichuan TV"
Case "SD2":
Slistfile = Slistfile + "<font color= #00AA00 > Shandong TV"
Case "GD2":
Slistfile = Slistfile + "<font color= #0000AA > Guangdong TV"
Case "GX2":
Slistfile = Slistfile + "<font color= #AAAA00 > Guangxi TV"
End Select
' Date display
If IsNumeric (Left (Arrfiles (j,0), 8), 2) Then
Imonth = CInt (Left (Arrfiles (j,0), 8), 2)
Iday = CInt (Left (Arrfiles (j,0), 6), 2)
Slistfile = Slistfile + CStr (imonth) + "month" + CStr (iday) + "Day"
Slistfile = Slistfile + ("</a></td><td class=" +stdstyleclass+ "align=right>")
Else
Response.Write Arrfiles (j,0)
End If
If arrfiles (j,2) >1024*1024 Then
Slistfile = Slistfile + CStr (round (Arrfiles (j,2)/1024/1024))
Slistfile = Slistfile + ("MB")
Else
Slistfile = Slistfile + CStr (round (Arrfiles (j,2)/1024))
Slistfile = Slistfile + ("KB")
End If
Slistfile = Slistfile + ("</td>")
Slistfile = Slistfile + ("<td class=" +stdstyleclass+ ">")
Slistfile = Slistfile + CStr (arrfiles (j,3))
Slistfile = Slistfile + ("</td>")
Slistfile = Slistfile + ("<td class=" +stdstyleclass+ ">")
Slistfile = Slistfile + (Cndate2 (Arrfiles (j,4), 4))
Slistfile = Slistfile + ("</td>")
Slistfile = Slistfile + ("</Tr>")
icount = icount+1
End If
Next
Slistfile = Slistfile + "</table>"
ListFile = Slistfile
End Function

' The process of generating the calling file
Sub showfilelistcontent ()
Dim tupdatetime,supdatecontent

Dim Fso,f,f_js,f_js_write
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso. GetFolder (Sshowpath)
Set F_js = fso. GetFile ("List.js")

' Compare the last modification time of the calling file and folder
If F.datelastmodified<>f_js. DateLastModified Then
Supdatecontent = ListFile (Slistfiletype,iorderfieldfiledate,iorderdesc,ishowcount)
Set f_js_write = fso. CreateTextFile ("List.js", True)
' JS call adds the following to the document.write
' F_js_write. Write ("document.write")
F_js_write. Write (supdatecontent)
' F_js_write. Write ("')")
F_js_write. Close
End If
End Sub

Call Showfilelistcontent ()

A section of the VBS script that can replace the Netcom broadband landing device

Dim WshShell, Iexplorepath, Iexploreselect
Iexplorepath= "C:\progra~1\intern~1\iexplore.exe"
Set wshshell=wscript.createobject ("Wscript.Shell")
Wshshell.run Iexplorepath

Wscript.Sleep 2000
Wshshell.appactivate "Users landing on the Internet"
Wshshell.sendkeys "own Account {tab}"
Wshshell.sendkeys "own password."
Wscript.Sleep 2000
Wshshell.sendkeys ' {ENTER} '

Creating shortcuts with the VBS script

We use the "QQ aqing enhanced Package Parameter Configurator" As an example to describe how to create a shortcut using the VBS script. The code is as follows:

Code:

Set WshShell = WScript.CreateObject ("Wscript.Shell")
Strdesktop = Wshshell.specialfolders ("Desktop")
Set oshelllink = Wshshell.createshortcut (Strdesktop & "\QQ aqing enhanced Package Parameter configurator. lnk")
' Create a shortcut object with the name "QQ aqing Enhanced Package Parameter Configurator" displayed on the desktop
Oshelllink.targetpath = "C:\Program Files\tencent\qq\aqing.exe"
' Set the path of execution for the shortcut
Oshelllink.windowstyle = 1
Oshelllink.hotkey = "Ctrl+alt+e" set shortcut keys for shortcuts
Oshelllink.iconlocation = "E:\Picture\Aqing.ico" Set icon path for shortcut
Oshelllink.description = "QQ aqing Enhanced Package Parameter Configurator" ' Set the description of the shortcut
Oshelllink.workingdirectory = Strdesktop
Oshelllink.save

Save the above code as "Createshortcut.vbs" (without quotes). Double-click Createshortcut.vbs to set up a shortcut to the QQ aqing enhanced package parameter configurator to the desktop.

The best thing about shortcuts that you can use in this way is that the icons for shortcuts are changed according to your preferences.

Send email! with a VBS script
[Code]
Set Objemail = CreateObject ("CDO.") Message ")
Objemail.from = "Null_vbt@163.com"
objemail.to = "Null_vbt@163.com"
Objemail.subject = "This message is sent by the VBS script"
Objemail.textbody = "If you receive this email, it means the test is successful!" "
Objemail.send

Using the VBS script to write the Windows xp/2003 serial number change device

Copy Code code as follows:

On ERROR RESUME NEXT

Dim Vol_prod_key
If Wscript.arguments.count<1 Then
Vol_prod_key =inputbox (Invalid OEM version): "&vbCr&vbCr&" This script will modify the current Windows serial number. Please use the operator to calculate the serial number matching the current Windows, copy and paste into the following space. "&vbCr&vbCr&" Enter serial number (default is XP VLK): "," Windows xp/2003 serial number replacement tool, "11111-11111-11111-11111-11111")
If vol_prod_key= "" Then
Wscript.Quit
End If
Else
Vol_prod_key = Wscript.arguments.Item (0)
End If

Vol_prod_key = Replace (Vol_prod_key, "-", "") ' remove hyphens if any

For each Obj in GetObject ("Winmgmts:{impersonationlevel=impersonate}"). InstancesOf ("win32_WindowsProductActivation")

result = Obj.SetProductKey (Vol_prod_key)

If Err = 0 Then
WScript.Echo "Your Windows Cd-key has been modified successfully. Please check the System properties. "
End If

If Err <> 0 Then
WScript.Echo "Modification failed!" Please check that the cd-key you entered matches the current version of Windows. "
Err.Clear
End If

Next

Copy the above code into the text, save it as a. vbs file, and then run the file directly.

Can upgrade key:
Mrx3f-47b9t-2487j-kwkmf-rpwby
Qc986-27d34-6m3ty-jjxp9-tbgmd
Cm3hy-26vyw-6jryc-x66gx-jvy2d
Dp7cm-pd6mc-6bkxt-m8jj6-rpxgj
F4297-rcwjp-p482c-yy23y-xh8w3
Hh7vv-6p3g9-82twk-qkjj3-mxr96
Hcq9d-tvcwx-x9qrg-j4b2y-gr2tt


A section of the file to delete the VBS script! (use the game to update the time can be used to Oh, I hope everyone flexible application) Dim Sdir,ddir
' Remote Directory
Sdir= "\\192.168.1.1\vbs\zz\"
' Local Directory
Ddir= "C:\c"
function Comparefile (sdir,ddir)
Dim fso,dfol,dfs,sf1,f1
Set Fso=createobject ("Scripting.FileSystemObject")
If not (Fso.folderexists (sdir)) Then
MsgBox Chr &sdir &chr (&) folder does not exist, please confirm! ", 64
Exit function
End If
If not (Fso.folderexists (ddir)) Then
MsgBox chr &ddir & "" folder does not exist, please confirm! ", 64
Exit function
End If
If Right (sdir,1) <> "\" then Sdir=sdir & "\"

Set Dfol=fso.getfolder (Ddir)
Set Dfs=dfol.files

For all F1 in DFS
If Fso.fileexists (Sdir & F1.name) Then
Set SF1=FSO. GetFile (Sdir & F1.name)
If F1. DateLastModified <>sf1. DateLastModified or F1.size<>sf1.size Then
F1.delete
End If
Else
F1. Delete (True)
End If
Next
Dim fols
Set Fols=dfol.subfolders
For each F1 in Fols
If not fso.folderexists (Sdir &f1.name) Then
F1.delete true
Else
Comparefile Sdir & F1.name,f1.path
End If
Next
End Function
Comparefile Sdir,ddir