中文字幕二区_国产精品免费在线观看_黄色网站观看_人人草人人澡_日本真实娇小xxxx

謝絕轉(zhuǎn)載

1：請(qǐng)尊重我的勞動(dòng)成果，貼出以下代碼只幫助個(gè)人欣賞或者學(xué)習(xí)，請(qǐng)直接copy不要用于商業(yè)用途。
2： 這是我從我寫的某系統(tǒng)里面剔出的程序，當(dāng)時(shí)水平差（現(xiàn)在也是），程序絕非產(chǎn)品級(jí)的代碼，但絕非無(wú)價(jià)值的。

實(shí)現(xiàn)功能：
文件(夾)目錄列表 提供了查閱目錄下面的文件和文件夾
文件 寫,創(chuàng),刪 提供了編輯,刪除文件(文件夾)的操作
創(chuàng)建文件夾/文件 針對(duì)創(chuàng)建文件夾(文件)而設(shè)置.
上傳文件 您可以模擬FTP上傳,文件大小,類型不受限制.

有興趣的自己體驗(yàn)，出現(xiàn)任何問(wèn)題我均不承擔(dān)任何后果，在此說(shuō)，我沒(méi)多少時(shí)間上網(wǎng)，經(jīng)常也顧不過(guò)來(lái)，是看到最近經(jīng)常有人問(wèn)這方面的問(wèn)題，就發(fā)上來(lái)，希望有所幫助。

upfso.asp //控制上傳的文件

代碼拷貝框
<!--#include file="upload.asp" --> <%'On Error Resume Next%> <STYLE type="text/css"> @import url("admin.css");</STYLE> <% Server.ScriptTimeOut = 999 'up_filetype="RAR,ZIP,SWF,JPG,PNG,GIF,DOC,TXT,CHM,PDF,ACE,JPG,MP3,WMA,WMV,bmp" IF Request.QueryString("yes")="upload" Then path=Trim(request("path")) 'response.write(path&"---") 'response.End Dim FSO,FSOIsOK,F_FileName,mode F_FileName=Trim(request("nn")) mode =killint(Trim(request("mode")),0,0,2) FSOIsOK=1 Set FSO=Server.CreateObject("Scripting.FileSystemObject") If Err<>0 Then Err.Clear FSOIsOK=0 End If Dim D_Name,F_Name If FSOIsOK=1 Then If InStr(1,path,":\")=0 Then path=Replace(Lcase(path),"\","/") path = server.mappath(path) path=Replace(path&"/","http://","/") Else path=Replace(Lcase(path),"/","\") path=Replace(path&"\","\\","\") End If if not fso.folderexists(path) Then response.write "<a href=""javascript:history.back()""><font color='#000080'>基本路徑查找失敗,返回</font></a>" response.End End If End If Set FSO=Nothing Dim FileUP Set FileUP=New Upload_File FileUP.GetDate(-1) Dim F_FileType, F_File Set F_File=FileUP.File("File") If Len(F_FileName)<2 Then F_FileName = F_File.FileName If Len(F_FileName)<2 Then response.write("<a href='javascript:history.go(-1);'><font color='#000080'>空文件,請(qǐng)返回</font></a>") response.End End If 'F_FileType = Ucase(F_File.FileExt) 'IF F_File.FileSize > 90000 Then ' Response.Write("<a href='javascript:history.go(-1);'>大小超過(guò)限制</a>") 'exit sub IF IsvalidFileName(F_FileName) = False Then Response.Write("<a href='javascript:history.go(-1);'><font color='#000080'>名稱有誤</font></a>") Else Dim FileIsExists Set FSO=Server.CreateObject("Scripting.FileSystemObject") FileIsExists=FSO.FileExists(path&F_FileName) If FileIsExists=True And mode<>1 Then fso.deletefile(path&F_FileName) Response.Write("<font color='#000080'>文件已經(jīng)存在,已經(jīng)被刪除</b></a>;") F_File.SaveToFile path&F_FileName Response.Write("<a href='upfso.asp?action=fso&path="&path&"'><b><font color='#000080'>點(diǎn)擊這里繼續(xù)上傳:"&path&F_FileName&"</font></b></a>") ElseIf FileIsExists=True And mode=1 Then Response.Write("<font color='#000080'>文件已經(jīng)存在,您選擇了不覆蓋</font></b>") Else F_File.SaveToFile path&F_FileName Response.Write("<a href='upfso.asp?action=fso&path="&path&"'><b><font color='#000080'>點(diǎn)擊這里繼續(xù)上傳:"&path&F_FileName&"</font></b></a>") End If End IF Set F_File=Nothing Set FileUP=Nothing Else Dim path,nn,mmode nn=Trim(request("nn")) mmode=Trim(request("mode")) path=Replace(request("path"),"http://","/") If path="" Then path="../newup/" Response.Write("<form enctype=""multipart/form-data"" method=""post"" action=""upfso.asp?yes=upload&path="&path&"&nn="&nn&"&mode="&mmode&""" class=""admin_fso_up"" onsubmit=""CheckForm()"" name='form'><label>選擇:<input name=""File"" type=""File"" size=""20""/></label><label> <input type=""Submit"" name=""Submit"" class=""submit"" value="" 上傳 "" /></label></form>") End IF '效驗(yàn)名稱 Function IsvalidFileName(File_Name) IsvalidFileName = False Dim re,reStr Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="[^_\.a-zA-Z\d]" reStr=re.Replace(File_Name,"") If File_Name = reStr Then IsvalidFileName=True Set re=Nothing End Function %>
[Ctrl+A 全部選擇 然后拷貝]

