欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

VBS相册生成脚本[

程序员文章站 2022-06-25 08:52:08
此脚本的功能为将一个目录中的jpg,gif,png格式的图片生成html相册,页面上的图像只是改变显示大小,并没有生成缩略图。用到的技术:scripting.filesys...
此脚本的功能为将一个目录中的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集锦