远程调用ACCESS数据库,ASP数据库

kk远程控制ASSECC数据库程序
在CSDN上有人问到这个问题..
“公司有两个网站，两个网站之间的ACCESS数据库不动的情况下，需要相互使用。“
其实如果这种情况，用SQLServer是很好的拉。。可是有些情况没SQL。。

也看过一个类似的东西,可是感觉他的功能还差的很多.
我自己写了一个程序用来远程调用,读取,处理ACCESS数据库的功能

功能大概如下,
1)可以很简单的对远程ACCESS数据库进行查询,更新,插入,删除等操作.一句SQL就可以了
2)强大的自定义远程执行功能~可以让远程服务端ASP处理任意的ASP(VB)程序,不但可以对数据库进行操作,而且可以执行更多的操作.
3)提供两种方式的远程操作
第一种是用表单提交的方式.当然这个就比较固定了.
第二种是一种方法~用XMLHTTP,可以应用到别的程序里,在别的程序运行过程中对数据库进行操作.
程序文件如下:

kk远程控制ASSECC数据库程序－服务端
kkRemotemdb.asp(放置在被控制的数据库的网站上)

程序代码
<%@LANGUAGE = "VBSCRIPT" CODEPAGE = "936"%>
<%
'Option Explicit '如果用强制声明，则自定义程序也必须遵守。
Const kkAccessFile = "site1.mdb" '定义位置(包括目录)例如/rootwww/mymdb.mdb 或者 mdbdata/mymdb.mdb等等
'=====================================================================
'kk远程控制ASSECC数据库程序－服务端,由张伟kk编写
'欢迎到我的blog坐坐^_^ http://www.kkee.cn
'---------------------------------------------
'初学ASP,难免有错漏,请多包涵.如过您把这个程序修改的更好了,请告诉我:)
'QQ:1280214 Email:kk@kkee.cn
'======================================================================
On Error Resume Next '不处理错误.如果出错则跳过
Dim kkCommType,SQL,RSexe,kkikk,kkgORp
SQL = Trim(Request.QueryString("SQL"))

If Request.Form("RSexe").Count>1 Then
For kkikk = 1 To Request.Form("RSexe").Count
  RSexe = RSexe & ":"&Trim(Request.Form("RSexe")(i))
Next
Else
RSexe = Trim(Request.Form("RSexe"))
End If
If Len(RSexe) < 1 Then
If Request.QueryString("RSexe").Count>1 Then
  For kkikk = 1 To Request.QueryString("RSexe").Count
   RSexe = RSexe&":"&Trim(Request.QueryString("RSexe")(i))
  Next
Else
  RSexe = Trim(Request.QueryString("RSexe"))
End If
End If

If Len(RSexe)>0 Then
Dim RSexeLen,kkInQuot,kkRSexeTemp,kkTempChr,kkInSQuot
kkInQuot = False
RSexeLen = Len(RSexe)
kkInSQuot = False
For kkikk = 1 to RSexeLen
  kkTempChr = Mid(RSexe,kkikk,1)
  If kkTempChr = CHR(34) and kkInSQuot = False Then
   kkInQuot = Not kkInQuot
  End If

  If kkInQuot = False Then
   If kkTempChr = CHR(39) Then kkInSQuot = true
   If kkTempChr = CHR(13) Then kkInSQuot = False
  End If
  If kkInSQuot = False Then kkRSexeTemp = kkRSexeTemp&kkTempChr
Next
RSexe = kkRSexeTemp
RSexe = Replace(RSexe, CHR(13)&CHR(10), ":")
RSexe = Replace(RSexe, CHR(13),":")
RSexe = Replace(RSexe, CHR(10),":")
End If
kkCommType = lcase(left(SQL,6))
Dim Conn
Set Conn = Server.CreateObject("ADODB.Connection") 'ADO连接
Conn.ConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(kkAccessFile) '链接字串
Conn.Open '打开连接
If Err Then '如果有错,清除错误,关闭连接,提示错误,停止输出
Err.Clear
Set Conn = Nothing
Response.Write("<meta http-equiv = ""Content-Type"" content = ""text/html; charSet = gb2312"" /><div style = 'font-size:12px;font-weight:bold;border:1px solid #006;padding:6px;background:#fcc'>数据库连接出错，请检查连接字串!</div>")
Response.End
End If '结束 If Err Then

'************如果先执行post*******************
If LCase(Trim(Request.QueryString("gORp")))="p" then
If Len(RSexe)>0 Then
  Execute RSexe
  RSexe=Nothing
