admin_database.asp

嘉缘人才6.0精简 ,很好用的人才系统

<textarea name="Sql" rows="5" wrap="OFF" style="width:100%;"></textarea>
<input type="hidden" name="Flag" value="Execute"></td>
</tr>
<tr>
<td style="height:30px;" align="center">
<input type="submit" name="submit1" class="inputs" value="立即执行"><span style="color:red">一次仅能执行一条SQL语句，如果您没有一定的SQL基础，建议不要使用！</span></td>
</tr>
</form>
<tr> 
<td valign="_top" style="height:70%;"><iframe id="ExecuteSQLFrame" scrolling="auto" src="Admin_Database.asp?Action=ExecSql&Flag=Result" style="width:100%;height:93%" frameborder=1></iframe></td>
</tr>
</table>
<% End iF%>
<%
End Sub
Sub ExecuteSQL()
Dim SelectSQLTF,ExecSQLErrorTF,ExeResultNum,ExeResult,FiledObj
Dim Sql:Sql =request.querystring("Sql")
if SQL="" Then Exit Sub
'If Instr(1,lcase(Sql),"delete from ks_log")<>0 then
	'Call KSCMS.AlertHistory("对不起，不能删除日志表数据！",-1)
		'Exit Sub
'End If
SelectSQLTF = (LCase(Left(Trim(Sql),6)) = "select")
Conn.Errors.Clear
On Error Resume Next
if SelectSQLTF = True then
	  Set ExeResult = Conn.Execute(Sql,ExeResultNum)
else
	  Conn.Execute Sql,ExeResultNum
end if
 
If Conn.Errors.Count<>0 Then
	  ExecSQLErrorTF = True
	  Set ExeResult = Conn.Errors
Else
	  ExecSQLErrorTF = False
End If
if ExecSQLErrorTF = True then
%>
<table width=100% border=0 align=center cellpadding=2  cellspacing=1 class=tableBorder>
  <tr bgcolor="F4F4EA"> 
	<td height="20" nowrap> 
	  <div align="center">错误号</div></td>
	<td height="20" nowrap> 
	  <div align="center">来源</div></td>
	<td height="20" nowrap> 
	  <div align="center">描述</div></td>
	<td height="20" nowrap> 
	  <div align="center">帮助</div></td>
	<td height="20" nowrap> 
	  <div align="center">帮助文档</div></td>
  </tr>
  <tr height="20" bgcolor="#FFFFFF"> 
	<td nowrap> 
	  <% = Err.Number %> </td>
	<td nowrap> 
	  <% = Err.Description %> </td>
	<td nowrap> 
	  <% = Err.Source %> </td>
	<td nowrap> 
	  <% = Err.Helpcontext %> </td>
	<td nowrap> 
	  <% = Err.HelpFile %> </td>
  </tr>
</table>
<%
else
%>
<table width=100% border=0 align=center cellpadding=2  cellspacing=1 class=tableBorder>
  <%
	if SelectSQLTF = True then
%>
  <tr>
<%
		For Each FiledObj In ExeResult.Fields
%>
	<td nowrap bgcolor="F4F4EA" height="26"><div align="center">
		<% = FiledObj.name %>
	  </div></td>
<%
		next
%>
  </tr>
<%
		do while Not ExeResult.Eof
%>
  <tr height="20" nowrap bgcolor="#ffffff" onMouseOver="this.style.background='#F5f5f5'" onMouseOut="this.style.background='#FFFFFF'">
<%
			For Each FiledObj In ExeResult.Fields
%>
	<td> 
	  <div align="center">
		<%
		 if IsNull(FiledObj.value) then
			Response.Write("&nbsp;")
		 else
			Response.Write(FiledObj.value)
		 end if
		 %>
	  </div></td>
<%
			next
%>
  </tr>
<%
			ExeResult.MoveNext
		loop
	else
%>
  <tr>
	<td bgcolor="F4F4EA" height="26">
<div align="center">执行结果</div></td>
  </tr>
  <tr>
	<td height="20" bgcolor="#FFFFFF">
<div align="center">
		<% = ExeResultNum & "条纪录被影响"%>
	  </div></td>
  </tr>
