在线压缩Access数据库,ASP升级程序

复制代码 代码如下:html head
meta”Content-Language”content=”zh-cn”
meta”Content-Type”content=”text/html;charset=gb2312″
title数据库管理/title /head body divalign=center数据库管理类别/div br br
palign=”center” % DimZC_DATABASE_PATH ‘数据库的门路ZC_DATABASE_PATH=”database/data.mdb”
data_array=Split(ZC_DATABASE_PATH,”/”卡塔尔(قطر‎ Dimaction
action=trim(request(“action”卡塔尔国卡塔尔 Dimdbpath,bkfolder,bkdbname,fso,fso1
SelectCaseaction Case”” Callchushihua(State of Qatar Case”CompressData”‘压缩数量
Dimtmprs dimallarticle dimMaxid dimtopic,username,dateandtime,body
callCompressData(State of Qatar case”BackupData”‘备份数据
ifrequest(“act”State of Qatar=”Backup”Then callupdata(卡塔尔(قطر‎ else callBackupData(卡塔尔国 endIf
case”RestoreData”‘苏醒数据 dimbackpath ifrequest(“act”State of Qatar=”Restore”Then
Dbpath=request.form(“Dbpath”卡塔尔 backpath=request.form(“backpath”)ifdbpath=””Then response.write”PleaseinputyourdatabasewholeName” else
Dbpath=server.mappath(Dbpath卡塔尔(قطر‎ endIf backpath=server.mappath(backpath卡塔尔国SetFso=server.CreateObject(“scripting.filesystemobject”卡塔尔iffso.fileexists(dbpath卡塔尔Then fso.copyfileDbpath,Backpath
response.write”数据库被成功还原!br” else
response.write”没找到您所急需的数据库!” endIf else callRestoreData(卡塔尔(قطر‎endIf Case”SpaceSize”‘系统空间占领 callSpaceSize(卡塔尔(قطر‎ Case”deletebackup”
Dimdbname dbpath=Request.QueryString(“dbpath”卡塔尔国dbname=Request.QueryString(“dbname”State of Qatar dbpath=Server.MapPath(dbpath卡塔尔(قطر‎dbpath=dbpath&””&dbname
setfso=CreateObject(“Scripting.FileSystemObject”State of QatarIffso.FileExists(dbPath卡塔尔国Then fso.DeleteFile(DBPath卡塔尔 Setfso=nothing
response.write”br您备份的数据库已经”&dbpath&”被成功删除!brbrahref=””data_s.asp””重返../a”
Else response.writedbpath
response.write”br输入的不二法门错误,请确认后再也输入!brbrahref=””data_s.asp””返回../a”
EndIf CaseElse EndSelect % /div % response.write”/body/html”
Subchushihua() % divalign=center form br/
ahref=”?action=CompressData”[减去数据库]/a
br/br/ahref=”?action=BackupData”[备份数据库]/a
br/br/ahref=”?action=RestoreData”[光复数据库]/a
br/br/ahref=”?action=SpaceSize”[系统空间并吞]/a br/br/ /form /div
%endsub% % ‘====================系统空间吞噬=======================
SubSpaceSize(卡塔尔国 OnErrorResumeNext % divalign=center divalign=center
系统空间查看 br/br/ form br
数据库:%showSpaceinfo(“../”&data_array(1卡塔尔&””卡塔尔国%brbr
备份数据库:%showSpaceinfo(“databackup”卡塔尔%brbr
系统一共:%showSpaceinfo(“/”卡塔尔(قطر‎% brbr /form /div br br br
ahref=”data_s.asp”返回…/a /div % EndSub % %SubShowSpaceInfo(drvpath)
dimfso,d,size,showsize
setfso=server.CreateObject(“scripting.filesystemobject”)
drvpath=server.mappath(drvpath) setd=fso.getfolder(drvpath) size=d.size
showsize=size&”Byte” ifsize1024Then size=(Size/1024) showsize=size&”KB”
endIf ifsize1024Then size=(size/1024) showsize=formatnumber(size,2)&”MB”
endIf ifsize1024Then size=(size/1024) showsize=formatnumber(size,2)&”GB”
endIf response.write”fontface=verdana”&showsize&”/font” EndSub % %
SubRestoreData() % divalign=center divalign=center br/…

来源:”小小灰 “小灰”的专辑灰”的专栏
地址:

While working on BuildDB/Buildapp online Demo, I developed a little function 
that will compact Access databases over the web. Here`s a “no-frills” page 
that`ll compact the databases for you. 
One problem with Access databases is that “holes” are created when records are 
deleted, making the database fluffy and bloated. Compacting the database makes 
it lean and efficient again.

<%
‘文件名:updata.asp
‘远程地址
const url=””

Note: This function/page can easily be combined with the Buildapp front end 
file navigation and search pages (Installment II), to create an application 
that`ll make it easy to handle this formerly troublesome chore for all the 
databases on your machine/web site.. 

action=request(“action”)
if action=”updata” then
 download(url&”config.txt”)
 download(url&”pack.jpg”)
 response.Write(“下载成功<a
href=’updata.asp?action=install’>安装</a>”卡塔尔(قطر‎
elseif action=”install” then
 str=openfile(“config.txt”)
 if str=”” then
  response.write “贫乏当地配置文件config.txt”
 else
  size=RegExpTest(“size”,str)
  call install(“pack.jpg”,size)
 end if
else
 str=getpage(url&”config.txt”)
 if str=”” then
  response.write “不设有可用更新或然地点配置不科学”
  response.end
 end if

++++++++++++ Begin Compact.asp +++++++++++++++++++++++++++++
<%
option explicit
Const JET_3X = 4

 str1=openfile(“config.txt”)
 if str1=”” then
  response.write
“缺少本地配置文件config.txt不能获悉当地程序的安装时间”
  response.end
 end if

Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath
strDBPath = left(dbPath,instrrev(DBPath,””))
Set fso = CreateObject(“Scripting.FileSystemObject”)

 updatatime=RegExpTest(“time”,str)
 updatatime1=RegExpTest(“time”,str1)

If fso.FileExists(dbPath) Then
Set Engine = CreateObject(“JRO.JetEngine”)

 if DateDiff(“d”,updatatime1,updatatime)>0 then
  response.Write(“存在可用更新,更新日期:”&updatatime&”<a
href=’updata.asp?action=updata’>下载</a>”卡塔尔
 else
  response.write “您的程序是风尚的了”
 end if
end if

If boolIs97 = “True” Then
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;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 = “Your database, ” & dbpath & “, has been Compacted” & vbCrLf
Else
CompactDB = “The database name or path has not been found. Try Again” & vbCrLf
End If

function openfile(filename)
set fso=server.CreateObject(“scripting.filesystemobject”)
if fso.fileexists(server.MapPath(filename)) then
 set f1=fso.opentextfile(server.mappath(filename),1,true)
 openfile=f1.readall
 f1.close
else
 openfile=””
end if
set fso=nothing
end function

End Function
%>
<html><head><title>Compact Database</title></head><body>

function getpage(url)
set
xmlhttp=server.createobject(“Microsoft.XMLHTTP”)
xmlhttp.open “get”,url,false
xmlhttp.send
if xmlhttp.status<>200 then
 getpage=””
else
 getpage=bytes2BSTR(xmlhttp.ResponseBody)
end if
end function

<h2 align=”center”> Compacting an Access database</h2>
<p align=”center”>
<form action=compact.asp>
Enter relative path to the database, including database name.<br><br>
<input type=”text” name=”dbpath”><br><br>
<input type=”checkbox” name=”boolIs97″ value=”True”> Check if Access 97 database
<br><i> (default is Access 2000)</i><br><br>
<input type=”submit”>
<form>
<br><br>
<%
Dim dbpath,boolIs97
dbpath = request(“dbpath”)
boolIs97 = request(“boolIs97”)

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

If dbpath <> “” Then
dbpath = server.mappath(dbpath)
response.write(CompactDB(dbpath,boolIs97))
End If
%>
</p></body></html>

Function RegExpTest(patrn,strng)
Dim regEx,Match,Matches’创设变量。
Set regEx = New RegExp’建设结构正则表明式。
regEx.Pattern = patrn&”=(.+?卡塔尔/n”‘设置形式。
regEx.IgnoreCase = True’设置是还是不是区分字符大小写。
regEx.Global = True’设置全局可用性。
Set Matches = regEx.Execute(strng卡塔尔(قطر‎’实行找寻。
For Each Match in Matches’遍历匹配集合。
RetStr = Match.Value
Next
RegExpTest = replace(RetStr,patrn&”=”,””)
End Function

++++++++++++ End Code 

function download(url)
 temp=split(url,”/”)
 filename=temp(ubound(temp))
 set
xmlhttp=server.createobject(“Microsoft.XMLHTTP”)
 xmlhttp.open “get”,url,false
 xmlhttp.send
 if xmlhttp.status<>200 then
  download=””
 else
  set fso=server.createobject(“scripting.filesystemobject”)
  if fso.fileexists(server.mappath(filename)) then
   fso.deletefile(server.mappath(filename))
  end if
  set fso=nothing
  img=xmlhttp.ResponseBody
  set objAdostream=server.createobject(“ADODB.Stream”)
  objAdostream.Open
  objAdostream.type=1
  objAdostream.Write(img)
  objAdostream.SaveToFile(server.mappath(filename))
  objAdostream.SetEOS
  set objAdostream=nothing
  download=filename
 end if
 set xmlhttp=nothing
end function

function install(filename,size)
on error resume next
path=server.mappath(“./”)

set fso=server.createobject(“scripting.filesystemobject”)

set s=server.createobject(“adodb.stream”)
set s1=server.createobject(“adodb.stream”)
set s2=server.createobject(“adodb.stream”)

s.open
s1.open
s2.open

s.type=1
s1.type=1
s2.type=1

s.loadfromfile(server.mappath(filename))
s.position=size
s1.write(s.read)
s1.position=0
s1.type=2
s1.charset=”gb2312″
s1.position=0
a=split(s1.readtext,vbcrlf)
s.position=0

i=0
while(i<ubound(a))
 b=split(a(i),”>”)
 if b(0)=”folder” then
  if not fso.folderexists(path&b(2)) then
   fso.createfolder(path&b(2))
  end if
 elseif b(0)=”file” then
  if fso.fileexists(path&b(2)) then
   fso.deletefile(path&b(2))
  end if
  s2.position=0
  s2.write(s.read(b(1)))
  s2.seteos
  s2.savetofile(path&b(2))
 end if
 i=i+1
wend

s.close
s1.close
s2.close
set s=nothing
set s1=nothing
set s2=nothing
set fso=nothing
if err.number<>0 then
 response.write err.description
else
 response.write “安装成功”
end if
end function

%>


<%
‘文件名称:pack.asp
on error resume next
set fso=server.createobject(“scripting.filesystemobject”)
if fso.fileexists(server.mappath(“./pack.jpg”)) then
 response.Write(“pack.jpg已经存在”卡塔尔(قطر‎
 response.End()
end if

dim str,s,s1,s2
set s=server.createobject(“ADODB.Stream”)
set s1=server.createobject(“ADODB.Stream”)
set s2=server.createobject(“ADODB.Stream”)

s.Open
s1.Open
s2.Open

s.Type=1
s1.type=1
s2.Type=2

call WriteFile(server.MapPath(“./”))

s2.charset=”gb2312″
s2.WriteText(str)
s2.Position=0
s2.type=1
s2.Position=0
bin=s2.Read

s2.Position=0
s2.type=2
s2.writeText(“time=”&now&vbcrlf)
s2.writeText(“size=”&s1.size&vbcrlf)
s2.writeText(“run=”&request.Form(“run”)&vbcrlf)
s2.seteos
s2.savetofile(server.mappath(“./config.txt”))

s1.write(bin)
s1.SetEOS
s1.SaveToFile(server.mappath(“./pack.jpg”))

s.close
s1.close
s2.close

set s=nothing
set s1=nothing
set s2=nothing

if err.number<>0 then
 response.write err.description
else
 response.Write(“完成”)
end if

Function WriteFile(folderspec)
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set f = fso.GetFolder(folderspec)

Set fc = f.Files
For Each f1 in fc
 if f1.name<>”pack.asp” then
  str=str&”file>”&f1.size&”>”&replace(folderspec&”/”&f1.name,server.MapPath(“./”),””)&vbcrlf
  s.LoadFromFile(folderspec&”/”&f1.name)
  img=s.Read()
  s1.Write(img)
 end if
Next

Set fc = f.SubFolders
For Each f1 in fc
  str=str&”folder>0>”&replace(folderspec&”/”&f1.name,server.MapPath(“./”),””)&vbcrlf
  WriteFile(folderspec&”/”&f1.name)
Next

set fso=nothing
End Function
%>


ASP升级程序行使验证

本程序分两部分:
1、ASP文件打包程序pack.asp
 把那几个程序和要打包的程序嵌入三个索引下,然后运转pack.asp,获得pack.jpg和config.txt
2、ASP在线更新、下载、安装程序updata.asp
 那个顺序能够用来检查是还是不是留存可用更新,和updata.asp同一目录要留存上边获得的config.txt,因为config里面有日前程序的设置日期,用来和网上的顺序相比较用的。
 使用前,先校订updata.asp里的url变量的值,使其相当于你寄存进级程序的UEscortL,运营updata.asp就可查阅是不是留存可用更新,如若存在就可用按着向导一步一步下载并安装更新了。

长途地址url下边贮存用pack.asp获得的pack.jpg和config.txt

本程序不仅能够用来做提高程序,当然假设原先安装目录下是空的,那正是一个完完全全的安装程序,^_^,也足以把updata.asp放到后台的首页里,那样每一趟登录都能够自动物检疫查是或不是有可用更新

小心:本地或许远程未有config.txt会招致程序不可用,以往会伪造参与那一个容错机制。

作者新闻:
QQ:103895
主页: 
 http://asp2004.net
版权证明:本程序能够随便拷贝使用,但请不要删除此音信。感谢!

发表评论

电子邮件地址不会被公开。 必填项已用*标注