VBS相册生成脚本[

'///////////////////////////////////////////////
'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,"""","#34")
    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(cpathname,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=sConvNum2Str(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 p1196 then exit do else aso.read(binval2(aso.Read(2))-2)
            do:p1=binVal(aso.Read(1)):loop while p1255 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