<%
	end if
%>
</table>
<%
  end if
 End Sub
 %>
<%
'=====================压缩参数=========================
Sub CompressData()
Dim fso, Engine, strDBPath,JET_3X,dbpath,boolIs97,TempStr
dbpath = Request("dbpath")
boolIs97 =Request("boolIs97")

If dbpath <> "" Then
   dbpath = Server.MapPath(dbpath)
Else
    ErrMsg="压缩数据库相对路径不能为空"
	Exit Sub
End If

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
	%>你的数据库, <% = dbpath%>, 已经压缩成功!<%
Else
	%>数据库名称或路径不正确. 请重试!<%
End If
End Sub

sub BackUpData()
Dim FileConnStr,Fileconn,Dbpath,bkfolder,bkdbname,Fso
bkfolder=request.Form("bkfolder")
bkdbname=request.Form("bkdbname")
If FR_HR_DataBaseType=1 then
	Set srv=Server.CreateObject("SQLDMO.SQLServer")
	srv.LoginTimeout = 15 '登陆超时
	srv.Connect HostIP,Username, Password
	Set bak = Server.CreateObject("SQLDMO.Backup")
	bak.Database=DatabaseName
	bak.Devices=Files
	If CheckDir(bkfolder) = True Then
			bak.Files=bkfolder& "\"& bkdbname
		else
			MakeNewsDir bkfolder
			bak.Files=bkfolder& "\"& bkdbname
		end if
	bak.SQLBackup srv
	if err.number>0 then
	response.write err.number&"<font color=red><br>"
	response.write err.description&"</font>"
	end if
	Response.write "<font color=green>备份成功!</font>"
Else
'Dbpath=request.Form("Dbpath")
Dbpath=server.mappath(Add_Root_Dir(Database)) '08年2月17日修改,防止恶意攻击.
	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 bkfolder& "\"& bkdbname
			'Response.Write("&nbsp;&nbsp;<a href="&bkfolder&"/"&bkdbname&"><span style='color:#FF0000;'>点击下载</span></a>")
	Else
		%>找不到您所需要备份的文件。<%
	End if
End If
End sub

Sub wResumeData()
On Error Resume Next
dim backpath,Fso
Dbpath=request.form("dbpath")
'backpath=request.form("backpath")
If FR_HR_DataBaseType=1 then
	Set srv=Server.CreateObject("SQLDMO.SQLServer")
	srv.LoginTimeout = 15
	srv.Connect HostIP,Username, Password
	Set rest=Server.CreateObject("SQLDMO.Restore")
	rest.Action=0
	rest.Database=DatabaseName
	rest.Devices=Files
	rest.Files=Dbpath
	rest.ReplaceDatabase=True
	if err.number>0 then
	response.write err.number&"<font color=red><br>"
	response.write err.description&"</font>"
	end if
	rest.SQLRestore srv
	If Err Then
        Err.Clear
        Response.Write "<br><br><br><br><br><br><br><div align='center'>数据库异常，错误编号10010！</div>"
        Response.End
    End If
	Response.write "<font color=green>恢复成功!</font>"
Else
	If Dbpath="" then
	%>请输入您要恢复成的数据库全名<%
	Else
	Dbpath=server.mappath(Dbpath)
	End If
	backpath=server.mappath(Add_Root_Dir(Database))
	Set Fso=server.createobject("Scripting.FilesyStemObject")
	if fso.fileexists(dbpath) then  					
	fso.copyfile Dbpath,Backpath
	%>成功恢复数据！<%
	else
	%>备份目录下并无您的备份文件！<%	
	end if
End If	
End Sub
'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
    dim fso1
	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,fso1
    Set fso1 = CreateObject("Scripting.FileSystemObject")
        Set f = fso1.CreateFolder(foldername)
        MakeNewsDir = True
    Set fso1 = nothing
End Function
'-------------时间转换成数字-----------------------
Function datenum(bkDBnamem)
bkDBnamem =replace(bkDBnamem,":","")
bkDBnamem=replace(bkDBnamem,"-","")
bkDBnamem=replace(bkDBnamem," ","")
datenum=bkDBnamem
End Function
Call CloseConn()
%>