'///////////////////////////////////////////////
'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(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