此脚本的功能为将一个目录中的jpg,gif,png格式的图片生成Html相册，页面上的图像只是改变显示大小，并没有生成缩略图。
用到的技术：Scripting.FileSystemObject，Adodb.Stream。其中得到图片长宽用了秋水无恨的Adodb.Stream取得图像的高宽
复制代码 代码如下:
'///////////////////////////////////////////////
'VBS相册生成脚本，使用方法：将此文件放在sendto目录中（在运行中输入直接sendto，就可以打开），然后在有图片的文件夹上点右键，选择发送到，等一下，就OK了。
'海娃http://www.51windows.Net
'更新日期:2004-12-30
'///////////////////////////////////////////////
SetArgObj=WScript.Arguments
SetfsoBrowse=CreateObject("Scripting.FileSystemObject")
dimcpath,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)
ifisempty(pagetitle2)=falseandlen(pagetitle2)>1then
pagetitle=pagetitle2
endif
filenamestart2=inputbox("请输入文件名前缀","请输入文件名前缀",filenamestart)
ifisempty(filenamestart2)=falseandlen(filenamestart2)>1then
filenamestart=filenamestart2
endif
firstpage2=inputbox("请输入第一页的文件名，点取消按序号生成","请输入第一页的文件名",firstpage)
ifisempty(firstpage2)=falseandlen(filenamestart2)>1then
firstpage=firstpage2
else
firstpage=""
endif
iflen(firstpage)>0and(right(lcase(firstpage),4)<>".htm"andright(lcase(firstpage),5)<>".html")then
firstpage=firstpage&".htm"
endif
imgw2=inputbox("请输入小图的宽度","请输入小图的宽度",imgw)
ifisnumeric(imgw2)andisempty(imgw2)=falsethen
imgw=imgw2
endif
imgh2=inputbox("请输入小图的高度","请输入小图的高度",imgh)
ifisnumeric(imgh2)andisempty(imgh2)=falsethen
imgh=imgh2
endif
wn2=inputbox("请输入每行的图像数","请输入每行的图像数",wn)
ifisnumeric(wn2)andisempty(wn2)=falsethen
wn=wn2
endif
hn2=inputbox("请输入行数","请输入行数",hn)
ifisnumeric(hn2)andisempty(hn2)=falsethen
hn=hn2
endif
diminfo
info="<>"
pagesize=wn*hn
dimmessage
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
dimStartRun
StartRun=msgbox(message,1,"VBS相册生成脚本")
ifStartRun=1then
CreatPageHtml(FileInofList(cpath))
endif
functionFileInofList(cpath)
ONERRORRESUMENEXT
dimFileNameListStr
FileNameListStr=""
filesize=0
iffsoBrowse.FolderExists(cpath)then
SettheFolder=fsoBrowse.GetFolder(cpath)
SettheFiles=theFolder.Files
ForEachxIntheFiles
ifright(lcase(x.name),4)=".gif"orright(lcase(x.name),4)=".png"orright(lcase(x.name),4)=".jpg"then
ifx.Size>0then
setqswh=newqswhImg
arr=qswh.getimagesize(cpath&""&x.name)'取得图片的扩展名，高宽信息
dimimgext,imgWidth,imgheight
imgext=arr(0)
imgWidth=arr(1)
imgheight=arr(2)
iflcase(imgext)="gif"orlcase(imgext)="jpg"orlcase(imgext)="png"then
FileNameListStr=FileNameListStr&x.name&"|"&x.Size&"|"&imgWidth&"|"&imgheight&"***"
endif
endif
endif
next
endif
setfsoBrowse=nothing
iflen(FileNameListStr)>3then
FileNameListStr=left(FileNameListStr,len(FileNameListStr)-3)
endif
FileInofList=FileNameListStr
iferr<>0then
msgbox"FileInofList出错了:"&err.description
err.clear
endif
endfunction
subCreatPageHtml(ListStr)
ONERRORRESUMENEXT
dimfilenamearr,filenamenum,outstr
filenamearr=split(ListStr,"***")
filenamenum=ubound(filenamearr)
outstr=""
fora=0tofilenamenum
thisstr=filenamearr(a)
thisstrarr=split(thisstr,"|")
ifubound(thisstrarr)=3then
dimw,h
w=thisstrarr(2)
h=thisstrarr(3)
okw=imgw
okh=imgh
if(w/h)>(imgw/imgh)then
ifint(w)>=int(imgw)then
okw=imgw
okh=formatnumber(h*imgw/w,0)
else
okw=w
okh=h
endif
else
ifint(h)>=int(imgh)then
okh=imgh
okw=formatnumber(w*imgh/h,0)
else
okw=w
okh=h
endif
endif
dimvspace
vspace=0
ifint(imgh)>int(okh)then
vspace=formatnumber((imgh-okh)/2,0)-3
endif
ifint(vspace)<1then
vspace=0
endif
outstr=outstr&"<divclass=""oneDiv"">"&vbnewline
outstr=outstr&"<divclass=""ImgDiv""><ahref="""&thisstrarr(0)&"""onclick=""ShowImg(this.href,"&w&","&h&");returnfalse""><imgborder=""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&"<divclass=""TextDiv""><ahref="""&thisstrarr(0)&"""onclick=""ShowImg(this.href,"&w&","&h&");returnfalse"">"&thisstrarr(0)&"</a></div>"&vbnewline
outstr=outstr&"</div>"&vbnewline
endif
if((a+1)modpagesize=0)or(a=filenamenum)then
dimn1,nn
n1=formatnumber(((a+1)/pagesize+0.49999),0)
nn=formatnumber((filenamenum+1)/pagesize+0.49999,0)
pagestr="<div>"
ifint(pagesize)=1then
nn=int(nn)+1
endif
forb=1tonn
bb=addzero(b,nn)
ifint(b)<>int(n1)then
ifint(b)=1andfirstpage<>""then
pagestr=pagestr&"<ahref="""&firstpage&""">"&bb&"</a>"
else
pagestr=pagestr&"<ahref="""&filenamestart&""&bb&".htm"">"&bb&"</a>"
endif
else
pagestr=pagestr&""&bb&""
endif
next
pagestr=pagestr&"</div><divalign=""center"">"
ifint(n1)=1then
pagestr=pagestr&"<spanid=""PrevLink"">[Prev]</span>"
else
ifint(n1)=2andfirstpage<>""then
pagestr=pagestr&"[<aid=""PrevLink""href="""&firstpage&""">Prev</a>]"
else
pagestr=pagestr&"[<aid=""PrevLink""href="""&filenamestart&""&addzero((n1-1),nn)&".htm"">Prev</a>]"
endif
endif
ifint(n1)=int(nn)then
pagestr=pagestr&"<spanid=""NextLink"">[Next]</span>"
else
pagestr=pagestr&"[<aid=""NextLink""href="""&filenamestart&""&addzero((n1+1),nn)&".htm"">Next</a>]"
endif
ifint(nn)>1then
pagestr="<divclass=""pageDiv"">"&pagestr&"</div></div>"
else
pagestr=""
endif
ifint(n1)=1andfirstpage<>""then
creatfileoutstr,pagestr,"/"&firstpage
else
creatfileoutstr,pagestr,"/"&filenamestart&""&addzero(n1,nn)&".htm"
endif
outstr=""
endif
next
iferr=0then
msgbox"文件已生成"
else
msgbox"CreatPageHtml出错了:"&err.description
err.clear
endif
endsub
functionaddzero(num1,numn)
addzero=right("00000000"&num1,len(numn))
endfunction
functionformattitle(str)
str1=str
str1=replace(str1,"""","")
formattitle=str1
endfunction
subcreatfile(outstr,pagestr,name)
ONERRORRESUMENEXT
dimtmphtml
tmphtml=tmphtml&"<html>"&vbNewLine
tmphtml=tmphtml&"<head>"&vbNewLine
tmphtml=tmphtml&"<metahttp-equiv=""Content-Type""content=""text/html;charset=gb2312"">"&vbNewLine
tmphtml=tmphtml&"<metaname=""GENERATOR""content=""MicrosoftFrontPage4.0"">"&vbNewLine
tmphtml=tmphtml&"<metaname=""ProgId""content=""FrontPage.Editor.Document"">"&vbNewLine
tmphtml=tmphtml&"<title>"&pagetitle&"</title>"&vbNewLine
tmphtml=tmphtml&"<style>"&vbNewLine
tmphtml=tmphtml&"<>"&vbNewLine
tmphtml=tmphtml&"</style>"&vbNewLine
tmphtml=tmphtml&"</head>"&vbNewLine
tmphtml=tmphtml&"<bodyonkeydown=""if(event.keyCode==37){if(PrevLink.href){window.open(PrevLink.href,'_self','')}}elseif(event.keyCode==39){if(NextLink.href){window.open(NextLink.href,'_self','')}}"">"&vbNewLine
tmphtml=tmphtml&"<SCRIPTLANGUAGE=""JavaScript"">"&vbNewLine
tmphtml=tmphtml&"<>"&vbNewLine
tmphtml=tmphtml&"</SCRIPT>"&vbNewLine
tmphtml=tmphtml&"<divclass=""TitleDiv"">"&pagetitle&"</div>"&vbNewLine
tmphtml=tmphtml&pagestr&vbNewLine
tmphtml=tmphtml&"<divclass=""FullDiv"">"&vbNewLine
tmphtml=tmphtml&outstr&vbNewLine
tmphtml=tmphtml&"</div>"&vbNewLine
tmphtml=tmphtml&"<divclass=""TitleDiv""align=""center""><atarget=""_blank""href=""http://www.51windows.Net"">www.51windows.Net</a></div>"&vbNewLine
tmphtml=tmphtml&info&vbNewLine
tmphtml=tmphtml&"</body>"&vbNewLine
tmphtml=tmphtml&"</html>"&vbNewLine
dimhtmlstr
htmlstr=tmphtml
Setfso=CreateObject("Scripting.FileSystemObject")
Setfout=fso.CreateTextFile(cpath&name,true,false)
fout.WriteLinehtmlstr
fout.close
setfso=nothing
iferr<>0then
msgbox"creatfile出错了:"&err.description
err.clear
endif
endsub
ClassqswhImg
dimaso
PrivateSubClass_Initialize
setaso=CreateObject("Adodb.Stream")
aso.Mode=3
aso.Type=1
aso.Open
EndSub
PrivateSubClass_Terminate
setaso=nothing
EndSub
PrivateFunctionBin2Str(Bin)
DimI,Str
ForI=1toLenB(Bin)
clow=MidB(Bin,I,1)
ifASCB(clow)<128then
Str=Str&Chr(ASCB(clow))
else
I=I+1
ifI<=LenB(Bin)thenStr=Str&Chr(ASCW(MidB(Bin,I,1)&clow))
endif
Next
Bin2Str=Str
EndFunction
PrivateFunctionNum2Str(num,base,lens)
'qiushuiwuhen(2002-8-12)
dimret
ret=""
while(num>=base)
ret=(nummodbase)&ret
num=(num-nummodbase)/base
wend
Num2Str=right(string(lens,"0")&num&ret,lens)
EndFunction
PrivateFunctionStr2Num(str,base)
'qiushuiwuhen(2002-8-12)
dimret
ret=0
fori=1tolen(str)
ret=ret*base+cint(mid(str,i,1))
next
Str2Num=ret
EndFunction
PrivateFunctionBinVal(bin)
'qiushuiwuhen(2002-8-12)
dimret
ret=0
fori=lenb(bin)to1step-1
ret=ret*256+ascb(midb(bin,i,1))
next
BinVal=ret
EndFunction
PrivateFunctionBinVal2(bin)
'qiushuiwuhen(2002-8-12)
dimret
ret=0
fori=1tolenb(bin)
ret=ret*256+ascb(midb(bin,i,1))
next
BinVal2=ret
EndFunction
FunctiongetImageSize(filespec)
'qiushuiwuhen(2002-9-3)
dimret(3)
aso.LoadFromFile(filespec)
bFlag=aso.read(3)
selectcasehex(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)):loopwhilep1=255andnotaso.EOS
ifp1>191andp1<196thenexitdoelseaso.read(binval2(aso.Read(2))-2)
do:p1=binVal(aso.Read(1)):loopwhilep1<255andnotaso.EOS
loopwhiletrue
aso.Read(3)
ret(0)="JPG"
ret(2)=binval2(aso.Read(2))
ret(1)=binval2(aso.Read(2))
caseelse:
ifleft(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)=""
endif
endselect
ret(3)="width="""&ret(1)&"""height="""&ret(2)&""""
getimagesize=ret
EndFunction
EndClass
使用方法：将此文件放在sendto目录中（在运行中输入直接sendto，就可以打开），然后在有图片的文件夹上点右键，选择发送到，等一下，就OK了。下载操作演示
效果1：Logo展示
效果2：圣诞新年LOGO集锦
【VBS相册生成脚本[】相关文章：