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"=- 

Option Explicit 
On Error Resume Next 

'生成列表的文件類型 
Const sListFileType = "wmv,rm,wma" 

'文件所在的相對路徑 
Const sShowPath="." 

'排序類型的常量定義 
Const iOrderFieldFileName = 0 
Const iOrderFieldFileExt = 1 
Const iOrderFieldFileSize = 2 
Const iOrderFieldFileType = 3 
Const iOrderFieldFileDate = 4 

'排序順逆的常量定義 
const iOrderAsc = 0 
const iOrderDesc = 1 

'生成列表的文件數量 
const iShowCount = 20 


'顯示的日期格式函數 
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))+"月"+Cstr(Day(dDate1))+"日" 
Case 4: 
Cndate2 = Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日" 
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 
'排序 
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 
'生成列表 
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 + ("名稱") 
sListFile = sListFile + ("</td><Td class=PageListTitleTd>") 
sListFile = sListFile + ("媒體") 
sListFile = sListFile + ("</td><Td class=PageListTitleTd>") 
sListFile = sListFile + ("大小") 
sListFile = sListFile + ("</td><Td class=PageListTitleTd>") 
sListFile = sListFile + ("類型") 
sListFile = sListFile + ("</td><Td class=PageListTitleTd ID=updatetime>") 
sListFile = sListFile + ("更新時間") 
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 + ("<img src=images/"+arrFiles(j,1)+".gif align=absbottom><img src=b.gif width=2 height=0><a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &"</a>") 
If datediff("h",arrFiles(j,4),now)<=24 then 
sListFile = sListFile + "<img src=images/new.gif align=absmiddle>" 
end if 
sListFile = sListFile + "</td><Td class="+sTDStyleClass+">" 
sListFile = sListFile + ("<a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">") 
'根據文件名規則,生成中文提示 
select case left(arrFiles(j,0),3) 
case "sc2": 
sListFile = sListFile + "<font color=#AA0000>四川衛視 " 
case "sd2": 
sListFile = sListFile + "<font color=#00AA00>山東衛視 " 
case "gd2": 
sListFile = sListFile + "<font color=#0000AA>廣東衛視 " 
case "gx2": 
sListFile = sListFile + "<font color=#AAAA00>廣西衛視 " 
end select 
'日期顯示 
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)+"月" + cstr(iDay)+"日" 
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 

'生成調用文件的過程 
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") 

'比較調用文件與文件夾的最后修改時間 
If f.DateLastModified<>f_js.DateLastModified then 
sUpdateContent = ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount) 
Set f_js_write = fso.CreateTextFile("list.js", True) 
'JS調用就加上下面這對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() 

可以代替網通寬帶登陸器的一段vbs腳本 

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 "用戶上網登陸" 
WshShell.SendKeys "自己的賬號{TAB}" 
WshShell.SendKeys "自己的密碼" 
WScript.Sleep 2000 
WshShell.SendKeys "{ENTER}" 

利用VBS腳本創建快捷方式 

我們以"QQ Aqing增強包參數配置器"為例子,講述如何利用VBS腳本創建快捷方式.代碼如下: 

代碼: 

set WshShell = Wscript.CreateObject("Wscript.Shell") 
strDesktop = WshShell.SpecialFolders("Desktop") 
set oShellLink = WshShell.CreateShortcut(strDesktop & "/QQ Aqing增強包參數配置器.lnk") 
'創建一個快捷方式對象,其在桌面上顯示的名字為"QQ Aqing增強包參數配置器" 
oShellLink.TargetPath = "C:/Program Files/Tencent/QQ/Aqing.exe" 
'設置快捷方式的執行路徑 
oShellLink.WindowStyle = 1 
oShellLink.Hotkey = "Ctrl+Alt+e" '設置快捷方式的快捷鍵 
oShellLink.IconLocation = "E:/Picture/Aqing.ico" '設置快捷方式的圖標路徑 
oShellLink.Description = "QQ Aqing增強包參數配置器" '設置快捷方式的描述 
oShellLink.WorkingDirectory = strDesktop 
oShellLink.Save 

將上述代碼保存為"CreateShortcut.vbs"(不含引號).雙擊CreateShortcut.vbs,就會將QQ Aqing增強包參數配置器的快捷方式建立到桌面上. 

用這種方法建立的快捷方式的最大優點是:快捷方式的圖標可以根據自己的喜好進行更改 

用VBS腳本發送email! 
[code] 
Set objEmail = CreateObject("CDO.Message") 
objEmail.From = "null_vbt@163.com" 
objEmail.To = "null_vbt@163.com" 
objEmail.Subject = "這封郵件是由VBS腳本發送" 
objEmail.Textbody = "如果你收到這封郵件，就表示測試成功！" 
objEmail.Send 

ON ERROR RESUME NEXT 

Dim VOL_PROD_KEY 
if Wscript.arguments.count<1 then 
VOL_PROD_KEY =InputBox("使用說明(OEM版無效)："&vbCr&vbCr&" 本腳本程序將修改當前 Windows 的序列號。請先使用算號器算出匹配當前 Windows 的序列號，復制并粘貼到下面空格中。"&vbCr&vbCr&"輸入序列號(默認為 XP VLK)：","Windows XP/2003 序列號更換工具","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 "您的 Windows CD-KEY 修改成功。請檢查系統屬性。" 
end if 

if err <> 0 then 
Wscript.echo "修改失敗！請檢查輸入的 CD-KEY 是否與當前 Windows 版本相匹配。" 
Err.Clear 
end if 

Next