VBS相册生成脚本[

''///////////////////////////////////////////////
''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="<!--本页面有VBScript相册生成脚本生成，http://www.51windows.Net-->"
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&"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:0pxsolid#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:1pxsolid#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:1pxsolid#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&"<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&"functionShowImg(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>ViewImage-51windows.Net</title><head><metahttp-equiv=Content-Typecontent=""text/html;charset=gb2312""></head><bodystyle=""border:0px;margin:0px;""onkeydown=if(event.keyCode==27){window.close()}><center><imgtitle=""点击关闭窗口""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&"<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