FSO操作文件系统_网页制作_学习笔记★闵涛★计算机学习电脑编程软硬件技巧


	转至繁体中文版	\| 网站首页 \| 图文教程 \| 资源下载 \| 站长博客 \| 图片素材 \| 武汉seo \| 武汉网站优化 \|

FSO操作文件系统

作者：闵涛文章来源：闵涛的学习笔记点击数：1824 更新时间：2009/4/23 14:19:17

"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
'效验名称
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)'创建
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

'错误抑制,打印错误
Function show_err(err)
On Error Resume Next
If err.Number <> 0 Then
Response.Clear
Dim err_mess
err_mess="发生错误: 错误 Number： "& err.Number&" 错误信息:"&err.Description&" 出错文件："&err.Source&" 出错行："&err.Line&"(不被支持) "& err
response.write(err_mess)
End if
End Function
'警告:
Function warn_red(mess)
warn_red="跟踪:"&mess&" "
End Function

'FSO文件目录
Function showallfile(path)
'On Error Resume Next
path=Replace(path,"//","/")
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("根目录 ")
Else
response.write("父目录:<a href=""default.asp?action=fso&this=top&path="&uploadfolder.parentfolder&""">
"&uploadfolder.parentfolder&" </a> ")

End If
response.write("目录大小:"&int(uploadfolder.size/1024)&" KB ")
set objSubFolders=uploadfolder.Subfolders
Dim fso_mes
fso_mes="<ol>"
for each objSubFolder in objSubFolders
fso_mes=fso_mes& "<li><a href=""default.asp?action=fso&this=top&path="&path&"/"&objSubFolder.name&""">" & objSubFolder.name & "</a></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,"//","/")
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("文件不存在或者无访问权限"))
Exit Function
End If
Dim f2,s_mess
Set f2 = fso.GetFile(whichfile)
s_mess = "<div class=""admin_post_form"">父目录:<a href=""default.asp?action=fso&this=top&path="&f2.parentfolder&""">"&f2.parentfolder&
"</a> "
s_mess = s_mess & "文件名称：" & f2.name & " "
s_mess = s_mess & "文件短路径名：" & f2.shortPath & " "
s_mess = s_mess & "文件物理地址：" & f2.Path & " "
s_mess = s_mess & "文件属性：" & f2.Attributes & " "
s_mess = s_mess & "文件大小： " & f2.size & " "
s_mess = s_mess & "文件类型： " & f2.type & " "
s_mess = s_mess & "文件创建时间： " & f2.DateCreated & " "
s_mess = s_mess & "最近访问时间: " & f2.DateLastAccessed & " "
s_mess = s_mess & "最近修改时间: " & f2.DateLastModified&" </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('警告,非文本请不要读取,否则文件无法读取了,你坚持点击确定么?劝你点击取消')){return true;} return false;}"" href=""default.asp?action=fso&this=file&path="&file&"&type=1"">编辑</a><a href=""default.asp?action=fso&this=move&path="&file&""">移动</a><a href=""default.asp?action=fso&this=copy&path="&file&"&mode=0"">复制</a><a href=""default.asp?action=fso&this=rename&path="&file&"&mode=0"">重命名</a><a onclick=""{if(confirm('警告,删除操作不能恢复,小心使用!!!')){return true;} return false;}"" href=""default.asp?action=fso&this=del&path="&file&"&mode=0"">删除</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"">创建目录</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"">移动</a><a href=""default.asp?action=fso&this=copy&path="&file&"&mode=1"">复制</a><a href=""default.asp?action=fso&this=rename&path="&file&"&mode=1"">重命名<

上一页 [1] [2] [3] 下一页

没有相关教程

教程录入：mintao 责任编辑：mintao

上一篇教程： ObjectDataSourc控件

下一篇教程：深入浅出之正则表达式

【字体：小大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】

注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网]

　网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！）

同类栏目

· Web开发  · 网页制作
· 平面设计  · 网站运营
· 网站推广  · 搜索优化
· 建站心得  · 站长故事
· 互联动态

热门推荐

没有教程

赞助链接

闵涛博文

500 - 内部服务器错误。

您查找的资源存在问题，因而无法显示。

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18

闵涛站盟:医药大全-武穴网。A打造B、C、D……