End If
End If
'************以下是默认的读取并以XML方式输出处理据处理**************
'需要用get方法提供一句和数据库对应的语句
'例如:SQL = "Select * FROM Smile orDER BY sm_id DESC"
If kkCommType = "select" Then
Dim rs
Set rs = Server.CreateObject( "ADODB.RecordSet" )
rs.Open SQL,Conn,1,1
Dim kkrsCount,kkrsName(),kkTableNameStart,kkTableName,kkTableNameLen,kkTableNameTemp
kkrsCount = rs.Fields.Count-1
ReDim kkrsName(kkrsCount)
For kkikk = 0 To kkrsCount
  kkrsName(kkikk) = CCEncode(rs(kkikk).Name)
Next
kkTableNameStart=InStr(LCase(SQL),"from")+5
kkTableNameTemp=InStr(kkTableNameStart,LCase(SQL)," ")
If kkTableNameTemp=0 then
  kkTableNameLen=len(SQL)-kkTableNameStart+1
Else
  kkTableNameLen=kkTableNameTemp-kkTableNameStart
End if
If mid(SQL,kkTableNameStart,1)="[" Then
kkTableNameStart=kkTableNameStart+1
kkTableNameLen=kkTableNameLen-2
End If
kkTableName=mid(SQL,kkTableNameStart,kkTableNameLen)
'----------------以下显示输出的XML的格式----------
Response.Write("<?xml version = ""1.0"" encoding = ""gb2312""?>")
Response.Write("<kkxml xmlns = ""http://www.kkee.cn/xml"">")
Response.Write("<"&kkTableName&">")
Do While Not rs.eof
  Response.Write("<row>")
  For kkikk = 0 To kkrsCount
   Response.Write("<"&kkrsName(kkikk)&">"&CCEncode(rs(kkikk))&"</"&kkrsName(kkikk)&">")
  Next
  Response.Write("</row>")
  rs.MoveNext
Loop
Response.Write("</"&kkTableName&">")
Response.Write("</kkxml>")
Set rs = Nothing
'**********以下是数据的一般处理****************
'需要用get方法提供一句和数据库对应的语句
'例如插入:SQL = "Insert inTo Smile(sm_image,sm_text) values('图片地址','图片文字')"
'例如删除:SQL = "Delete FROM Smile Where sm_id = 15"
'例如更新:SQL = "update smile Set sm_image = '我的图片',sm_text = '我的文字' where sm_ID = 81"
ElseIf kkCommType = "insert" or kkCommType = "delete" or kkCommType = "update" Then
Conn.Execute SQL
If Err Then '如果有错,清除错误,关闭连接,提示错误,停止输出
  Err.Clear
  Set Conn = Nothing
