此脚本的功能为将一个目录中的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集锦