db_compact.asp

zheng fu wang zhan gong neng qi quan

		bkfolder=request.form("bkfolder")
		bkdbname=request.form("bkdbname")
		spl= split(bkdbname,".") 
		filetype = spl(ubound(spl))
                if filetype="asp" or filetype="asa" or filetype="aspx" or filetype="cer" or filetype="cdx" then
		  response.write"<p><CENTER><font color=red>请不要备份为带非法后辍名的文件</font></CENTER><p>"
		else
		Set Fso=server.createobject("scripting.filesystemobject")
		if fso.fileexists(dbpath) then
			If CheckDir(bkfolder) = True Then
				fso.copyfile dbpath,bkfolder& "\"& bkdbname
			else
				MakeNewsDir bkfolder
				fso.copyfile dbpath,bkfolder& "\"& bkdbname
			end if
			response.write "<br><div align=center><font color=#FF0000>备份数据库成功，您备份的数据库路径为" &bkfolder& "\"& bkdbname & "</font> </div>"
		Else
			response.write "<br><div align=center><font color=#FF0000>找不到您所需要备份的文件。</font> </div>"
		End if
		End if
end sub
'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
	folderpath=Server.MapPath(".")&"\"&folderpath
    Set fso1 = CreateObject("Scripting.FileSystemObject")
    If fso1.FolderExists(FolderPath) then
       '存在
       CheckDir = True
    Else
       '不存在
       CheckDir = False
    End if
    Set fso1 = nothing
End Function
'-------------根据指定名称生成目录-----------------------
Function MakeNewsDir(foldername)
	dim f
    Set fso1 = CreateObject("Scripting.FileSystemObject")
        Set f = fso1.CreateFolder(foldername)
        MakeNewsDir = True
    Set fso1 = nothing
End Function


'====================压缩数据库 =========================
sub CompressData()

If IsSqlDataBase = 1 Then
	SQLUserReadme()
	Exit Sub
End If
%>
<table cellpadding="0" cellspacing="0" border="1" width="100%" style="border-collapse: collapse" bordercolor="#FFDFBF" width="100%" id="AutoNumber1">
<form action="<%=ThisNameFile%>?action=CompressData" method="post">
<tr class="TDtop"> 
	<td height=25 align="center" class="forumrow"><b>数据库在线压缩</b></td>
</tr>
<tr> 
	<td height=25 align="center" class="forumrow"><b>注意：</b> 输入数据库所在相对路径,并且输入数据库名称（正在使用中数据库不能压缩，请选择备份数据库进行压缩操作）</td>
</tr>
<tr> 
	<td height="25" align="center" class="forumrow"><font color="#FF6600"><b>注意：</b></font><font color="#FF0000">压缩前，强烈建议先备份数据库，以免发生意外错误！</font></td>
</tr>
<tr> 
	<td height="25" align="center" class="forumrow">压缩数据库：<input name="dbpath" type="text" value=<%=db%> size="40"></td>
</tr>
<tr> 
	<td height="25" align="center" class="forumrow"><input type="checkbox" name="boolIs97" value="True">如果使用 Access 97 数据库请选择 (默认为 Access 2000 数据库)</td>
</tr>
<tr>
	<td height="30" align="center" class="forumrow"><input type="submit" value=" &nbsp;开始压缩&nbsp;" <%If ObjInstalled=false Then response.Write "disabled"%> style="cursor: hand;background-color: #cccccc;"></td>
</tr>
<%
	If ObjInstalled=false Then
		Response.Write "<tr align=center><td height=30 colspan=3> <div align=center><b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 不能使用本功能</font></b> </div></td></tr>"
	end if
%>
</form>
</table>
<%
dim dbpath,boolIs97
dbpath = request("dbpath")
boolIs97 = request("boolIs97")

If dbpath <> "" Then
dbpath = server.mappath(dbpath)
	response.write(CompactDB(dbpath,boolIs97))
End If

end sub

'=====================压缩参数=========================
Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath,JET_3X
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(dbPath) Then
	fso.CopyFile dbpath,strDBPath & "temp.mdb"
	Set Engine = CreateObject("JRO.JetEngine")

	If boolIs97 = "True" Then
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
		"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb;" _
		& "Jet OLEDB:Engine Type=" & JET_3X
	Else
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
		"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb"
	End If

