wm.sys_data.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<!--#include file="WM.Sys_Cook.asp"-->
<%
Call WM_Content
Sub WM_Content()
  Dim Currf, Backf, BackFy, DBPath, BoolIs97, Engine, strDBPath,Cnn
  Call DBConnBegin()
  Const JET_3X = 4
  Select Case WRMPS.CheckStr(Request("Action"), 0)
    Case "SQL"

    Case "BackUpOperate"
	   If CheckAdminFlag("DateBak") = False Then Call WRMPS.ErrView("·您没有权限进行此操作",0)
       Backf = "../DataBackup/"
       Call WRMPS.FsoBegin
	   If Fso.FolderExists(Server.MapPath(Backf)) = False Then Fso.CreateFolder (Server.MapPath(Backf))
       If ConnTypeStr <> 0 Then
         Set Cnn=Server.createobject("adodb.connection")
         Cnn.open "driver={SQL Server};Server="&DBServer&";uid="&DBuid&";pwd="&DBpwd
         BackFy = Replace(WRMPS.CheckStr(Request.Form("BackFy"),0),".","")&".dat"
         SQL="backup database "&DBname&" to disk='"&Server.MapPath(Backf) &"/"& BackFy&"'"
         Cnn.Execute SQL
         on error resume next
         If Err<>0 Then Call WRMPS.ErrView("·未知错误<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
	   Else
         Currf = ACCDB
         Currf = Server.MapPath(Currf)
         If Fso.FileExists(Currf) = False Then Call WRMPS.ErrView("·原数据库路径不正确<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
         BackFy = Replace(WRMPS.CheckStr(Request.Form("BackFy"),0),".","")&".db"
         Fso.CopyFile Currf, Server.MapPath(Backf) &"/"& BackFy
	   End IF
       Call WRMPS.FsoEnd
	   Call WRMPS.ErrView("·数据库备份成功<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",1)

    Case "CompactOperate"
	   If CheckAdminFlag("") = False Then Call WRMPS.ErrView("·您没有权限进行此操作",0)
       If ConnTypeStr <> 0 Then Response.Redirect "WM.Sys_Data.asp"
       DBPath = "../DataBackup/"&Replace(WRMPS.CheckStr(Request.Form("mDBPath"), 0),".","")&".db"
       BoolIs97 = "false"
       If DBPath <> "" Then
         DBPath = Server.MapPath(DBPath)
         strDBPath = Left(DBPath, InStrRev(DBPath, "\"))
         Call WRMPS.FsoBegin
         If Fso.FileExists(DBPath) Then
           Set Engine = CreateObject("JRO.JetEngine")
             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 Engine = Nothing
		   Call WRMPS.FsoEnd
		   Call WRMPS.ErrView("·数据库压缩成功<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",1)
         Else
		   Call WRMPS.FsoEnd
		   Call WRMPS.ErrView("·数据库名称或路径不正确<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
         End If
       End If

    Case "RestoreOperate"
	   If CheckAdminFlag("") = False Then Call WRMPS.ErrView("·您没有权限进行此操作",0)
	   Backf = "../DataBackup/"
       If ConnTypeStr <> 0 Then
         Set Cnn=Server.createobject("adodb.connection")
         Cnn.open "driver={SQL Server};Server="&DBServer&";uid="&DBuid&";pwd="&DBpwd
         SQL="Restore database "&DBname&" from disk='"&Server.MapPath(Backf&Replace(WRMPS.CheckStr(Request.Form("Backf"), 0),".","")&".dat")&"'"
         Cnn.Execute SQL
         on error resume next
         If Err<>0 Then Call WRMPS.ErrView("·未知错误<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
	   Else
         Call WRMPS.FsoBegin
         Currf = ACCDB
         If InStr(Currf, "*") Then Call WRMPS.ErrView("·数据库路径中包含错误字符<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
         Currf = Server.MapPath(Currf)
         If Fso.FileExists(Currf) = False Then Call WRMPS.ErrView("·原数据库路径不正确<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
         Backf = Backf&Replace(WRMPS.CheckStr(Request.Form("Backf"), 0),".","")&".db"
         Backf = Server.MapPath(Backf)
         If Fso.FileExists(Backf) = False Then Call WRMPS.ErrView("·备份数据库路径不正确<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",0)
         Fso.CopyFile "" & Backf & "", "" & Currf & ""
	     Call WRMPS.FsoEnd
	   End If

	   Call WRMPS.ErrView("·数据库恢复成功<meta http-equiv=refresh content='1;URL=WM.Sys_Data.asp'>",1)

    Case Else
       Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
       Content = Content & "<form name='form1' method='POST' Action='?Action=BackUpOperate'>" & vbCrLf
       Content = Content & "<tr><td colspan=2 class=td4><strong>备份数据库</strong></td></tr>" & vbCrLf
       Content = Content & "<tr class=td2><td width='35%'><strong>备份数据库名称</strong></td>" & vbCrLf
       Content = Content & "<td width='65%'><input type='text' name='BackFy' size=20 value='"&Date()&"'></td></tr>" & vbCrLf
       Content = Content & "<tr class=td2><td></td><td><input type=submit name='Submit' value=' 备 份 '></td></tr>" & vbCrLf
       Content = Content & "</form>" & vbCrLf
	   If CheckAdminFlag("") Then
	     If ConnTypeStr <> 1 Then
           Content = Content & "<form name='form1' method='POST' Action='?Action=CompactOperate'>" & vbCrLf
           Content = Content & "<tr><td colspan=2 class=td4><strong>压缩数据库</strong></td></tr>" & vbCrLf
           Content = Content & "<tr class=td2><td><strong>备份数据库名称</strong></td>"
           Content = Content & "<td><input type='text' name='mDBPath' size=20 value='"&Date()&"'></td></tr>" & vbCrLf
           Content = Content & "<tr class=td2><td></td><td><input type=submit name='Submit' value=' 压 缩 '></td></tr>" & vbCrLf
           Content = Content & "</form>" & vbCrLf
	     End If
         Content = Content & "<form name='form1' method='POST' Action='?Action=RestoreOperate'>" & vbCrLf
         Content = Content & "<tr><td colspan=2 class=td4><strong>恢复数据库</strong></td></tr>" & vbCrLf
         Content = Content & "<tr class=td2><td><strong>备份数据库名称</strong></td>"
         Content = Content & "<td><input type='text' name='Backf' size=20 value='"&Date()&"'></td></tr>" & vbCrLf
         Content = Content & "<tr class=td2><td></td><td><input type=submit name='Submit' value=' 恢 复 '></td></tr>" & vbCrLf
         Content = Content & "</form>" & vbCrLf
	   End If
       Content = Content & "</table>" & vbCrLf

  End Select
  Call ClassEnd()
  Response.Write Content
  Call GetBottom()
End Sub
%>