fso读写操作。XMLHTTP对象及其方法。巧用xmlHttp生成静态页面_et xtestobj = createobject(strclassstring)-CSDN博客

本文链接：https://blog.csdn.net/hljqfl/article/details/86224309

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值为４说明载入完毕

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">

</textarea>
</form>
再配合FSO写文件来生成静态首页，但这种方法需要人为每次去点，不方便多用户的操作，现在用这个方法，就比较快了