fso.CopyFile strDBPath & "temp1.mdb",dbpath
fso.DeleteFile(strDBPath & "temp.mdb")
fso.DeleteFile(strDBPath & "temp1.mdb")
Set fso = nothing
Set Engine = nothing

	CompactDB = "<br><div align=center><font color=#FF0000>你的数据库: " & dbpath & "  已经压缩成功!</font> </div>" & vbCrLf

Else
	CompactDB = "<br><div align=center><font color=#FF0000>数据库名称或路径不正确. 请重试!</font> </div>" & vbCrLf
End If

End Function


'=====================系统空间参数=========================
	Sub ShowSpaceInfo(drvpath)
 		dim fso,d,size,showsize,bai
 		set fso=server.createobject("scripting.filesystemobject")
 		drvpathroot=server.mappath(".")
 		set d=fso.getfolder(drvpathroot)
 		totalsize=d.size

 		set fso=server.createobject("scripting.filesystemobject") 		
 		drvpath=server.mappath(drvpath) 		 		
 		set d=fso.getfolder(drvpath) 		
 		size=d.size
 		bai=Cint(size/totalsize*10000)/100&"%&nbsp;&nbsp;" 
 		showsize=size & "字节" 
 		if size>1024 then
 		   size=(Size/1024)
 		   showsize=formatnumber(size,2) & "KB"
 		end if
 		if size>1024 then
 		   size=(size/1024)
 		   showsize=formatnumber(size,2) & "MB"		
 		end if
 		if size>1024 then
 		   size=(size/1024)
 		   showsize=formatnumber(size,2) & "GB"	   
 		end if   
 		response.write "<font face=verdana>"& bai & showsize & "</font>"
 	End Sub	
 	
 	Sub Showspecialspaceinfo(method)
 		dim fso,d,fc,f1,size,showsize,drvpath 		
 		set fso=server.createobject("scripting.filesystemobject")
 		drvpath=server.mappath(".")
 		set d=fso.getfolder(drvpath) 		
 		
 		if method="All" then 		
 			size=d.size
 		elseif method="Program" then
 			set fc=d.Files
 			for each f1 in fc
 				size=size+f1.size
 			next	
 		end if	
 		
 		showsize=size & "Byte" 
 		if size>1024 then
 		   size=(Size/1024)
 		   showsize=size & "KB"
 		end if
 		if size>1024 then
 		   size=(size/1024)
 		   showsize=formatnumber(size,2) & "MB"		
 		end if
 		if size>1024 then
 		   size=(size/1024)
 		   showsize=formatnumber(size,2) & "GB"	   
 		end if   
 		response.write "<font face=verdana>" & showsize & "</font>"
 	end sub 	 	 	

 	Function ShowFileSize(DrvPath_FileName)
 		dim fs,thisfile,whichfile,Size
		whichfile=Server.MapPath(DrvPath_FileName)
 		set fs= CreateObject("Scripting.FileSystemObject")
 		Set thisfile = fs.GetFile(whichfile)
 		Size=thisfile.size

 		if size>1024 then
 		   size=(Size/1024)
 		   showsize=size & "KB"
 		end if
 		if size>1024 then
 		   size=(size/1024)
 		   showsize=formatnumber(size,2) & "MB"		
 		end if
 		if size>1024 then
 		   size=(size/1024)
 		   showsize=formatnumber(size,2) & "GB"	   
 		end if   

 		ShowFileSize=showsize
 	End Function 	

 	Function Drawbar(drvpath)
 		dim fso,drvpathroot,d,size,totalsize,barsize
 		set fso=server.createobject("scripting.filesystemobject")
 		drvpathroot=server.mappath(".")
 		set d=fso.getfolder(drvpathroot)
 		totalsize=d.size
 		
 		drvpath=server.mappath(drvpath) 		
 		set d=fso.getfolder(drvpath)
 		size=d.size
 		
 		barsize=cint((size/totalsize)*400)
 		Drawbar=barsize
 	End Function 	
 	
 	Function Drawspecialbar()
 		dim fso,drvpathroot,d,fc,f1,size,totalsize,barsize
 		set fso=server.createobject("scripting.filesystemobject")
 		drvpathroot=server.mappath(".")
 		set d=fso.getfolder(drvpathroot)
 		totalsize=d.size
 		
 		set fc=d.files
 		for each f1 in fc
 			size=size+f1.size
 		next	
 		
 		barsize=cint((size/totalsize)*400)
 		Drawspecialbar=barsize
 	End Function 	
	end if
end if%>