upload.asp // 上傳類

代碼拷貝框
<% Dim oUpFileStream Class Upload_File Dim Form,File,Err Private Sub Class_Initialize Err=-1 End Sub Private Sub Class_Terminate 'Clear Variables & Objects If Err < 0 Then oUpFileStream.Close Form.RemoveAll File.RemoveAll Set Form=Nothing Set File=Nothing Set oUpFileStream =Nothing End If End Sub Public Sub GetDate(RetSize) 'Define Variables Dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo Dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName Dim iFindStart,iFindEnd Dim iFormStart,iFormEnd,sFormName If Request.TotalBytes < 1 Then Err=1 Exit Sub End If If RetSize > 0 Then If Request.TotalBytes > RetSize Then Err=2 Exit Sub End If End If Set Form = Server.CreateObject("Scripting.Dictionary") Form.CompareMode = 1 Set File = Server.CreateObject("Scripting.Dictionary") File.CompareMode = 1 Set tStream = Server.CreateObject("Adodb.Stream") Set oUpFileStream = Server.CreateObject("Adodb.Stream") oUpFileStream.Type = 1 oUpFileStream.Mode = 3 oUpFileStream.Open oUpFileStream.Write Request.BinaryRead(Request.TotalBytes) oUpFileStream.Position=0 RequestBinDate = oUpFileStream.Read iFormEnd = oUpFileStream.Size bCrLf = chrB(13) & chrB(10) 'Get Seperators sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1) iStart = LenB (sStart) iFormStart = iStart+2 'Split Items Do iInfoEnd = InStrB(iFormStart,RequestBinDate,bCrLf & bCrLf)+3 tStream.Type = 1 tStream.Mode = 3 tStream.Open oUpFileStream.Position = iFormStart oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.Charset = "UTF-8" sInfo = tStream.ReadText 'Get form item name iFormStart = InStrB(iInfoEnd,RequestBinDate,sStart)-1 iFindStart = InStr(22,sInfo,"name=""",1)+6 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) 'If it's a file If InStr (45,sInfo,"filename=""",1) > 0 Then Set oFileInfo= new FileInfo 'Get File attributes iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1) oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\")) oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1) iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14 iFindEnd = InStr(iFindStart,sInfo,vbCr) oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart) oFileInfo.FileStart = iInfoEnd oFileInfo.FileSize = iFormStart -iInfoEnd -2 oFileInfo.FormName = sFormName file.add sFormName,oFileInfo Else 'If it's form item tStream.Close tStream.Type = 1 tStream.Mode = 3 tStream.Open oUpFileStream.Position = iInfoEnd oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2 tStream.Position = 0 tStream.Type = 2 tStream.Charset = "UTF-8" sFormvalue = tStream.ReadText If Form.Exists (sFormName) Then Form (sFormName) = Form (sFormName) & ", " & sFormValue Else Form.Add sFormName,sFormvalue End If End If tStream.Close iFormStart = iFormStart+iStart+2 'Exit at end of file Loop Until (iFormStart+2) = iFormEnd RequestBinDate="" Set tStream = Nothing End Sub End Class 'Get File Info Class FileInfo Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" FileType = "" FileExt = "" End Sub 'Save File Method Public Function SaveToFile(FullPath) Dim oFileStream,ErrorChar,i On Error Resume Next Set oFileStream=CreateObject("Adodb.Stream") oFileStream.Type=1 oFileStream.Mode=3 oFileStream.Open oUpFileStream.position=FileStart oUpFileStream.copyto oFileStream,FileSize oFileStream.SaveToFile FullPath,2 oFileStream.Close Set oFileStream=Nothing End Function 'Get File Content Public Function GetDate oUpFileStream.Position =FileStart GetDate=oUpFileStream.Read(FileSize) End Function End Class %>
[Ctrl+A 全部選擇 然后拷貝]

