“小灰”的特辑灰”的专辑

复制代码 代码如下: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() Case”CompressData”‘压缩数据
Dimtmprs dimallarticle dimMaxid dimtopic,username,dateandtime,body
callCompressData() case”BackupData”‘备份数据
ifrequest(“act”)=”Backup”Then callupdata() else callBackupData() endIf
case”RestoreData”‘恢复数据 dimbackpath ifrequest(“act”)=”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”) dbpath=Server.MapPath(dbpath)
dbpath=dbpath&””&dbname
setfso=CreateObject(“Scripting.FileSystemObject”)
Iffso.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

相关文章

You can leave a response, or trackback from your own site.

Leave a Reply

网站地图xml地图