Common VBS code worth reading

Delete this link from the system Start Menu: Copy codeThe Code is 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 for disk fragmentation

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 call VBS scriptCopy codeThe Code is as follows: Option Explicit
On Error Resume Next

'File type of the generated list
Const sListFileType = "wmv, rm, wma"

'Relative path of the file
Const sShowPath = "."

'Constant definition of sorting type
Const iOrderFieldFileName = 0
Const iOrderFieldFileExt = 1
Const iOrderFieldFileSize = 2
Const iOrderFieldFileType = 3
Const iOrderFieldFileDate = 4

'Sorting inverse constant definition
Const iOrderAsc = 0
Const iOrderDesc = 1

'The number of files in the generated list
Const iShowCount = 20

'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 ("20" + 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) + "Day"
Case 4:
Cndate2 = Cstr (year (dDate1) + "year" + Cstr (Month (dDate1) + "Month" + Cstr (Day (dDate1) + "Day"
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)-Rev (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
'Generate a 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 a Chinese prompt Based on the file name rules
Select case left (arrFiles (j, 0), 3)
Case "sc2 ":
SListFile = sListFile + "<font color = # AA0000> Sichuan satellite TV"
Case "sd2 ":
SListFile = sListFile + "<font color = #00AA00> Shandong satellite TV"
Case "gd2 ":
SListFile = sListFile + "<font color = # 0000AA> Guangdong satellite TV"
Case "gx2 ":
SListFile = sListFile + "<font color = # AAAA00> Guangxi satellite TV"
End select
'Date display
If isnumeric (left (right (arrFiles (j, 0), 8), 2) then
IMonth = cint (left (right (arrFiles (j, 0), 8), 2 ))
IDay = cint (left (right (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 called 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 called 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 pair of 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 vbs script can be used to replace the Netcom broadband login device.

Dim WshShell, iexplorePath, iexploreselect
IexplorePath = "c: \ Progra ~ 1 \ Intern ~ 1 \ iexplore.exe"
Set WshShell = WScript. CreateObject ("WScript. Shell ")
WshShell. Run iw.epath

WScript. Sleep 2000
WshShell. AppActivate "User Logon"
WshShell. SendKeys "your account {TAB }"
WshShell. SendKeys "password"
WScript. Sleep 2000
WshShell. SendKeys "{ENTER }"

Use VBS scripts to create shortcuts

The following uses the "QQ Aqing enhancement package parameter configurator" as an example to describe how to create a shortcut using a 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. The name displayed on the desktop is "QQ Aqing enhancement package parameter configurator"
OShellLink. TargetPath = "C: \ Program Files \ Tencent \ QQ \ Aqing.exe"
'Set the shortcut execution path
OShellLink. WindowStyle = 1
OShellLink. Hotkey = "Ctrl + Alt + e" 'set shortcuts
OShellLink. IconLocation = "E: \ Picture \ Aqing. ico" 'sets the shortcut icon path
OShellLink. Description = "QQ Aqing enhancement package parameter configurator" 'set the shortcut Description
OShellLink. WorkingDirectory = strDesktop
OShellLink. Save

Save the above Code as "CreateShortcut. vbs" (without quotation marks). Double-click CreateShortcut. vbs to create a shortcut for the QQ Aqing enhancement package parameter configurator on the desktop.

The biggest advantage of a shortcut created using this method is that the shortcut icon can be changed according to your preferences.

Use the VBS script to send an email!
[Code]
Set objEmail = CreateObject ("CDO. Message ")
ObjEmail. From = "null_vbt@163.com"
ObjEmail. To = "null_vbt@163.com"
ObjEmail. Subject = "This email is sent by the VBS script"
ObjEmail. Textbody = "if you receive this email, the test is successful! "
ObjEmail. Send

Use vbs scripts to write the Windows XP/2003 Serial Number changerCopy codeThe Code is as follows: ON ERROR RESUME NEXT

Dim VOL_PROD_KEY
If Wscript. arguments. count <1 then
VOL_PROD_KEY = InputBox ("usage instructions (OEM version is invalid):" & vbCr & "This script will modify the serial number of the current Windows. Use the calculator to calculate the serial number matching the current Windows instance, copy and paste it into the following space. "& VbCr &" Input Serial Number (xp vlk by default): "," 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. Check System Properties. "
End if

If err <> 0 then
Wscript. echo "modification failed! Check whether the entered CD-KEY matches the current Windows version. "
Err. Clear
End if

Next

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

Key that can be upgraded:
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 vbs script for file deletion! (This can be used when game updates are used. I hope you can use it flexibly.) 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 (34) & sdir & chr (34) & "the folder does not exist. Check the folder! ", 64
Exit function
End if
If not (Fso. folderexists (ddir) then
The msgbox chr (34) & 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 each 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