核心函數(shù)

Dim theInstalledObjects(17)
    theInstalledObjects(0) = "MSWC.AdRotator"
    theInstalledObjects(1) = "MSWC.BrowserType"
    theInstalledObjects(2) = "MSWC.NextLink"
    theInstalledObjects(3) = "MSWC.Tools"
    theInstalledObjects(4) = "MSWC.Status"
    theInstalledObjects(5) = "MSWC.Counters"
    theInstalledObjects(6) = "IISSample.ContentRotator"
    theInstalledObjects(7) = "IISSample.PageCounter"
    theInstalledObjects(8) = "MSWC.PermissionChecker"
    theInstalledObjects(9) = "Scripting.FileSystemObject"
    theInstalledObjects(10) = "adodb.connection"
    theInstalledObjects(11) = "SoftArtisans.FileUp"
    theInstalledObjects(12) = "SoftArtisans.FileManager"
    theInstalledObjects(13) = "JMail.SMTPMail"
    theInstalledObjects(14) = "CDONTS.NewMail"
    theInstalledObjects(15) = "Persits.MailSender"
    theInstalledObjects(16) = "LyfUpload.UploadFile"
    theInstalledObjects(17) = "Persits.Upload.1"
Dim fso
If  IsObjInstalled(theInstalledObjects(9)) Then
Set fso =Server.CreateObject("Scripting.FileSystemObject")
End If
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
'檢查組件版本
Public Function getver(Classstr)
 On Error Resume Next
 Dim xTestObj
 Set xTestObj = Server.CreateObject(Classstr)
 If Err Then
  getver=""
 else 
   getver=xTestObj.version
 end if
 Set xTestObj = Nothing
End Function
'效驗(yàn)名稱
Function IsvalidFileName(File_Name)
 IsvalidFileName = False
 Dim re,reStr
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 re.Pattern="[^_\.a-zA-Z\d]"
 reStr=re.Replace(File_Name,"")
 If File_Name = reStr Then IsvalidFileName=True
 Set re=Nothing
End Function
'文件寫入
Function writeto(xmlfloder,xmlfile,content,mode)
writeto=false
If Not IsObjInstalled(theInstalledObjects(9)) Then Exit Function
mode=killint(mode,0,0,2)
xmlfloder=server.mappath(xmlfloder)
Set fso =Server.CreateObject("Scripting.FileSystemObject")
 if not fso.folderexists(xmlfloder) Then
 fso.createfolder(xmlfloder)
 End If
