fso读写操作
对于一个支持asp和fso的空间来说有了fso一切变得简单多了
我也是个新手写了一些代码供大家学习研究用
首先看支持fso组件吗
<%
’FSO组件名称
dim FSObject
FSObject="Scripting.FileSystemObject"
’=========================================================
’◆是否支持组件
’=========================================================
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
if IsObjInstalled(FSObject) then
response.write "√"
else
response.write "×"
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
’=========================================================
’fso 操作
’=========================================================
’◆检查某一目录是否存在
’=========================================================
Function CheckDir(FolderPath)
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso= CreateObject(FSObject)
If fso.FolderExists(FolderPath) then
CheckDir = True
Else
CheckDir = False
End if
Set fso= nothing
End Function
’=========================================================
’◆ 根据指定名称生成目录
’=========================================================
Function MakeNewsDir(foldername)
dim fs0
Set fso= CreateObject(FSObject)
Set fs0= fso.CreateFolder(foldername)
Set fso = nothing
End Function
’=========================================================
’◆ 如果文件夹不存在则建立新文件夹 ◆
’=========================================================
Function checkFolder(folderpath)
If CheckDir(folderpath) = false Then’如果文件夹不存在
MakeNewsDir(folderpath)’就建一个文件夹
end if
end Function
’=========================================================
’◆ 删除文件夹 ◆
’=========================================================
Function DeleteFoldera(folderpath)
dim path
Set fso = CreateObject(FSObject)
path=request.ServerVariables("APPL_PHYSICAL_PATH")&folderpath
fso.DeleteFolder(path)
Set fso = nothing
end Function
’=========================================================
’◆ 更改文件夹名称 ◆
’=========================================================
Function moveFolder(foldername,newfoldername)
isfso
Set fso = CreateObject(FSObject)
fso.moveFolder ""&request.ServerVariables("APPL_PHYSICAL_PATH")&"\"&foldername&"" ,""&request.ServerVariables("APPL_PHYSICAL_PATH")&"\"&newfoldername&""
Set fso =nothing
End Function
’=========================================================
’◆ 删除指定文件 ◆
’=========================================================
Function DeleteFile(file)
Set fso = CreateObject(FSObject)
fso.DeleteFile request.ServerVariables("APPL_PHYSICAL_PATH")&file
Set fso = nothing
End Function
’=========================================================
’◆ 备份指定文件 ◆
’=========================================================
Function CopyFile(oldfile,newfile)
Set fso = CreateObject(FSObject)
On Error Resume Next
Set fso=Server.CreateObject(FSObject)
oldfile=Server.MapPath(oldfile)
if Err.Number>0 Then call alert("原路径错误!","")
newfile=Server.MapPath(newfile)
if Err.Number>0 Then call alert("新路径错误!","")
fso.CopyFile oldfile,newfile’覆盖原来的文件
if Err.Number>0 Then call alert(Err.Description,"")
Set fso=nothing
End Function
’=========================================================
’◆ 转移指定文件 ◆
’=========================================================
Function MoveFile(oldfile,newfile)
Set fso = CreateObject(FSObject)
On Error Resume Next
Set fso=Server.CreateObject(FSObject)
oldfile=Server.MapPath(oldfile)
if Err.Number>0 Then call alert("原路径错误!","")
newfile=Server.MapPath(newfile)
if Err.Number>0 Then call alert("新路径错误!","")
’fso.MoveFile oldfile,newfile’不能覆盖原来的文件
fso.MoveFile "d:\o\data\test.txt","d:\o\databackup\test3.txt"
if Err.Number>0 Then call alert(Err.Description,"")
Set fso=nothing
End Function
’=========================================================
’◆ 读取文件代码 ◆
’=========================================================
Function loadfile(file)’读取文件
dim ftemp
Set fso = CreateObject(FSObject)
Set ftemp=fso.OpenTextFile(Server.MapPath(""&file&""), 1)
loadfile=ftemp.ReadAll
ftemp.Close
fso.close
set fso=nothing
End Function
’=========================================================
’◆ 根据代码生成文件 ◆
’=========================================================
’========================================
’■file生成文件名
’■code文件的代码
’========================================
Function savefile(file,code)’保存文件
dim MyFile
Set fso = CreateObject(FSObject)
Set MyFile = fso.CreateTextFile(Server.mapPath(file), True)
MyFile.WriteLine(code)
MyFile.Close
set MyFile=nothing
End Function
’=========================================================
’ 压缩数据库
’=========================================================
’========================================
’dbPath数据文件路径
’boolIs97 access97压缩
’========================================
Function CompactDB(dbPath,boolIs97)
dim strDBPath,fso,Engine
dbPath=server.mappath(dbpath)
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject(FSObject)
If fso.FileExists(dbPath) Then
Set Engine = CreateObject("JRO.JetEngine")
If boolIs97 = "True" Then
dim JET_3X
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb;" _
&"Jet OLEDB:Engine Type=" & JET_3X
Else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
"Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database password="&dbpw&";Data Source="&strDBPath&"temp.mdb"
End If
fso.CopyFile strDBPath & "temp.mdb",dbpath
fso.DeleteFile(strDBPath&"temp.mdb")
Set fso = nothing
Set Engine = nothing
CompactDB="当前数据库,已经压缩成功!"
Else
CompactDB="数据库名称或路径不正确. 请重试!"
End If
End Function
%>
======================================================================
XMLHTTP对象及其方法
XMLHTTP对象及其方法:
创建XMLHTTP对象的语句如下:
Set objXML = CreateObject("Msxml2.XMLHTTP")
或
Set objXML = CreateObject(“Microsoft.XMLHTTP”)
其中Set objXML = CreateObject("Msxml2.XMLHTTP")是最新的版本
对象创建后调用Open方法对Request对象进行初始化,语法格式为:
poster.open http-method, url, async, userID, password
Open方法中包含了5个参数,前三个是必要的,后两个是可选的(在服务器需要进行身份验证时提供)。
参数的含义如下所示:
http-method: HTTP的通信方式,比如GET或是 POST
url: 接收XML数据的服务器的URL地址。通常在URL中要指明ASP或CGI程序
async: 一个布尔标识,说明请求是否为异步的。如果是异步通信方式(true),客户机就不等待服务器的响应;如果是同步方式(false),客户机就要等到服务器返回消息后才去执行其他操作
userID:用户ID,用于服务器身份验证
password:用户密码,用于服务器身份验证
比如,我们要调用百度的网页,我们可以:
dim Http
set Http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET","http://www.baidu.com",false
Http.send()
Send方法是用来发送XML数据的,用法如下:
poster.send()
如果不用send来发参数,而你要调用的网页又要接收参数,可以这样简单处理
dim Http
set Http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET","http://要调用的网页?id=1&name=abc",false
Http.send()
Http.send()以后,xmlhttp对象会返回一个对象,这个对象里面就包含了所调用网页的内容,就象从浏览器里打开一样,只不过网页内容是在内存中,还没有显示出来。但在调用过程中可能会出错,所以XMLHTTP对象中的readyState属性能够反映出服务器在处理请求时的进展状况。
0 Response对象已经创建,但XML文档上载过程尚未结束
1 XML文档已经装载完毕
2 XML文档已经装载完毕,正在处理中
3 部分XML文档已经解析
4 文档已经解析完毕,客户端可以接受返回消息
所以我们一般这样处理:
dim Http
set Http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET","http://要调用的网页?id=1&name=abc",false
Http.send()
'检查是否完成,readystate值为4说明载入完毕
if Http.readystate<>4 then
exit function
end if
Http.send()后,经检测Http.readystate==4,说明载入完毕,这时网页内容已经载入到了Http.responseBody中了 ,但是如果是中文网页,Http.responseBody中会有乱码,这需要我们转换一下乱码 ,所以完整的调用是这样的:
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET","你要调用的网址",false
Http.send()
if Http.readystate<>4 then '如果不等于4,说明出错了
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
其中,bytesToBSTR是一个自己写的函数
Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
所以,getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")表示,将Http.responseBody的内容按GB2312编码转换一下,放到getHTTPPage变量中。
最后,你再对getHTTPPage变量进行分析,取出你想显示的数据就行了。
需要注意的是,BytesToBstr函数中用到了adodb.stream组件,这需要你的服务器有执行它的权限。
下面我们讲个实例,我们显示一下新浪的新闻。要想显示新浪的新闻,我们就要先找到新浪的新闻网址是什么。新浪有个动态新闻页网址:http://news.sina.com.cn/old1000/news1000_日期.shtml 。比如,我们要显示6月18日的新闻,就输入
http://news.sina.com.cn/old1000/news1000_20050618.shtml ,打开网页你会发现是一个新闻列表,下面我们就要分析一下它的结构,右键查看源代码。里面很乱,但你可以找到<!--新闻开始-->和<!--新闻结束-->,中间的内容就是列表的内容。好了,也就是我说,我们想显示6月18号的新闻,就这样调用:
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET","http://news.sina.com.cn/old1000/news1000_20050618.shtml",false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
start=Instr(wstr,"<!--新闻开始-->")
over=Instr(wstr,"<!--新闻结束-->")
wstr=mid(wstr,start+11,over-start-11)
这样wstr就是新闻列表的内容。为什么start+11和over-start-11呢?因为<!--新闻开始-->和<!--新闻结束-->都是11的长度。wstr取出来后,还要进行分析,把它的网址链接替换成你的链接,把不必要的字符过滤掉,这个工作很烦琐,你可以用replace或者用正则表达式来替换,比如:
wstr=replace(wstr,"href=""","href=""show.asp?url=")
wstr=replace(wstr,"<ul>","")
wstr=trim(replace(wstr,"</ul>","")) '完成对页面内容的截取加工
wstr=Replace(wstr,"http://news.sina.com.cn","NewsNews")
wstr=Replace(wstr,"http://tech.sina.com.cn","TechNews")
wstr=Replace(wstr,"http://sports.sina.com.cn","SportsNews")
wstr=Replace(wstr,"http://ent.sina.com.cn","EntNews")
wstr=Replace(wstr,"http://eladies.sina.com.cn","EladiesNews")
wstr=Replace(wstr,"http://jczs.sina.com.cn","jczs")
wstr=Replace(wstr,"http://auto.sina.com.cn","AutoNews")
wstr=Replace(wstr,"http://finance.sina.com.cn","FinanceNews")
wstr=Replace(wstr,"http://www.eladies.com.cn","wwwEladies
====================================================================================
巧用xmlHttp生成静态页面
巧用xmlHttp生成静态页面(比include或模板方法都好)
<%
'用途:将指定内容,写入文本文件
'参数:filepath(包含路径的文件名,支持虚拟路径),fileContent(文件内容)
'示例:WriteFile "/abc.txt","abcde" 或WriteFile "c:\abc.txt","abcde"
'编写:杨俊明 2006-2-8 13:10 QQ:278919507 Email:yjmyzz@126.com
function WriteFile(filepath,fileContent)
if instr(filepath,"/") then filepath = server.mappath(filepath)
set t_fso = Server.CreateObject("scripting.FileSystemObject")
set t_keyFile = t_fso.CreateTextFile(filepath, true)
t_keyFile.WriteLine(fileContent)
t_keyFile.Close
set t_keyfile = nothing
set t_fso = nothing
end function
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function
Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
call WriteFile("/cppnews/index.htm",getHTTPPage("http://localhost:82/cppnews/index.asp"))'生成静态页面
%>
以前一直用
<form>
<textarea name="textarea">
<!--#include file=../index.asp-->
</textarea>
</form>
再配合FSO写文件来生成静态首页,但这种方法需要人为每次去点,不方便多用户的操作,现在用这个方法,就比较快了