FSO操作文件系统

时间:2007-03-07 16:19:39   来源:  作者:  点击:次  出处:技术无忧
关键字:目录列表 FSO FTP

核心函数 


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 
’效验名称 
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="<b>发生错误:</b><br/>错误 Number: "& err.Number&"<br/>错误信息:"&err.Description&"<br/>出错文件:"&err.Source&"<br/>出错行:"&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  



文章评论

共有 0 位网友发表了评论 此处只显示部分留言 点击查看完整评论页面