?? lbbs_pic v1.02.asp
字號:
<%
'**************************************
'** LBBS_pic.asp
'**
'** 文件說明：樂學LBBS無限級目錄圖片直讀系統V1.02（ASP）
'** 創建日期：2008-04-30
'** 修改日期：2008-05-02
'** 網站支持：http://www.learn365.cn/（樂學365）
'** 技術支持：learn365
'** 作 者：cyc
'** 測試反饋: vfrs
'**************************************
'系統變量
Dim c_adminname,c_adminpassword,c_HomeName,c_HomeUrl,c_title,c_UploadDirg,c_PicType
Dim c_filelb,c_cook,con_MaxPerPage,con_Page,con_picwidth,con_picheight
dim c_strFileName,Action,totalPut,CurrentPage,TotalPages,upforder2
dim UploadDir,TruePath,fso,theFolder,theFile,thisfile,FileCount,TotalSize,TotalSize_Page
dim strFileType,sqlup,rsup,strFiles,iij,strDirName,strFileName
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.02" '系統版本號
'============參數設置（等號“=”前后不要留空）===================
c_admin_name="admin" '管理員名稱
c_admin_password="7a57a5a743894a0e" '管理密碼(用MD5加密，如果忘記，請改為“7a57a5a743894a0e”,密碼即是“admin”）
c_HomeName="<< 返回首頁" '網站首頁鏈接名稱（空值則不顯示）
c_HomeUrl="http://www.learn365.cn/" '網站首頁鏈接地址
c_title="樂學LBBS圖片庫" '標題名
c_UploadDirg="lbbs_pic" '圖片所在文件夾
c_PicType="jpg|gif|png|bmp" '圖片類型 (可使用|將圖片格式分開)
c_filelb="是" '左則是否顯示當前目錄下文件。（是：顯示，否則不顯示）
c_cook="是" '是否顯示并允許使用自定義功能。（是：可用，否則不可用）
con_MaxPerPage=20 '每頁顯示圖片數
con_Page=5 '每行顯示圖片數
con_picwidth=140 '圖片縮圖寬度
con_picheight=120 '圖片縮圖高度
'=============================================================
UploadDir =c_UploadDirg
c_filelb = Replace(c_filelb,"是","YES")
c_cook = Replace(c_cook,"是","YES")
If UploadDir = "" Then UploadDir="./"
if right(UploadDir,1)<>"/" or right(UploadDir,1)<>"\" then
UploadDir=UploadDir & "/"
End if
forder=request("forder")
If instr(forder,"../")>0 Or instr(forder,"./")>0 Then
Response.write "<script language='javascript'>alert('路徑有誤！');history.go(-1);</script>"
Response.End
End if
if forder<>"" then
if right(forder,1)<>"/" then
forder=forder & "/"
End If
UploadDir=UploadDir&forder
end If
if instr(forder,"/")>0 then
upforder=left(forder,instrrev(forder,"/")-1) 'upforder當前目錄去末尾的/
end If
if instr(upforder,"/")>0 then
upforder2=left(upforder,instrrev(upforder,"/")-1) 'upforder2上一層目錄
end If
TruePath=Server.MapPath(UploadDir)
if upforder2<>"" then
TruePath2=Server.MapPath(upforder2)
end If
c_strFileName=Request.ServerVariables("script_name")
If forder = "" Then
strFileName = c_strFileName
c_strFileName = c_strFileName
Else
strFileName = c_strFileName
c_strFileName = c_strFileName &"?forder="&forder&"&"
End If
Action=trim(Request("Action"))
if trim(request("page"))<>"" then
currentPage=cint(request("page"))
else
currentPage=1
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
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
strTemp=strTemp & "當前目錄下共 <b>" & totalnumber & "</b> 個文件，占用 <b>" & TotalSize\1024 & "</b> K "
sfilename=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首頁 上一頁 "
else
strTemp=strTemp & "<a title='首頁' href='" & sfilename & "page=1'>首頁</a> "
strTemp=strTemp & "<a title='上一頁' href='" & sfilename & "page=" & (CurrentPage-1) & "'>上一頁</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一頁 尾頁"
else
strTemp=strTemp & "<a title='下一頁' href='" & sfilename & "page=" & (CurrentPage+1) & "'>下一頁</a> "
strTemp=strTemp & "<a title='尾頁' href='" & sfilename & "page=" & n & "'>尾頁</a>"
end if
strTemp=strTemp & " 頁次：<strong><font color=red>" & CurrentPage & "</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(CurrentPage)=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
'------------------------------------------------
'------------------------------------------------
Sub ShowObjectInstalled(strObjName)
If IsObjInstalled(strObjName) Then
Response.Write "<font color='#99CCFF'><b>√</b></font>"
Else
Response.Write "<font color='red'><b>×</b>(無)</font>"
End If
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, s ,fs,jj,Filenames,FileSize,Filetype,i
set fs=CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
s = s &"<BR><B>當前目錄下文件夾：</B><br>"
Set fc = f.SubFolders
jj=1
For Each f1 in fc
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></a><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
'Filetype=Right(Trim(Filenames),3)
If Len(Filenames)>20 Then Filenames=Left(Filenames,20)&".."
If instr(LCase(c_PicType),LCase(Filetype))>0 Then
s = s &"<BR><a href='" & UploadDir & f1.name & "' target='_blank' alt='[文件]"&f1.name &Chr(10)&"[大小]"&round(FileSize\1024)&"K'>"
s = s &"<img border='0' src='images/file.gif' width='16' height='16'>"
s = s &"<font color='#0066FF'>"&i&".</font>"&Filenames&"</a>"
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 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 + -