Else
Response.Write("Successful "&kkCommType&"! <a href = ""javascript:history.back(1)"">back</a>")
End If
End If
'**********以下为额外需要运行的代码**********
If Len(RSexe)>0 Then
Execute RSexe
End If
'********************************************
Function CCEncode(reString)
Dim Str:Str = reString
If Not IsNull(Str) Then
  Str = Replace(Str, CHR(38), "&")
  Str = Replace(Str, CHR(39), "'")
  Str = Replace(Str, ">", ">")
  Str = Replace(Str, "<", "<")
  Str = Replace(Str, CHR(32), " ")
  Str = Replace(Str, CHR(9), " ")
  Str = Replace(Str, CHR(9), "    ")
  Str = Replace(Str, CHR(34), """)
  Str = Replace(Str, CHR(13), " ")
  Str = Replace(Str, CHR(20), "")
  Str = Replace(Str, CHR(10), " ")
  CCEncode = Str
End If
End Function

If Err.Number > 0 Then
Err.Clear
Response.Write("输入参数有错误~!")
End If

If TypeName(Conn)<>"Nothing" Then
Conn.Close
Set Conn = Nothing
End If
%>

kk远程控制ASSECC数据库程序－表单
send.htm(可以放置在任何地方)

程序代码
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>kk远程控制ASSECC数据库程序－表单</title>

<style type="text/css">

</style></head>

<body>
<table width="800" border="0" align="center">
<tr>
<td height="20" colspan="2" align="center"><span class="style1">kk远程控制ASSECC数据库程序－表单</span></td>
</tr>
<tr>
<td height="20" colspan="2">接受指令的ASP程序：
<input name="actionurl" type="text" id="actionurl" value="http://kk:91/kkRemotemdb.asp" size="60" onChange="myaction()"> </td>
</tr>
<tr>
<td height="20" colspan="2">
  <strong>执行方式:</strong>  <select name="commType" id="commType" onChange="myaction2()">
<option value="" selected>自定义命令</option>
<option value="Select TOP 20 * FROM []">Select（选择）</option>
<option value="Update [] SET ">Update（更新）</option>
<option value="Insert INTO [] () VALUES ('')">Insert（插入）</option>
<option value="Delete FROM [] Where 0>1">Delete（删除）</option>
</select>
<select name="getorpost" id="getorpost" disabled>
<option selected value="get">先执行一般get</option>
<option value="post">先执行特殊命令</option>
</select></td>
</tr>
<tr>
<td height="20" colspan="2"><strong>常用指令:</strong></td>
</tr>
<tr>
<td height="20" colspan="2">SQL="
<input name="sendSQL" type="text" id="sendSQL" size="100" onChange="myaction()">
"</td>
</tr>
<tr>
<td height="20" colspan="2"> </td>
</tr>
<tr>
<td colspan="2"><form name="form1" method="post" target="_blank">

<table width="100%" border="0">
<tr>
<td colspan="3" align="left"><strong>自定义指令:</strong></td>
</tr>
<tr>
<td colspan="3" align="center"><textarea name="Rsexe" cols="100" rows="10" wrap="VIRTUAL" id="Rsexe" onChange="myaction()"></textarea></td>
</tr>
<tr>
<td width="16%" align="center"> </td>
<td width="69%" align="center"><input name="Submit" type="submit" id="Submit" onClick="myaction()" value=" 提交 "></td>
<td width="16%"><a href="#" onClick="VBScript:form1.rsexe.value=''">清空自定义</a></td>
</tr>
</table>
<p> </p>
<p> <strong>使用说明:</strong><br>
一、控制远端ASP操作并显示数据库内容的方法有两种。<br>
1)自定义指令<br>
默认就是只使用自定义命令的。<br>
在这里输入一段ASP或者VB的程序。就可以让远端的ASP程序执行。<br>
原理：用post方式将发送到服务端后，服务端接收"RSexe"参数，把程序集成一行，即用“:”隔开每一句，这是VB的语法，然后再一次性执行。<br>
<br>
2)常用指令<br>
在远程的ASP服务端已经嵌入了基本的数据库操作，在这里输入一句符合以上格式的SQL程序就可以在远端执行。<br>
由于服务端没有集成太多所以也只能支持这几种格式的SQL语句。如果需要别的格式的SQL就用自定义指令吧。<br>
原理：把SQL语句，加入到URL中发送，服务端接收SQL参数。<br>
<br>
二、注意事项<br>
1)自定义指令必须是ASP或者VB的程序。<br>
2)数据库连接conn已经连接好了,可以直接使用.变量rs,SQL已经定义过,但如果不使用常用指令中的“读取”的话,他们是Empty,未初始化的.<br>
3)自定义程序的变量最好是显示声明的。</p>
<p></p>
</form></td>
</tr>
<tr>
<td width="272" align="right"> </td>
<td width="518" align="center">张伟kk制作</td>
</tr>
<tr>
<td align="right"> </td>
<td align="center"><a href="http://www.kkee.cn" target="_blank">http://www.kkee.cn</a></td>
</tr>
</table>
<p>
<script language="vbscript">
Dim posturl
function myaction()
if sendSQL.value<>"" then
  posturl="?SQL="&sendSQL.value
if getorpost.value = "post" then posturl=posturl&"&gORp=p"
else
  posturl=""
end if
  form1.action=actionurl.value&posturl
if sendSQL.value<>"" then
  getorpost.disabled=false
else
  getorpost.disabled=true
end if
end function

call myaction()

function myaction2()
sendSQL.value=commType.value
if sendSQL.value<>"" then
  posturl="?SQL="&sendSQL.value
  if getorpost.value = "post" then posturl=posturl&"&gORp=p"
else
  posturl=""
end if
form1.action=actionurl.value&posturl
if sendSQL.value<>"" then
  getorpost.disabled=false
else
  getorpost.disabled=true
end if
end function
</script>

</body>
</html>

kk远程控制ASSECC数据库程序－XMLHTTP例子
autosend.asp(放置在任何支持ASP和XMLHTTP的服务器上

程序代码

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%Option Explicit '强制声明%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>kk远程控制ASSECC数据库程序-XMLHTTP</title>
</head><body>
<%

'=====================================================================
'kk远程控制ASSECC数据库程序－XMLHTTP,由张伟kk编写
'欢迎到我的blog坐坐^_^ http://www.kkee.cn
'---------------------------------------------
'初学ASP,难免有错漏,请多包涵.如过您把这个程序修改的更好了,请告诉我:)
'QQ:1280214 Email:kk@kkee.cn
'======================================================================
'On Error Resume Next '不处理错误.如果出错则跳过

Dim kkRemoteFileUrl'远程ASP文件
Dim kkSendSQL
Dim kk
Dim kkBefpost'
Dim kksendType
'---------------------------
kkSendSQL="Select * FROM smile"'在这输入SQL语句,这是必要的
kkRemoteFileUrl="http://kk:91/kkRemotemdb.asp"
'---------------------------

If kkSendSQL<>"" Then kkRemoteFileUrl=kkRemoteFileUrl&"?SQL="&kkSendSQL

Dim kkbError,kkobjXML,kkRetrieval,kkGetRemoteData
kkbError = False
Set kkRetrieval = Server.CreateObject("Msxml2.ServerXMLHTTP")
With kkRetrieval
.Open "GET", kkRemoteFileUrl, False
.Send
If .Status = 200 Then
kkGetRemoteData = .ResponseBody
Else
bError = True
End If
End With
Set kkobjXML = Server.CreateObject("Microsoft.FreeThreadedXMLDOM")
'以自由线程创建一个XML对像
kkobjXML.load(kkGetRemoteData)
'kkobjXML.load(strSourceFile)'把XML文件读入内存
Set kkRetrieval = Nothing
'******到这里已经******实现了读取远程ACCESS文件效果.
'下面则用操作XML的方法来显示出来.
'以下仅供参考程序的参考.如需要了解更多关于XML的调用,请看看关于XML的书.

'以下表名判断----------
Dim kkTableNameStart,kkTableName,kkTableNameLen,kkTableNameTemp
kkTableNameStart=InStr(LCase(kkSendSQL),"from")+5
kkTableNameTemp=InStr(kkTableNameStart,LCase(kkSendSQL)," ")
If kkTableNameTemp=0 then
  kkTableNameLen=len(kkSendSQL)-kkTableNameStart+1
Else
  kkTableNameLen=kkTableNameTemp-kkTableNameStart
End if
If Mid(kkSendSQL,kkTableNameStart,1)="[" Then
kkTableNameStart=kkTableNameStart+1
kkTableNameLen=kkTableNameLen-2
End If
'Response.Write(kkTableNameStart&kkTableNameLen&kkTableNameTemp&len(kkSendSQL))
kkTableName=Mid(kkSendSQL,kkTableNameStart,kkTableNameLen)
'表名判断结束----------

Dim kkobjRootsite,PageSize,AllNodesNum,PageNum,PageNo,StarNodes,EndNodes,objRootsite
Set kkobjRootsite = kkobjXML.documentElement.selectSingleNode(kkTableName)'如果这里输入表名，上面略去表名判断的程序
PageSize =20'假设每页10条信息
AllNodesNum =kkobjRootsite.childNodes.length-1'获取子节点数据（因为是从节点数从0开始的所最大子节点数要减1）
'下面我们用倒序来显示数据库里的内容.
PageNum=AllNodesNum\PageSize+1'算出总页数
PageNo=request.querystring("PageNo")
if PageNo="" then
PageNo=PageNum
end if
StarNodes=PageNo*PageSize-1'获得起始节点
EndNodes=(PageNo-1)*PageSize'获得结束节点
if EndNodes<0 then
EndNodes=0
end if
if StarNodes>AllNodesNum then'判断起始节点数是否超过总的节点数
EndNodes=EndNodes-(StarNodes-AllNodesNum)
'如果超过则结束节点要减去(StarNodes-AllNodesNum)的差值否则下标会超界出错
StarNodes=AllNodesNum
end if
if EndNodes<0 then
EndNodes=0
end if
while StarNodes>=EndNodes
'从结束节点到超始节点之间读取节点数据
dim kkdata,kkdataname,ikk,kknodeslen
kknodeslen=kkobjRootsite.childNodes.item(StarNodes).childNodes.Length
Response.Write kknodeslen
for ikk = 0 to kknodeslen-1
kkdataname = kkobjRootsite.childNodes.item(StarNodes).childNodes.item(ikk).nodeName
kkdata = kkobjRootsite.childNodes.item(StarNodes).childNodes.item(ikk).text
Response.Write(kkdataname&" = "&kkdata&"　　　　")
next
'*****************************************************************************
'这里使作了XML的DOM来读取数据,显然objRootsite对像所对应的节点为表名
' kkobjRootsite.childNodes.item(StarNodes)所对应的节点就是<row>节点因，由于是倒序,随着StarNodes的递减<row>节点根着往上移一个个读取<row>节点数据。
'kkobjRootsite.childNodes.item(StarNodes).childNodes.item(i).text所对应的节点为具体的每个节点的文本值.
'******************************************************************************
StarNodes=StarNodes-1
Response.Write("<br>")
wend
set kkobjXML=nothing
%>
共有<<%=PageNum%>>页
<%
if cint(PageNo)<>PageNum then'分页
response.write "<a href='autosend.asp?PageNo="&(PageNo+1)&"'>上一页</a> "
end if
if cint(PageNo)<>1 then
response.write "<a href='autosend.asp?PageNo="&(PageNo-1)&"'>下一页</a> "
end if

'这里我只演示了读取，如果是要操作数据库的话，依然可以用XMLHTTP的Open方法当然如果是需要执行自定义程序，当然要用open "POST"方法，.send来发送RSEXE（要执行的自定义语句）其他的都话就可以用先定义个带SQL命令的URL，用GET方法发送，或者用send（sendSQL）也可以。：）
%>
</body>
</html>