xmlfile=replace(xmlfloder&"\","\\","\")&xmlfile
' response.write(warn_red(xmlfile))
Dim fsoxml
If fso.fileexists(xmlfile) And mode=1 Then '存在不寫
 Exit Function
elseIf fso.fileexists(xmlfile) And mode=2 Then '重寫
 Set fsoxml=fso.opentextfile(xmlfile,2)
 fsoxml.writeline(content)
 fsoxml.close
 writeto=true
ElseIf fso.fileexists(xmlfile) And mode=8 Then '追加
 Set fsoxml=fso.opentextfile(xmlfile,8)
 fsoxml.writeline(content)
 fsoxml.close
 writeto=true
ElseIf fso.fileexists(xmlfile) Then
 Set fsoxml=fso.opentextfile(xmlfile,2)'重寫
 fsoxml.writeline(content)
 fsoxml.close
 writeto=true
Else
 Set fsoxml=fso.createtextfile(xmlfile)'創(chuàng)建
 fsoxml.writeline(content)
 fsoxml.close
 writeto=true
End If
End Function
'刪除文件
Function delaspfile(x)
On Error Resume Next
 delaspfile=False
 If Not fileexitornot(x) Then
 Exit Function
 Else
 fso.deletefile server.mappath(x)
 delaspfile=True 
 End if
End Function
'文件存在
Function fileexitornot(file)
On Error Resume Next
Dim f_re_file
f_re_file=true
If not fso.fileexists(server.MapPath(file)) Then f_re_file=False
If err<>0 Then f_re_file=False 
fileexitornot=f_re_file
End Function

'錯(cuò)誤抑制,打印錯(cuò)誤
Function show_err(err)
On Error Resume Next
If err.Number <> 0 Then
Response.Clear
Dim err_mess
err_mess="<b>發(fā)生錯(cuò)誤:</b><br/>錯(cuò)誤 Number： "& err.Number&"<br/>錯(cuò)誤信息:"&err.Description&"<br/>出錯(cuò)文件："&err.Source&"<br/>出錯(cuò)行："&err.Line&"(不被支持)<br/>"& err
response.write(err_mess)
End if
End Function
'警告:
Function warn_red(mess)
warn_red="<font color=red><b>跟蹤:"&mess&"</b></font><br/>"
End Function

'FSO文件目錄
Function showallfile(path)
'On Error Resume Next
path=Replace(path,"http://","/")
set fso =  CreateObject("Scripting.FileSystemObject")
Dim uploadPath,uploadfolder,objSubFolders,allfiles,fileitem,objSubFolder,
sFileName
 If InStr(1,path,":\")=0 Then
 path=Replace(path,"\","/")
 uploadPath = server.mappath(path)
 Else
 path=Replace(path,"/","\")
 uploadPath=path
 End If
response.write(warn_red(uploadPath))
if not fso.folderexists(uploadPath) Then
response.write warn_red("路徑查找失敗")
Exit Function
End If
Set uploadfolder = fso.GetFolder(uploadPath)
If uploadfolder.isrootfolder Then
response.write("<b>根目錄</b><br/>")
Else
response.write("<b><font color=""#00008b"">父目錄:</font><a href=""default.asp?action=fso&this=top&path="&uploadfolder.parentfolder&""">
"&uploadfolder.parentfolder&" </a></b><br/>")

End If
response.write("<b>目錄大小:"&int(uploadfolder.size/1024)&" KB</b><br/>")
set objSubFolders=uploadfolder.Subfolders
Dim fso_mes
fso_mes="<ol>"
for each objSubFolder in objSubFolders
fso_mes=fso_mes& "<li><b><a href=""default.asp?action=fso&this=top&path="&path&"/"&objSubFolder.name&"""><font color=blue>" & objSubFolder.name & "</font></a></b></li>"
next
set allfiles = uploadfolder.Files
for each fileitem in allfiles
 fso_mes=fso_mes& "<li><a href=""default.asp?action=fso&this=file&path="&path&"/"&fileitem.Name&""">" & fileitem.Name & "</a></li>"
Next
fso_mes=fso_mes&"</ol>"
response.write(fso_mes)
response.write deltext(uploadPath,1)
End Function

'文件屬性
Function filepro(name)
name=Replace(name,"http://","/")
Dim whichfile
If InStr(1,name,":\")=0 Then
name=Replace(name,"\","/")
whichfile = server.mappath(name)
Else
name=Replace(name,"/","\")
whichfile=name
End If
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.fileexists(whichfile) Then
 response.write(warn_red("文件不存在或者無(wú)訪問(wèn)權(quán)限"))
 Exit Function
End If
Dim f2,s_mess
Set f2 = fso.GetFile(whichfile)
s_mess = "<div class=""admin_post_form""><b><font color=""#00008b"">父目錄:</font><a href=""default.asp?action=fso&this=top&path="&f2.parentfolder&""">"&f2.parentfolder&
"</a></b><br/>"
s_mess = s_mess & "文件名稱：" & f2.name & "<br>"
s_mess = s_mess & "文件短路徑名：" & f2.shortPath & "<br>"
s_mess = s_mess & "文件物理地址：" & f2.Path & "<br>"
s_mess = s_mess & "文件屬性：" & f2.Attributes & "<br>"
s_mess = s_mess & "文件大�。� " & f2.size & "<br>"
s_mess = s_mess & "文件類型： " & f2.type & "<br>"
s_mess = s_mess & "文件創(chuàng)建時(shí)間： " & f2.DateCreated & "<br>"
s_mess = s_mess & "最近訪問(wèn)時(shí)間: " & f2.DateLastAccessed & "<br>"
s_mess = s_mess & "最近修改時(shí)間: " & f2.DateLastModified&"<br/></div>"
response.write(s_mess)
If killint(Trim(request("type")),0,0,2)<>0 Then
showtext(whichfile)
End If
response.write deltext(whichfile,0)
End Function
'
SUB showtext(files)
 dim iStr,adosText,strasp
 set adosText=Server.CreateObject("ADODB.Stream")
 adosText.mode=3
 adosText.type=2
 adosText.charset="gb2312"
 'adosText.charset="big5"
 adosText.open
 If InStr(1,files,":\")=0 Then
 files=Replace(files,"\","/")
 files = server.mappath(files)
 Else
 files=Replace(files,"/","\")
 files=files
 End If
 adosText.loadFromFile (files)
 strasp=adosText.ReadText()
 adosText.close
 set adosText=nothing%>
<form method="post" class="admin_post_form" action="default.asp?action=fso&this=edit&mode=1">
 <textarea id="txt" name="txt" rows="15" cols="60"><%=Server.HTMLEncode(strasp)%></textarea>
<label> <input name="path" type="hidden" value="<%=Trim(request("path"))%>"/><input type="submit" name="okedit" class="submit" value="確定編輯"> </label>
</form>
<%End Sub
Function deltext(file,mode)
Dim deltext_mess
deltext_mess="<div class=""deltext"">"
Select Case killint(mode,0,0,2)
Case 0:
deltext_mess=deltext_mess&"文件操作:<a href=""default.asp?action=fso&this=file&path="&file&""">屬性</a><a  onclick=""{if(confirm('警告,非文本請(qǐng)不要讀取,否則文件無(wú)法讀取了,你堅(jiān)持點(diǎn)擊確定么?勸你點(diǎn)擊取消')){return true;} return false;}"" href=""default.asp?action=fso&this=file&path="&file&"&type=1""><font color=red><b>編輯</b></font></a><a href=""default.asp?action=fso&this=move&path="&file&""">移動(dòng)</a><a href=""default.asp?action=fso&this=copy&path="&file&"&mode=0"">復(fù)制</a><a href=""default.asp?action=fso&this=rename&path="&file&"&mode=0"">重命名</a><a  onclick=""{if(confirm('警告,刪除操作不能恢復(fù),小心使用!!!')){return true;} return false;}"" href=""default.asp?action=fso&this=del&path="&file&"&mode=0""><font color=red><b>刪除</b></font></a>"

Case 1:
deltext_mess=deltext_mess&"文件夾操作:<a href=""default.asp?action=fso&this=top&path="&file&""">列表</a><a href=""default.asp?action=fso&this=add&path="&file&"&ff=1"">創(chuàng)建目錄</a><a href=""default.asp?action=fso&this=add&path="&file&""">手建文件</a><a href=""default.asp?action=fso&this=up&path="&file&""">上傳文件</a><a href=""default.asp?action=fso&this=move&path="&file&"&mode=1"">移動(dòng)</a><a href=""default.asp?action=fso&this=copy&path="&file&"&mode=1"">復(fù)制</a><a href=""default.asp?action=fso&this=rename&path="&file&"&mode=1"">重命名</a><a  onclick=""{if(confirm('警告,刪除操作不能恢復(fù),以上列表的文件全部被刪除,你堅(jiān)持點(diǎn)擊確定么?勸你點(diǎn)擊取消')){return true;} return false;}"" href=""default.asp?action=fso&this=del&path="&file&"&mode=1""><font color=red><b>刪除</b></font></a>"

End Select
deltext_mess=deltext_mess&"</div>"
deltext=deltext_mess
End Function

出處：藍(lán)色理想
責(zé)任編輯：moby

◎進(jìn)入論壇網(wǎng)絡(luò)編程版塊參加討論