时间:2021-05-22
此脚本的功能为将一个目录中的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="<!--本页面有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
使用方法:将此文件放在sendto目录中(在运行中输入直接sendto,就可以打开),然后在有图片的文件夹上点右键,选择发送到,等一下,就OK了。下载操作演示
效果1:Logo展示
效果2:圣诞新年LOGO集锦
声明:本页内容来源网络,仅供用户参考;我单位不保证亦不表示资料全面及准确无误,也不保证亦不表示这些资料为最新信息,如因任何原因,本网内容或者用户因倚赖本网内容造成任何损失或损害,我单位将不会负任何法律责任。如涉及版权问题,请提交至online#300.cn邮箱联系删除。
Vbs脚本病毒生成器V1.0版 简 介:国产的新编的vbs脚本病毒生成器1.0版,本程序通过采集用户的各项输入、选择,产生符合需要的vbs脚本病毒,属于傻瓜式的
Install.vbs发布者MicrosoftCorporation脚本专家此脚本由scenario1.vbs在一台网络主机上启动。Install.vbs可以在
VBS脚本和BAT批处理自身删除的方法(自杀)删除自身之:VBS把下面的脚本保存为selfkill.vbs或selfkill.vbe:复制代码代码如下:Setf
Office软件保护平台脚本(ospp.vbs)使你能够配置Office产品(包括Project和Visio)的批量许可版本。ospp.vbs脚本opss.vb
之前大多数人可能用过VBS读取Windows产品密钥的VBS脚本,VBS脚本通常都比较隐晦、难懂,今天忙里偷闲,随手写了一个用于读取Windows产品密钥的Po