此脚本的功能为将一个目录中的jpg,gif,png格式的图片生成Html相册，页面上的图像只是改变显示大小，并没有生成缩略图。
用到的技术：Scripting.FileSystemObject，Adodb.Stream。其中得到图片长宽用了秋水无恨的Adodb.Stream取得图像的高宽
复制代码 代码如下:
"///////////////////////////////////////////////
"VBS相册生成脚本，使用方法：将此文件放在sendto目录中（在运行中输入直接sendto，就可以打开），然后在有图片的文件夹上点右键，选择发送到，等一下，就OK了。
"海娃 http://www.51windows.Net
"更新日期:2004-12-30
"///////////////////////////////////////////////
Set ArgObj = WScript.Arguments
Set fsoBrowse = CreateObject（"Scripting.FileSystemObject"）
dim cpath,imgw,imgh,pagesize,wn,hn,pagetitle,filenamestart,firstpage
cpath=ArgObj（0）"传递路径
imgw = 240
imgh = 180
wn = 3
hn = 3
pagetitle = "图片展示 - 51windows.Net"
filenamestart = "Page_"
firstpage = "index.htm"
pagetitle2 = inputbox（"请输入页面标题","请输入页面标题",pagetitle）
if isempty（pagetitle2） = false and len（pagetitle2） > 1 then
pagetitle = pagetitle2
end if
filenamestart2 = inputbox（"请输入文件名前缀","请输入文件名前缀",filenamestart）
if isempty（filenamestart2） = false and len（filenamestart2） > 1 then
filenamestart = filenamestart2
end if
firstpage2 = inputbox（"请输入第一页的文件名，点取消按序号生成","请输入第一页的文件名",firstpage）
if isempty（firstpage2） = false and len（filenamestart2） > 1 then
firstpage = firstpage2
else
firstpage = ""
end if
if len（firstpage） > 0 and （right（lcase（firstpage）,4）<>".htm" and right（lcase（firstpage）,5）<>".html"） then
firstpage = firstpage & ".htm"
end if
imgw2 = inputbox（"请输入小图的宽度","请输入小图的宽度",imgw）
if isnumeric（imgw2） and isempty（imgw2） = false then
imgw = imgw2
end if
imgh2 = inputbox（"请输入小图的高度","请输入小图的高度",imgh）
if isnumeric（imgh2） and isempty（imgh2） = false then
imgh = imgh2
end if
wn2 = inputbox（"请输入每行的图像数","请输入每行的图像数",wn）
if isnumeric（wn2） and isempty（wn2） = false then
wn = wn2
end if
hn2 = inputbox（"请输入行数","请输入行数",hn）
if isnumeric（hn2） and isempty（hn2） = false then
hn = hn2
end if
dim info
info = "<！-- 本页面有 VBScript 相册生成脚本生成，http://www.51windows.Net -->"
pagesize = wn*hn
dim message
message = ""
message = message & "文件路径：" & chr（9） & cpath & vbnewline
message = message & "页面标题：" & chr（9） & pagetitle & vbnewline
message = message & "文件名前缀：" & chr（9） & filenamestart & vbnewline
message = message & "首页文件名：" & chr（9） & firstpage & vbnewline
message = message & "小图的宽度：" & chr（9） & imgw & vbnewline
message = message & "小图的高度" & chr（9） & imgh & vbnewline
message = message & "每行的图像数：" & chr（9） & wn & vbnewline
message = message & "行数：" & chr（9） & chr（9） & hn & vbnewline
message = message & vbnewline & "确定生成吗？" & vbnewline
dim StartRun
StartRun = msgbox（message,1,"VBS相册生成脚本"）
if StartRun=1 then
CreatPageHtml（FileInofList（cpath））
end if
function FileInofList（cpath）
ON ERROR RESUME NEXT
dim FileNameListStr
FileNameListStr=""
filesize = 0
if fsoBrowse.FolderExists（cpath）then
Set theFolder=fsoBrowse.GetFolder（cpath）
Set theFiles=theFolder.Files
For Each x In theFiles
if right（lcase（x.name）,4） = ".gif" or right（lcase（x.name）,4） = ".png" or right（lcase（x.name）,4） = ".jpg" then
if x.Size>0 then
set qswh=new qswhImg
arr=qswh.getimagesize（cpath & "" & x.name）"取得图片的扩展名，高宽信息
dim imgext,imgWidth,imgheight
imgext = arr（0）
imgWidth = arr（1）
imgheight = arr（2）
if lcase（imgext） = "gif" or lcase（imgext） = "jpg" or lcase（imgext） = "png" then
FileNameListStr = FileNameListStr & x.name & "|"& x.Size &"|"& imgWidth & "|" & imgheight &"***"
end if
end if
end if
next
end if
set fsoBrowse = nothing
if len（FileNameListStr）>3 then
FileNameListStr = left（FileNameListStr,len（FileNameListStr）-3）
end if
FileInofList = FileNameListStr
if err<>0 then
msgbox "FileInofList 出错了:" & err.description
err.clear
end if
end function
sub CreatPageHtml（ListStr）
ON ERROR RESUME NEXT
dim filenamearr,filenamenum,outstr
filenamearr = split（ListStr,"***"）
filenamenum = ubound（filenamearr）
outstr = ""
for a = 0 to filenamenum
thisstr = filenamearr（a）
thisstrarr = split（thisstr,"|"）
if ubound（thisstrarr） = 3 then
dim w,h
w = thisstrarr（2）
h = thisstrarr（3）
okw = imgw
okh = imgh
if （w/h）>（imgw/imgh） then
if int（w）>=int（imgw） then
okw = imgw
okh = formatnumber（h*imgw/w,0）
else
okw = w
okh = h
end if
else
if int（h）>=int（imgh） then
okh = imgh
okw = formatnumber（w*imgh/h,0）
else
okw = w
okh = h
end if
end if
dim vspace
vspace = 0
if int（imgh）>int（okh） then
vspace = formatnumber（（imgh-okh）/2,0）-3
end if
if int（vspace）<1 then
vspace = 0
end if
outstr = outstr & "<div class=""oneDiv"">" & vbnewline
outstr = outstr & " <div class=""ImgDiv""><a href="""& thisstrarr（0） &""" onclick=""ShowImg（this.href,"& w &","& h &"）;return false""><img border=""0"" title="""& thisstrarr（0） &"（"& thisstrarr（1） &" byte）"" alt="""& thisstrarr（0） &""" src="""& thisstrarr（0） &""" align=""center"" hspace=""0"" vspace="""& vspace &""" width="""& okw &""" height="""& okh &"""></a></div>" & vbnewline
outstr = outstr & " <div class=""TextDiv""><a href="""& thisstrarr（0） &""" onclick=""ShowImg（this.href,"& w &","& h &"）;return false"">"& thisstrarr（0） &"</a></div>" & vbnewline
outstr = outstr & "</div>" & vbnewline
end if
if （（a+1） mod pagesize = 0） or （a = filenamenum） then
dim n1,nn
n1 = formatnumber（（（a+1）/pagesize+0.49999）,0）
nn = formatnumber（（filenamenum+1）/pagesize+0.49999,0）
pagestr = "<div>"
if int（pagesize） = 1 then
nn = int（nn）+1
end if
for b = 1 to nn
bb = addzero（b,nn）
if int（b）<>int（n1） then
if int（b） = 1 and firstpage<>"" then
pagestr = pagestr & " <a href="""& firstpage &""">"& bb &"</a> "
else
pagestr = pagestr & " <a href="""& filenamestart &""& bb &".htm"">"& bb &"</a> "
end if
else
pagestr = pagestr & " "& bb &" "
end if
next
pagestr = pagestr & "</div><div align=""center"">"
if int（n1） = 1 then
pagestr = pagestr & "<span id=""PrevLink"">[ Prev ]</span>"
else
if int（n1） = 2 and firstpage<>"" then
pagestr = pagestr & "[ <a id=""PrevLink"" href="""& firstpage &""">Prev</a> ]"
else
pagestr = pagestr & "[ <a id=""PrevLink"" href="""& filenamestart &""& addzero（（n1-1）,nn） &".htm"">Prev</a> ]"
end if
end if
if int（n1） = int（nn） then
pagestr = pagestr & "<span id=""NextLink"">[ Next ]</span>"
else
pagestr = pagestr & "[ <a id=""NextLink"" href="""& filenamestart &""& addzero（（n1+1）,nn） &".htm"">Next</a> ]"
end if
if int（nn） > 1 then
pagestr = "<div class=""pageDiv"">"& pagestr & "</div></div>"
else
pagestr = ""
end if
if int（n1） = 1 and firstpage<>"" then
creatfile outstr,pagestr,"/"& firstpage
else
creatfile outstr,pagestr,"/"& filenamestart &""& addzero（n1,nn） &".htm"
end if
outstr = ""
end if
next
if err=0 then
msgbox "文件已生成"
else
msgbox "CreatPageHtml 出错了:" & err.description
err.clear
end if
end sub
function addzero（num1,numn）
addzero = right（"00000000"&num1,len（numn））
end function
function formattitle（str）
str1 = str
str1 = replace（str1,"""","""）
formattitle = str1
end function
sub creatfile（outstr,pagestr,name）
ON ERROR RESUME NEXT
dim tmphtml
tmphtml = tmphtml & "<html>" & vbNewLine
tmphtml = tmphtml & "<head>" & vbNewLine
tmphtml = tmphtml & "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbNewLine
tmphtml = tmphtml & "<meta name=""GENERATOR"" content=""Microsoft FrontPage 4.0"">" & vbNewLine
tmphtml = tmphtml & "<meta name=""ProgId"" content=""FrontPage.Editor.Document"">" & vbNewLine
tmphtml = tmphtml & "<title>"& pagetitle &"</title>" & vbNewLine
tmphtml = tmphtml & "<style>" & vbNewLine
tmphtml = tmphtml & "<！--" & vbNewLine
tmphtml = tmphtml & "body {margin:0px;}" & vbNewLine
tmphtml = tmphtml & ".TitleDiv {margin:2px;padding:2px;display:block;font-size:18pt;font-family:Verdana;width:"& （int（imgw）+20）*wn &"px;}" & vbNewLine
tmphtml = tmphtml & ".pageDiv {margin:2px;padding:2px;display:block;font-size:11pt;font-family:Verdana;word-break : break-all;width:"& （int（imgw）+20）*wn &"px;}" & vbNewLine
tmphtml = tmphtml & "a {word-break : break-all;}" & vbNewLine
tmphtml = tmphtml & ".FullDiv {margin:0px;padding:0px;width:"& （int（imgw）+20）*wn &"px;}" & vbNewLine
tmphtml = tmphtml & ".oneDiv {background-color: #FFFFFF; border: 0px solid #F2F2F2; padding: px;margin:2px;width:"& （int（imgw）+12） &"px;height:"& （int（imgh）+30） &"px;float:left;}" & vbNewLine
tmphtml = tmphtml & ".ImgDiv {background-color: #F2F2F2; border: 1px solid #999999; padding: 2px;margin:2px;width:"& （int（imgw）+8） &"px;height:"& （int（imgh）+4） &"px;overflow:hidden;text-align:center;}" & vbNewLine
tmphtml = tmphtml & ".TextDiv {background-color: #F2F2F2; border: 1px solid #999999; padding: 2px;margin:2px;width:"& （int（imgw）+8） &"px;height:20px;overflow:hidden;text-align:center;font-size:9pt;font-family:Verdana;}" & vbNewLine
tmphtml = tmphtml & "-->" & vbNewLine
tmphtml = tmphtml & "</style>" & vbNewLine
tmphtml = tmphtml & "</head>" & vbNewLine
tmphtml = tmphtml & "<body onkeydown=""if（event.keyCode==37）{if（PrevLink.href）{window.open（PrevLink.href,"_self",""）}}else if（event.keyCode==39）{if（NextLink.href）{window.open（NextLink.href,"_self",""）}}"">" & vbNewLine
tmphtml = tmphtml & "<SCRIPT LANGUAGE=""JavaScript"">" & vbNewLine
tmphtml = tmphtml & "<！--" & vbNewLine
tmphtml = tmphtml & "function ShowImg（url,w,h）" & vbNewLine
tmphtml = tmphtml & "{" & vbNewLine
tmphtml = tmphtml & "newwin = window.open（""about:blank"","""",""width=""+（w-3）+"",height=""+（h-3）+"",left=""+（window.screen.width-w）/2+"",top=""+（window.screen.height-h）/2+""""）" & vbNewLine
tmphtml = tmphtml & "newwin.document.write （"<html><title>View Image - 51windows.Net</title><head><meta http-equiv=Content-Type content=""text/html; charset=gb2312""></head><body style=""border:0px;margin:0px;"" onkeydown=if（event.keyCode==27）{window.close（）}><center><img title=""点击关闭窗口"" onclick=""window.close（）"" style=""cursor:hand;"" border=""0"" src="""+url+""" align=""absmiddle"" hspace=""0"" vspace=""0"" width="""+w+""" height="""+h+"""></center></body></html>"）" & vbNewLine
tmphtml = tmphtml & "}" & vbNewLine
tmphtml = tmphtml & "//-->" & vbNewLine
tmphtml = tmphtml & "</SCRIPT>" & vbNewLine
tmphtml = tmphtml & "<div class=""TitleDiv"">"& pagetitle &"</div>" & vbNewLine
tmphtml = tmphtml & pagestr & vbNewLine
tmphtml = tmphtml & "<div class=""FullDiv"">" & vbNewLine
tmphtml = tmphtml & outstr & vbNewLine
tmphtml = tmphtml & "</div>" & vbNewLine
tmphtml = tmphtml & "<div class=""TitleDiv"" align=""center""><a target=""_blank"" href=""http://www.51windows.Net"">www.51windows.Net</a></div>" & vbNewLine
tmphtml = tmphtml & info & vbNewLine
tmphtml = tmphtml & "</body>" & vbNewLine
tmphtml = tmphtml & "</html>" & vbNewLine
dim htmlstr
htmlstr = tmphtml
Set fso = CreateObject（"Scripting.FileSystemObject"）
Set fout = fso.CreateTextFile（cpath&name,true,false）
fout.WriteLine htmlstr
fout.close
set fso = nothing
if err<>0 then
msgbox "creatfile 出错了:" & err.description
err.clear
end if
end sub
Class qswhImg
dim aso
Private Sub Class_Initialize
set aso=CreateObject（"Adodb.Stream"）
aso.Mode=3
aso.Type=1
aso.Open
End Sub
Private Sub Class_Terminate
set aso=nothing
End Sub
Private Function Bin2Str（Bin）
Dim I, Str
For I=1 to LenB（Bin）
clow=MidB（Bin,I,1）
if ASCB（clow）<128 then
Str = Str & Chr（ASCB（clow））
else
I=I+1
if I <= LenB（Bin） then Str = Str & Chr（ASCW（MidB（Bin,I,1）&clow））
end if
Next
Bin2Str = Str
End Function
Private Function Num2Str（num,base,lens）
"qiushuiwuhen （2002-8-12）
dim ret
ret = ""
while（num>=base）
ret = （num mod base） & ret
num = （num - num mod base）/base
wend
Num2Str = right（string（lens,"0"） & num & ret,lens）
End Function
Private Function Str2Num（str,base）
"qiushuiwuhen （2002-8-12）
dim ret
ret = 0
for i=1 to len（str）
ret = ret *base + cint（mid（str,i,1））
next
Str2Num=ret
End Function
Private Function BinVal（bin）
"qiushuiwuhen （2002-8-12）
dim ret
ret = 0
for i = lenb（bin） to 1 step -1
ret = ret *256 + ascb（midb（bin,i,1））
next
BinVal=ret
End Function
Private Function BinVal2（bin）
"qiushuiwuhen （2002-8-12）
dim ret
ret = 0
for i = 1 to lenb（bin）
ret = ret *256 + ascb（midb（bin,i,1））
next
BinVal2=ret
End Function
Function getImageSize（filespec）
"qiushuiwuhen （2002-9-3）
dim ret（3）
aso.LoadFromFile（filespec）
bFlag=aso.read（3）
select case hex（binVal（bFlag））
case "4E5089":
aso.read（15）
ret（0）="PNG"
ret（1）=BinVal2（aso.read（2））
aso.read（2）
ret（2）=BinVal2（aso.read（2））
case "464947":
aso.read（3）
ret（0）="GIF"
ret（1）=BinVal（aso.read（2））
ret（2）=BinVal（aso.read（2））
case "535746":
aso.read（5）
binData=aso.Read（1）
sConv=Num2Str（ascb（binData）,2 ,8）
nBits=Str2Num（left（sConv,5）,2）
sConv=mid（sConv,6）
while（len（sConv）<nBits*4）
binData=aso.Read（1）
sConv=sConv&Num2Str（ascb（binData）,2 ,8）
wend
ret（0）="SWF"
ret（1）=int（abs（Str2Num（mid（sConv,1*nBits+1,nBits）,2）-Str2Num（mid（sConv,0*nBits+1,nBits）,2））/20）
ret（2）=int（abs（Str2Num（mid（sConv,3*nBits+1,nBits）,2）-Str2Num（mid（sConv,2*nBits+1,nBits）,2））/20）
case "FFD8FF":
do
do: p1=binVal（aso.Read（1））: loop while p1=255 and not aso.EOS
if p1>191 and p1<196 then exit do else aso.read（binval2（aso.Read（2））-2）
do:p1=binVal（aso.Read（1））:loop while p1<255 and not aso.EOS
loop while true
aso.Read（3）
ret（0）="JPG"
ret（2）=binval2（aso.Read（2））
ret（1）=binval2（aso.Read（2））
case else:
if left（Bin2Str（bFlag）,2）="BM" then
aso.Read（15）
ret（0）="BMP"
ret（1）=binval（aso.Read（4））
ret（2）=binval（aso.Read（4））
else
ret（0）=""
end if
end select
ret（3）="width=""" & ret（1） &""" height=""" & ret（2） &""""
getimagesize=ret
End Function
End Class
使用方法：将此文件放在sendto目录中（在运行中输入直接sendto，就可以打开），然后在有图片的文件夹上点右键，选择发送到，等一下，就OK了。下载操作演示
效果1：Logo展示
效果2：圣诞新年LOGO集锦
易网时代-编程资源站