本来想用相册程序,但无法批量上传图片,自写了一端代码,与君共享
复制内容到剪贴板
代码:
'---------image.asp------------------------------------------------------------------------------------------------------------------------
<!--#include file="BlogCommon.asp" -->
<!--#include file="header.asp" -->
<!--#include file="common/ModSet.asp" -->
<!--#include file="common/UBBconfig.asp" -->
<!--#include file="class/cls_article.asp" -->
<!--#include file="plugins.asp" -->
<div id="Tbody">
<div id="mainContent">
<div id="innermainContent">
<div id="mainContent-topimg"></div>
<%=content_html_Top%>
<%
dim myfolder
if trim(request("myfolder"))<>"" then
dim AttPath,ArrFolder,Arrfile,ArrFolders,Arrfiles,arrUpFolders,arrUpFolder,TempF,filecount,i,cur
TempF=""
if request("page")="" then
cur=1
else
cur=int(request("page"))
end if
filecount=1
AttPath="project/" & trim(request("myfolder"))
ArrFolders=split(getPathList(AttPath)(0),"*")
Arrfiles=split(getPathList(AttPath)(1),"*")
' response.write "<div style=""font-weight:bold;font-size:14px;margin:3px;margin-left:0px"">"&AttPath&"</div><div style=""margin:3px;margin-left:0px;"">"
response.write "<div style=""font-weight:bold;font-size:14px;margin:3px;margin-left:0px""> </div><div style=""margin:3px;margin-left:0px;"">"
for each ArrFolder in ArrFolders
' response.write "<img border=""0"" src=""images/file/folder.gif"" style=""margin:4px 3px -3px 0px""/>"&ArrFolder&"</a><br>"
next
for each Arrfile in Arrfiles
filecount=filecount+1
next
%>
<div class="pageContent" style="text-align:Right;overflow:hidden;height:18px;line-height:140%"><%=MultiPage(filecount-1,10,cur,Url_Add,"","float:Left")%> </div>
<%
dim endi
if (cur-1)*10+9>filecount-2 then
endi=filecount-2
else
endi=(cur-1)*10+9
end if
for i=(cur-1)*10 to endi
'for each Arrfile in Arrfiles
' response.write getFileIcons(getFileInfo(AttPath&"/"&Arrfile)(1))&Arrfile&"</a> "&getFileInfo(AttPath&"/"&Arrfile)(0)&" | "&getFileInfo(AttPath&"/"&Arrfile)(2)&" | "&getFileInfo(AttPath&"/"&Arrfile)(3)&"<br>"
response.write "<a href='" &AttPath&"/"&Arrfiles(i)&"' target=_blank><img style=""margin:4px 3px -3px 0px;width:320px;height:240px"" src='" & AttPath&"/"&Arrfiles(i) & "'></a><br><br>"
next
response.write "</div>"%>
<div class="pageContent"><%=MultiPage(filecount-1,10,cur,Url_Add,"","float:Left")%></div>
<%
else
response.write "Please check your input directory"
end if%>
<%=content_html_Bottom%>
<div id="mainContent-bottomimg"></div>
</div>
</div>
<% Side_Module_Replace '處理系統側欄模組訊息 %>
<div id="sidebar">
<div id="innersidebar">
<div id="sidebar-topimg"><!--工具條頂部圖像--></div>
<%=side_html%>
<div id="sidebar-bottomimg"></div>
</div>
</div>
<div style="clear: both;height:1px;overflow:hidden;margin-top:-1px;"></div>
</div>
<!--#include file="footer.asp" -->
<%
function getPathList(pathName) '獲得路徑的文件訊息
dim FSO,ServerFolder,getInfo,getInfos,tempS
getInfo=""
Set FSO=Server.CreateObject("Scripting.FileSystemObject")
Set ServerFolder=FSO.GetFolder(Server.MapPath(pathName))
Dim ServerFolderList,ServerFolderEvery
Set ServerFolderList=ServerFolder.SubFolders
tempS=""
For Each ServerFolderEvery IN ServerFolderList
getInfo=getInfo&tempS&ServerFolderEvery.Name
tempS="*"
Next
getInfo=getInfo&"|"
Dim ServerFileList,ServerFileEvery
Set ServerFileList=ServerFolder.Files
tempS=""
For Each ServerFileEvery IN ServerFileList
getInfo=getInfo&tempS&ServerFileEvery.Name
tempS="*"
Next
Set FSO=Nothing
getInfos=split(getInfo,"|")
getPathList=getInfos
end function
function getFileInfo(FileName) '獲取文件訊息
dim FSO,File,FileInfo(3)
Set FSO=Server.CreateObject("Scripting.FileSystemObject")
if FSO.FileExists(Server.MapPath(FileName)) then
Set File=FSO.GetFile(Server.MapPath(FileName))
FileInfo(0)=File.Size
if FileInfo(0)/1000>1 then
FileInfo(0)=int(FileInfo(0)/1000)&" KB"
else
FileInfo(0)=FileInfo(0)&" Bytes"
end if
FileInfo(1)=lcase(right(FileName,4))
FileInfo(2)=File.DateCreated
FileInfo(3)=File.Type
end if
getFileInfo=FileInfo
Set FSO=Nothing
end function
function getFileIcons(str) '獲取文件圖標
dim FileIcon,Target
Select Case str
case ".jpg"
FileIcon="jpg.gif"
case ".gif"
FileIcon="gif.gif"
case ".bmp"
FileIcon="bmp.gif"
case ".png"
FileIcon="png.gif"
case ".zip"
FileIcon="zip.gif"
case ".rar"
FileIcon="rar.gif"
case ".swf"
FileIcon="swf.gif"
case ".mdb"
FileIcon="mdb.gif"
case ".doc"
FileIcon="doc.gif"
case ".xls"
FileIcon="xls.gif"
case ".pdf"
FileIcon="pdf.gif"
case ".mbk"
FileIcon="mbk.gif"
case ".mp3"
FileIcon="mp3.gif"
case ".wmv"
FileIcon="wma.gif"
case ".wma"
FileIcon="wma.gif"
case else
FileIcon="unknow.gif"
end Select
getFileIcons="<img border=""0"" src=""images/file/"&FileIcon&""" style=""margin:4px 3px -3px 0px""/>"
end function
Function GetTotalSize(GetLocal,GetType) '獲得目標大小
Dim FSO
Set FSO=Server.CreateObject("Scripting.FileSystemObject")
IF Err<>0 Then
Err.Clear
GetTotalSize="Fail"
Else
Dim SiteFolder
IF GetType="Folder" Then
Set SiteFolder=FSO.GetFolder(GetLocal)
Else
Set SiteFolder=FSO.GetFile(GetLocal)
End IF
GetTotalSize=SiteFolder.Size
IF GetTotalSize>1024*1024 Then
GetTotalSize=GetTotalSize/1024/1024
IF inStr(GetTotalSize,".") Then GetTotalSize = Left(GetTotalSize,inStr(GetTotalSize,".")+2)
GetTotalSize=GetTotalSize&" MB"
Else
GetTotalSize=Fix(GetTotalSize/1024)&" KB"
End IF
Set SiteFolder=Nothing
End IF
Set FSO=Nothing
End Function
Function MultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style)
CurPage=Int(Curpage)
Numbers=Int(Numbers)
Dim URL
URL=Request.ServerVariables("Script_Name")&Url_Add
MultiPage=""
Dim Page,Offset,PageI
' If Int(Numbers)>Int(PerPage) Then
Page=9
Offset=4
Dim Pages,FromPage,ToPage
If Numbers Mod Cint(Perpage)=0 Then
Pages=Int(Numbers/Perpage)
Else
Pages=Int(Numbers/Perpage)+1
End If
FromPage=Curpage-Offset
ToPage=Curpage+Page-Offset-1
If Page>Pages Then
FromPage=1
ToPage=Pages
Else
If FromPage<1 Then
Topage=Curpage+1-FromPage
FromPage=1
If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then ToPage=Page
ElseIF Topage>Pages Then
FromPage =Curpage-Pages +ToPage
ToPage=Pages
If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then FromPage=Pages-Page+1
End If
End If
MultiPage="<div class=""page"" style="""&Style&"""><ul>"
'if Curpage<>1 then MultiPage=MultiPage&"<li class=""PageL""><a href="""&Url&"page=1"" class=""PageLbutton"" title=""第一頁""></a></li>"
MultiPage=MultiPage&"<li class=""pageNumber"">"
if Curpage<>1 then MultiPage=MultiPage&"<a href="""&Url&"page=1"&"&myfolder="&trim(request("myfolder"))&""" title=""第一頁"" style=""text-decoration:none""><</a> | "
if not FirstShortCut then ShortCut=" accesskey="",""" else ShortCut=""
if Curpage<>1 then MultiPage=MultiPage&"<a href="""&Url&"page="&CurPage-1&""" title=""上一頁"" style=""text-decoration:none;"""&ShortCut&"></a>"
For PageI=FromPage TO ToPage
If PageI<>CurPage Then
MultiPage=MultiPage&"<a href="""&Url&"page="&PageI&aname&"&myfolder="&trim(request("myfolder"))&""">"&PageI&"</a> | "
Else
MultiPage=MultiPage&"<strong>"&PageI&"</strong>"
if PageI<>Pages then MultiPage=MultiPage&" | "
End If
Next
if not FirstShortCut then ShortCut=" accesskey="".""" else ShortCut=""
if Curpage<>pages then MultiPage=MultiPage&"<a href="""&Url&"page="&CurPage+1&"&myfolder="&trim(request("myfolder"))&""" title=""下一頁"" style=""text-decoration:none"""&ShortCut&"></a>"
if Curpage<>pages then MultiPage=MultiPage&"<a href="""&Url&"page="&Pages&aname&"&myfolder="&trim(request("myfolder"))&""" title=""最後一頁"" style=""text-decoration:none"">></a>"
MultiPage=MultiPage&"</li>"
'If Int(Pages)>Int(Page) Then
' MultiPage=MultiPage&"<li>...</li><li><a href="""&Url&"page="&Pages&aname&""">"&pages&"</a></li>"
'End If
'if Curpage<>pages then MultiPage=MultiPage&"<li class=""PageR""><a href="""&Url&"page="&Pages&aname&""" class=""PageRbutton"" title=""最後一頁""></a></li>"
MultiPage=MultiPage&"</ul></div>"
' End If
FirstShortCut=true
End Function
%>
'---------end of image.asp------------------------------------------------------------------------------------------------------------------使用方法:
1. 在/目录下上传上述image.asp文件,在/下建立project目录，
2. 将所有图片处理到某个较小尺寸
3． 建议所有图片文件尽量用英文或数字命名
4． 将同一内容的图片放到一个文件夹内，不要摆放在子文件夹内,文件夹可任意命名,如test
5． 将文件夹上传到/project/下，目录结构如/project/test/
6． 上诉步骤5中的文件夹/test/下为您处理完的所有图片
7． 发表新日志,添加联结为image.asp?myfolder=test即可自动显示test文件夹下的所有图片
8． 修改少少可自行批量做小图,联接显示大图.
[
本帖最后由 sting 于 2006-1-12 22
编辑 ]
![[PJblog^3]技术支持论坛 - PJBLOG SUPPORT FORUM](images/phpwind/logo.gif){kind=logo}
