📄 clienteleupdate.asp
字号:
<!--#include file = include.asp-->
<!--#include file = CheckPurview.asp-->
<html>
<head>
<title>在线更新</title>
<style type="text/css">
<!--
body,td { font-size: 9pt;color:#848284}
a { color: #000000; text-decoration: none}
a:hover { text-decoration: underline}
-->
</style>
</head>
<%
'==========================================
'
' 渐飞在线更新系统
'
'
'
' 最后修改：2003-14-05 19：05：14
'==========================================
On Error Resume Next
adTypeBinary =1
adTypeText =2
UpdateNO=request("UpdateNO")
ClientHost=request("ClientHost")
num=request("UpID").count
for i=1 to Num
Url="http://www.xunt.net/OnLineUpdate/UpdateData.asp?upid="&request("Upid")(i)&"&ClientHost="&ClientHost&"&UpdateNO="&UpdateNO&""
'获得更新数据
Update=GetURL(URL)
Update=Bytes2bStr(Update)
Call CheckErr
'获得各个属性值
UpTitle=GetContent(Update,"UpTitle")
UpFileName=GetContent(Update,"UpFileName")
UpContent=GetContent(Update,"UpContent")
UpVerNo=GetContent(Update,"UpVerNo")
AllUpTitle=AllUpTitle&","&UpTitle
AllUpVerNo=AllUpVerNo&","&UpVerNo
UpFileDirectory=GetContent(Update,"UpFileDirectory")
Call UpdateFile(UpFileName,UpContent)
next
'检查是否有错误发生
SUb CheckErr()
If Err <> 0 Then
Response.Write "<font color=red size=2>有错误发生:</font>"&Err.Description
response.end
End If
End Sub
' 获取更新数据
Function GetURL(url)
Set Retrieval = Server.CreateObject("Msxml2.ServerXMLHTTP")
'Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "GET", url, False
.Send
GetURL = .responsebody
End With
Set Retrieval = Nothing
End Function
' 二进制转字符串
Function Bytes2bStr(vin)
Dim objStream,StringReturn
Set objStream = Server.CreateObject("ADODB.Stream")
With objStream
.Type = adTypeText
.Open
.WriteText vin
.Position = 0
.Charset = "GB2312"
.Position = 2
StringReturn = .ReadText
.close
End With
Set objStream = Nothing
Bytes2bStr = StringReturn
End Function
Sub UpdateFile(UpFileName,UpContent)
set FileObj=Server.CreateObject("Scripting.FileSystemObject")
if not FileObj.FolderExists(Server.MapPath(".")&"\"&UpFileDirectory) then
FileObj.CreateFolder(Server.MapPath(".")&"\"&UpFileDirectory)
end if
set CrFi=FileObj.CreateTextFile(Server.MapPath(".")&"\"&UpFileDirectory&UpFileName&"")
CrFi.WriteLine(UpContent)
End Sub
' 获取指定内容
Function GetContent(Content,upStr)
Dim StartPos,EndPos,Length,StartStr,EndStr
StartStr="["&upStr&"]"
EndStr="[/"&upStr&"]"
StartPos=Instr(1,Content,StartStr)
StartPos=StartPos+len(StartStr)
EndPos=Instr(StartPos,Content,EndStr)
Length=EndPos-StartPos
If Length <0 then
Err=Err+1
Err.Description="未找到标志符号:"&upStr
Else
GetContent=Mid(Content,StartPos,Length)
End If
End Function
'获得时间+随即数字
Function GetTimer()
randomize
ranNum=Int((899)*Rnd +100)
GetTimer=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum
End Function
%>
<body bgProperties=fixed leftMargin=0 topMargin=5 marginwidth="0" marginheight="0">
<table width="97%" border="0" align="center" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
<%
AllUpTitle=split(AllUpTitle,",")
AllUpVerNo=split(AllUpVerNo,",")
set FileObj=Server.CreateObject("Scripting.FileSystemObject")
set OpFile=FileObj.OpenTextFile(Server.MapPath(".")&"\UpdateLog.txt",8,true)
for i=1 to Ubound(AllUpTitle)
OpFile.WriteLine AllUpVerNo(i)
%>
<%=AllUpVerNo(i)%>：<%=AllUpTitle(i)%><br>
<div align="right">
<font color=green>该项目更新成功</font>
<hr size="1" color="#C0C0C0"></div>
<%
next
IF Ubound(AllUpTitle)<=0 then
%>
<div align="right">
<font color=red>请选择更新项目</font>
<hr size="1" color="#C0C0C0"></div>
<%end if%>
</table>
</body>
</html>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -