VBS album generation script[

'///////////////////////////////////////////////
'VBS album generation script, how to use it: put this file in the sendto directory (enter sendto directly during runtime and you can open it), then right-click on the folder with pictures, select Send to, wait a moment, and it will be OK.
'Haiwa http://
'Update date: 2004-12-30
'///////////////////////////////////////////////

Set ArgObj =
Set fsoBrowse = CreateObject("")
dim cpath,imgw,imgh,pagesize,wn,hn,pagetitle,filenamestart,firstpage
cpath=ArgObj(0)'Pass path
imgw = 240
imgh = 180
wn = 3
hn = 3
pagetitle = "Picture Display-"
filenamestart = "Page_"
firstpage = ""

pagetitle2 = inputbox("Please enter the page title", "Please enter the page title", pagetitle)
if isempty(pagetitle2) = false and len(pagetitle2) > 1 then
    pagetitle = pagetitle2
end if

filenamestart2 = inputbox("Please enter the file name prefix", "Please enter the file name prefix", filenamestart)
if isempty(filenamestart2) = false and len(filenamestart2) > 1 then
    filenamestart = filenamestart2
end if

firstpage2 = inputbox("Please enter the file name of the first page, click Cancel to generate by sequence number", "Please enter the file name of the first page", 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("Please enter the width of the small picture", "Please enter the width of the small picture", imgw)
if isnumeric(imgw2) and isempty(imgw2) = false then
    imgw = imgw2
end if

imgh2 = inputbox("Please enter the height of the small picture", "Please enter the height of the small picture", imgh)
if isnumeric(imgh2) and isempty(imgh2) = false then
    imgh = imgh2
end if

wn2 = inputbox("Please enter the number of images per line", "Please enter the number of images per line", wn)
if isnumeric(wn2) and isempty(wn2) = false then
    wn = wn2
end if

hn2 = inputbox("Please enter the number of lines", "Please enter the number of lines", hn)
if isnumeric(hn2) and isempty(hn2) = false then
    hn = hn2
end if

dim info
info = ""
pagesize = wn*hn

dim message
message = ""
message = message & "File path:" & chr(9) & cpath & vbnewline
message = message & "Page title:" & chr(9) & pagetitle & vbnewline
message = message & "Filename prefix:" & chr(9) & filenamestart & vbnewline
message = message & "Homepage file name:" & chr(9) & firstpage & vbnewline
message = message & "Width of the small picture:" & chr(9) & imgw & vbnewline
message = message & "The height of the small picture" & chr(9) & imgh & vbnewline
message = message & "Number of images per line:" & chr(9) & wn & vbnewline
message = message & "Line number:" & chr(9) & chr(9) & hn & vbnewline

message = message & vbnewline & "Are you sure you generate?" & vbnewline

dim StartRun
StartRun = msgbox(message,1,"VBS album generation script")

if StartRun=1 then
    CreatPageHtml(FileInofList(cpath))
end if

function FileInofList(cpath)
    ON ERROR RESUME NEXT
    dim FileNameListStr
    FileNameListStr=""
    filesize = 0
    if (cpath)then
        Set theFolder=(cpath)
        Set theFiles=
        For Each x In theFiles
            if right(lcase(),4) = ".gif" or right(lcase(),4) = ".png" or right(lcase(),4) = ".jpg" then
                if >0 then
                    set qswh=new qswhImg
arr=(cpath & "\" & )' Get the extension of the picture, height and width information
                    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 &  & "|"&  &"|"& 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 error:" &

    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(,"& 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(,"& 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 "File generated"
    else
msgbox "CreatPageHtml error:" &

    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="""">" & vbNewLine
    tmphtml = tmphtml &  "<title>"& pagetitle &"</title>" & vbNewLine
    tmphtml = tmphtml &  "<style>" & vbNewLine
    tmphtml = tmphtml &  "" & vbNewLine
    tmphtml = tmphtml &  "</style>" & vbNewLine
    tmphtml = tmphtml &  "</head>" & vbNewLine
    tmphtml = tmphtml &  "<body onkeydown=""if(==37){if(){(,'_self','')}}else if(==39){if(){(,'_self','')}}"">" & vbNewLine
    tmphtml = tmphtml &  "<SCRIPT LANGUAGE=""JavaScript"">" & 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://""></a></div>" & vbNewLine
    tmphtml = tmphtml &  info & vbNewLine
    tmphtml = tmphtml &  "</body>" & vbNewLine
    tmphtml = tmphtml &  "</html>" & vbNewLine

    dim htmlstr
    htmlstr = tmphtml

    Set fso = CreateObject("")
    Set fout = (cpath&name,true,false)
     htmlstr

    set fso = nothing
    if err<>0 then
msgbox "creatfile error:" &

    end if
end sub

Class qswhImg
dim aso
Private Sub Class_Initialize
    set aso=CreateObject("")
    =3
    =1

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)
    (filespec)
    bFlag=(3)
    select case hex(binVal(bFlag))
    case "4E5089":
        (15)
        ret(0)="PNG"
        ret(1)=BinVal2((2))
        (2)
        ret(2)=BinVal2((2))
    case "464947":
        (3)
        ret(0)="GIF"
        ret(1)=BinVal((2))
        ret(2)=BinVal((2))
    case "535746":
        (5)
        binData=(1)
        sConv=Num2Str(ascb(binData),2 ,8)
        nBits=Str2Num(left(sConv,5),2)
        sConv=mid(sConv,6)
        while(len(sConv)<nBits*4)
            binData=(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((1)): loop while p1=255 and not
            if p1>191 and p1<196 then exit do else (binval2((2))-2)
            do:p1=binVal((1)):loop while p1<255 and not
        loop while true
        (3)
        ret(0)="JPG"
        ret(2)=binval2((2))
        ret(1)=binval2((2))
    case else:
        if left(Bin2Str(bFlag),2)="BM" then
            (15)
            ret(0)="BMP"
            ret(1)=binval((4))
            ret(2)=binval((4))
        else
            ret(0)=""
        end if
    end select
    ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
    getimagesize=ret
End Function
End Class