?? lbbs_pic v1.04.asp
字號:
<%
'**********************************************************
'** LBBS_pic.asp
'**
'** 文件說明：樂學LBBS無限級目錄圖片直讀系統V1.04（ASP）
'** 創建日期：2008-04-30
'** 修改日期：2008-05-14
'** 網站支持：http://www.learn365.cn/（樂學365）
'** 技術支持：learn365
'** 作 者：cyc
'** 測試反饋: vfrs、duohai等
'**********************************************************
'系統變量
Option Explicit '變量定義后可用
Dim c_admin_name,c_admin_password,c_HomeName,c_HomeUrl,c_title,c_UploadDirg,c_PicType
Dim c_filelb,c_cook,con_MaxPerPage,con_Page,con_picwidth,con_picheight,c_shownane
dim picurl,c_picurl,Action,totalPut,picPage,TotalPages,FileExt,picbgclass
dim UploadDir,TruePath,fso,theFolder,theFile,thisfile,FileCount,TotalSize,TotalSize_Page
dim strFileType,sqlup,rsup,strFiles,iij,strDirName,admin_login,delpic
dim forder,upforder,action_cook,c_MaxPerPage,cook_MaxPerPage,cook_MaxPerPage01
dim c_Page,cook_Page,cook_Page01,c_picwidth,cook_picwidth,cook_picwidth01
dim c_picheight,cook_picheight,cook_picheight01
dim starttime:starttime = timer()
dim c_poweredby:c_poweredby ="v1.04" '系統版本號
'============參數設置（等號“=”前后不要留空）===================
c_admin_name="hz" '管理員名稱
c_admin_password="a793272f232d2877" '管理密碼(用MD5加密，如果忘記，請改為“7a57a5a743894a0e”,密碼即是“admin”）
c_HomeName="<< 返回首頁" '網站首頁鏈接名稱（空值則不顯示）
c_HomeUrl="../" '網站首頁鏈接地址
c_title="海洲中學榮譽證書" '標題名
c_UploadDirg="zhengshu_pic" '圖片所在文件夾
c_PicType="jpg|gif|png|bmp" '圖片類型 (可使用|將圖片格式分開)
c_filelb="是" '左則是否顯示當前目錄下文件。（是：顯示，否則不顯示）
c_cook="是" '是否顯示并允許使用自定義功能。（是：可用，否則不可用）
c_shownane="是" '是否中圖片下顯示圖片文件名。（是：顯示，否則不顯示）
con_MaxPerPage=20 '每頁顯示圖片數
con_Page=2 '每行顯示圖片數
con_picwidth=380 '圖片縮圖寬度
con_picheight=250 '圖片縮圖高度
'=============================================================
If c_UploadDirg="" Then
Response.write "未設置圖片所在文件夾，程序停止執行。"
Response.End
End If
'轉換參數，以便后臺管理設置
c_filelb = Replace(c_filelb,"是","YES")
c_cook = Replace(c_cook,"是","YES")
c_shownane = Replace(c_shownane,"是","YES")
'取文件夾路徑/目錄
forder=request("forder")
forder=Replace(forder,"\","/") '轉換\為/，保證彈窗跳轉路徑正確
If forder="" Then forder=c_UploadDirg
If Left(forder,1)="/" Then forder=replace(forder,Left(forder,1),"")
if inStr(forder,"//")<>0 Then forder = Replace( forder ,"//","/" )
If instr(forder,"../")>0 Or instr(forder,"./")>0 Or forder="/" Or forder="." Then
Response.write "<script language='javascript'>alert('文件夾路徑有誤！');history.go(-1);</script>"
Response.End
End If
'取上層文件夾/目錄
if instr(forder,"/")>0 then
upforder=left(forder,instrrev(forder,"/")-1) 'upforder當前目錄去末尾的\
end If
'取目錄實際路徑
TruePath=Server.MapPath(forder)
'取當前文件路徑/文件名
picurl=Request.ServerVariables("script_name")
If forder = "" Then
c_picurl = picurl
Else
c_picurl = picurl &"?forder="&forder&""
End If
'頁碼
picPage=trim(request("page"))
if picPage<>"" then
picPage=cint(picPage)
else
picPage=1
end if
'管理員登錄檢查
admin_login=false
If Session("lbbs_pic_UserName")=c_admin_name And Session("lbbs_pic_password")=c_admin_password Then
admin_login=True
end if
'-----------------------------------
'自定義每頁圖片數、行數、寬度、高度
If c_cook = "YES" then
action_cook = request("action_cook")
Select Case action_cook
Case "cookies"
cook_MaxPerPage = trim(replace(request("cook_MaxPerPage")," ",""))
cook_Page = trim(replace(request("cook_Page")," ",""))
cook_picwidth = trim(replace(request("cook_picwidth")," ",""))
cook_picheight = trim(replace(request("cook_picheight")," ",""))
if not(IsNumeric(cook_MaxPerPage)) then
Response.write "<script language='javascript'>alert('第頁圖片數：你輸入的不是純數字，請輸入1-30之間的數字！');history.go(-1);</script>"
Response.end
elseif cook_MaxPerPage<1 or cook_MaxPerPage>30 then
Response.write "<script language='javascript'>alert('第頁圖片數：請輸入1-30之間的數字！');history.go(-1);</script>"
Response.end
end if
if not(IsNumeric(cook_Page)) then
Response.write "<script language='javascript'>alert('每行圖片數：你輸入的不是純數字，請輸入正確數字！');history.go(-1);</script>"
Response.end
elseif cook_Page<1 or cook_Page>10 then
Response.write "<script language='javascript'>alert('每行圖片數：請輸入1-10之間的數字！');history.go(-1);</script>"
Response.end
end if
if not(IsNumeric(cook_picwidth)) then
Response.write "<script language='javascript'>alert('圖片寬度：你輸入的不是純數字，請輸入正確數字！');history.go(-1);</script>"
Response.end
elseif cook_picwidth<20 or cook_Page>800 then
Response.write "<script language='javascript'>alert('圖片寬度：請輸入20-800之間的數字！');history.go(-1);</script>"
Response.end
end if
if not(IsNumeric(cook_picheight)) then
Response.write "<script language='javascript'>alert('圖片高度：你輸入的不是純數字，請輸入正確數字！');history.go(-1);</script>"
Response.end
elseif cook_picheight<20 or cook_picheight>800 then
Response.write "<script language='javascript'>alert('圖片高度：請輸入20-800之間的數字！');history.go(-1);</script>"
Response.end
end If
Response.cookies("cycpic")("cook_MaxPerPage") = cook_MaxPerPage
Response.cookies("cycpic")("cook_Page") = cook_Page
Response.cookies("cycpic")("cook_picwidth") = cook_picwidth
Response.cookies("cycpic")("cook_picheight") = cook_picheight
if cook_MaxPerPage<>"" and cook_Page<>"" and cook_picwidth<>"" and cook_picheight<>"" then
Select Case Request.Form("CookieTime")
Case 1
Response.cookies("cycpic").Expires=Date+1
Case 2
Response.cookies("cycpic").Expires=Date+7
Case 3
Response.cookies("cycpic").Expires=Date+31
Case 4
Response.cookies("cycpic").Expires=Date+365
End Select
end If
Case "con"
Response.cookies("cycpic")("cook_MaxPerPage") = con_MaxPerPage
Response.cookies("cycpic")("cook_Page") = con_Page
Response.cookies("cycpic")("cook_picwidth") = con_picwidth
Response.cookies("cycpic")("cook_picheight") = con_picheight
End Select
End If
'---------------------------------
cook_MaxPerPage = Request.cookies("cycpic")("cook_MaxPerPage")
cook_Page = Request.cookies("cycpic")("cook_Page")
cook_picwidth = Request.cookies("cycpic")("cook_picwidth")
cook_picheight = Request.cookies("cycpic")("cook_picheight")
if cook_MaxPerPage="" then c_MaxPerPage = con_MaxPerPage else c_MaxPerPage = cook_MaxPerPage
if cook_Page="" then c_Page = con_Page else c_Page = cook_Page
if cook_picwidth="" then c_picwidth = con_picwidth else c_picwidth = cook_picwidth
if cook_picheight="" then c_picheight = con_picheight else c_picheight = cook_picheight
'------------------------------------------------
'上一頁、下一頁鏈接
sub showpage(sfilename,totalnumber,c_MaxPerPage)
dim n, i,strTemp
c_MaxPerPage=CInt(c_MaxPerPage)
if totalnumber mod c_MaxPerPage=0 then
n= totalnumber \ c_MaxPerPage
else
n= totalnumber \ c_MaxPerPage+1
end If
If totalnumber=0 Then
Exit Sub
End if
sfilename=JoinChar(sfilename)
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
strTemp=strTemp & "當前目錄下共 <b>" & totalnumber & "</b> 個文件，占用 <b>" & SizeTo(TotalSize)& "</b> "
if picPage<2 then
strTemp=strTemp & "首頁 上一頁 "
else
strTemp=strTemp & "<a title='首頁' href='" & sfilename & "page=1'>首頁</a> "
strTemp=strTemp & "<a title='上一頁' href='" & sfilename & "page=" & (picPage-1) & "'>上一頁</a> "
end if
if n-picPage<1 then
strTemp=strTemp & "下一頁 尾頁"
else
strTemp=strTemp & "<a title='下一頁' href='" & sfilename & "page=" & (picPage+1) & "'>下一頁</a> "
strTemp=strTemp & "<a title='尾頁' href='" & sfilename & "page=" & n & "'>尾頁</a>"
end if
strTemp=strTemp & " 頁次：<strong><font color=red>" & picPage & "</font>/" & n & "</strong>頁 "
strTemp=strTemp & " <b>" & c_MaxPerPage & "</b>" & "個文件/頁"
strTemp=strTemp & " 轉到：<select name='page' size='1' onchange='javascript:submit()'>"
for iij = 1 to n
strTemp=strTemp & "<option value='" & iij & "'"
if cint(picPage)=cint(iij) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & iij & "頁</option>"
next
strTemp=strTemp & "</select>"
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end sub
'------------------------------------------------
'------------------------------------------------
'函數名：IsObjInstalled 檢查組件是否已經安裝（參 數：strClassString ----組件名）
'返回值：True ----已經安裝 False ----沒有安裝
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'------------------------------------------------
'函數名：JoinChar
'作 用：向地址中加入 ? 或 &
'參 數：strUrl ----網址
'返回值：加了 ? 或 & 的網址
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end Function
'------------------------------------------------
'------------------------------------------
'目錄存在時顯示此目錄下的所有子目錄
Function ShowFolderList(folderspec)
On Error Resume Next
Dim f,f1,fc,fc2,s,fs,jj,Filenames,FileSize,i,pj,pj2,picFile
set fs=CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
's = s &"<B>當前目錄下文件夾：</B><br>"
Set fc = f.SubFolders
jj=1
For Each f1 in fc
pj=0
pj2=0
For Each picFile In f1.Files
If instr(LCase(c_PicType),LCase(Right(Trim(picFile.name),3)))>0 Then
pj=pj+1
Else
pj2=pj2+1
End If
Next
If CInt(pj)>0 Then pj=" "&pj&"P" Else pj=""
If CInt(pj2)>0 Then pj2=" "&pj2&"F" Else pj2=""
s = s & "<a title='"&f1.name&"' href='?forder="&forder&"/"&f1.name&"'><img border='0' src='images/folder.gif' width='16' height='16'>"
s = s &"<font color='#0066FF'>"&jj&"."& f1.name&"</font>"& pj & pj2 &"</a>"
s = s &"<br>"
jj=jj+1
Next
If jj-1=0 then s = s &"(當前目錄無下層文件夾)<BR>"
If c_filelb = "YES" then
's = s &"<BR><B>當前目錄下文件：</B>"
'讀取該文件夾下所有文件
Set fc2 = f.Files
i=1
For Each f1 in fc2
Filenames= f1.name
FileSize= f1.Size
FileExt = fs.GetExtensionName(Filenames) '獲得文件的擴展名
if FileExt<>"" then
FileExt = Lcase(FileExt)
end if
If Len(Filenames)>20 Then Filenames=Left(Filenames,20)&".."
If instr(LCase(c_PicType),FileExt)>0 Then
s = s &"<a href='"&Server.URLEncode(forder &"\"& f1.Name)&"' target='_blank' alt='[文件]"&f1.name &Chr(10)&"[大小]"&SizeTo(FileSize)&"'>"
s = s &"<img src='images/" & FileExt & ".gif' border='0' onerror=""this.src='images/Unknown.gif';"">"
s = s &"<font color='#0066FF'>"&i&".</font>"&Filenames&"</a><BR>"
else
i=i-1
End If
i=i+1
Next
If i-1=0 then s = s &"(當前目錄無文件)<BR>"
End if
ShowFolderList = s
End Function
'===========================================
'===========================================
'轉換文件大小轉換
Function SizeTo(PFSize)
SizeTo=0
IF PFSize>(1024*1024*1024) And (PFSize/1024/1024/1024)>0 Then
'GB轉換
SizeTo=FormatNumber(PFSize/1024/1024/1024,2)&" GB"
ElseIF PFSize>(1024*1024) And (PFSize/1024/1024)>0 Then
'MB轉換
SizeTo=FormatNumber(PFSize/1024/1024,2)&" MB"
ElseIF PFSize>1024 And (PFSize/1024)>0 Then
'KB轉換
SizeTo=FormatNumber(PFSize/1024,2)&" KB"
ElseIF PFSize>0 Then
'byte轉換
SizeTo="0"&FormatNumber(PFSize/1024,3)&" KB"
'SizeTo=PFsize&" Byte(字節)"
Else
SizeTo=0&" Byte(字節)"
End IF
End Function
'===========================================
'===========================================
function strvalue(str,lennum) '截取字符串，支持中英文混用
dim p_num,x
dim i
if strlen(str)<=lennum then
strvalue=str
else
p_num=0
x=0
do while not p_num > lennum-2
x=x+1
if asc(mid(str,x,1))<0 then
p_num=int(p_num) + 2
else
p_num=int(p_num) + 1
end if
strvalue=left(trim(str),x)&"…"
loop
end if
end function
'===========================================
'===========================================
'MD5
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -