<%
'本程序是翟振恺(小琦)原创的,现在我免费发布出来,请转用或转载时不要把版权去掉。
'本程序是针对不能用组件加密asp的用户写的,应该可以有效的保护ACCESS数据。
'www.xiaoqi.net
if Request("mdbname" <>"" then
'------------------------取磁盘序列号----------------------------小琦
set fs=server.createObject("scripting.filesystemobject"
testDrive="G:/"
set f=fs.getdrive(testDrive)
''调用GetDrive方法,将驱动器赋予一个变量
xlh=trim(f.serialnumber) '取到磁盘序列号
'-------------------------取绑定的网站地址---------------------------小琦
myname=Request.ServerVariables("SERVER_NAME"'我绑定我的主机名
'-------------------------取二进制数据---------------------------小琦
url=server.MapPath("."&"/ www.xiaoqi.net" '取一个exe文件或其它的文件作为提供加密的文件,为了安全,你可以把这个文件放到别人下载不到的地方。
Set fso=Server.CreateObject("Scripting.FileSystemObject"
Set fl=fso.getfile(url)
flsize=fl.size
flName=fl.name
Set objStream = Server.CreateObject("ADODB.Stream"
objStream.Open
objStream.Type = 1
objStream.LoadFromFile url
Password=objStream.Read'二进制数据
Password=left(Password,4)&right(xlh,3)&myname'数据库密码用二进制数据+磁盘序列号+绑定的网站地址
Password=left(Password,19)'ACCESS数据库密码好像最多20个字符,我用了19个
db="xq.mdb"
SavePath=Server.MapPath("."
'----------------------------------------------------小琦
Application.Contents.RemoveAll()
Dim fs, Engine
Set fs = CreateObject("Scripting.FileSystemObject"
mdbname = Request("mdbname"
If fs.FileExists(Server.Mappath(mdbname)) Then
Set Engine = CreateObject("JRO.JetEngine"
'----------------------------------------------------改数据库密码
if request("dz"=1 then
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath(mdbname), "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDBatabase Password="&Password&";Data Source=" & Server.Mappath(mdbname & ".temp"
else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDBatabase Password="&Password&";Data Source=" & Server.Mappath(mdbname), "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath(mdbname & ".temp"
end if
'----------------------------------------------------改数据库密码
fs.CopyFile Server.Mappath(mdbname & ".temp",Server.Mappath(mdbname)
fs.DeleteFile(Server.Mappath(mdbname & ".temp")
Set fs = Nothing
Set Engine = nothing
if request("dz"=1 then
Response.write "<p><font color=#FF0000>数据库加密成功!...</font>"
Else
Response.write "<p><font color=#FF0000>数据库解密成功!...</font>"
end if
Else
Set fs = Nothing
Response.Write "<p><br><br>数据库名称或路径不正确. 压缩失败!" & vbCrLf
End If
end if
%>
<form method="POST" action="--WEBBOT-SELF--">
<p><b>加密解密码数据库</b></p>
<p><input type="text" name="mdbname" size="20" value="测试.mdb"> 数据库名</p>
<p><input type="radio" value="1" name="dz" checked>加密
<input type="radio" value="2" name="dz">解密</p>
<p><input type="submit" value="提交" name="B1"><input type="reset" value="重置" name="B2"></p>
</form>
'本程序是翟振恺(小琦)原创的,现在我免费发布出来,请转用或转载时不要把版权去掉。
'本程序是针对不能用组件加密asp的用户写的,应该可以有效的保护ACCESS数据。
'www.xiaoqi.net
if Request("mdbname" <>"" then
'------------------------取磁盘序列号----------------------------小琦
set fs=server.createObject("scripting.filesystemobject"
testDrive="G:/"
set f=fs.getdrive(testDrive)
''调用GetDrive方法,将驱动器赋予一个变量
xlh=trim(f.serialnumber) '取到磁盘序列号
'-------------------------取绑定的网站地址---------------------------小琦
myname=Request.ServerVariables("SERVER_NAME"'我绑定我的主机名
'-------------------------取二进制数据---------------------------小琦
url=server.MapPath("."&"/ www.xiaoqi.net" '取一个exe文件或其它的文件作为提供加密的文件,为了安全,你可以把这个文件放到别人下载不到的地方。
Set fso=Server.CreateObject("Scripting.FileSystemObject"
Set fl=fso.getfile(url)
flsize=fl.size
flName=fl.name
Set objStream = Server.CreateObject("ADODB.Stream"
objStream.Open
objStream.Type = 1
objStream.LoadFromFile url
Password=objStream.Read'二进制数据
Password=left(Password,4)&right(xlh,3)&myname'数据库密码用二进制数据+磁盘序列号+绑定的网站地址
Password=left(Password,19)'ACCESS数据库密码好像最多20个字符,我用了19个
db="xq.mdb"
SavePath=Server.MapPath("."
'----------------------------------------------------小琦
Application.Contents.RemoveAll()
Dim fs, Engine
Set fs = CreateObject("Scripting.FileSystemObject"
mdbname = Request("mdbname"
If fs.FileExists(Server.Mappath(mdbname)) Then
Set Engine = CreateObject("JRO.JetEngine"
'----------------------------------------------------改数据库密码
if request("dz"=1 then
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath(mdbname), "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDBatabase Password="&Password&";Data Source=" & Server.Mappath(mdbname & ".temp"
else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDBatabase Password="&Password&";Data Source=" & Server.Mappath(mdbname), "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath(mdbname & ".temp"
end if
'----------------------------------------------------改数据库密码
fs.CopyFile Server.Mappath(mdbname & ".temp",Server.Mappath(mdbname)
fs.DeleteFile(Server.Mappath(mdbname & ".temp")
Set fs = Nothing
Set Engine = nothing
if request("dz"=1 then
Response.write "<p><font color=#FF0000>数据库加密成功!...</font>"
Else
Response.write "<p><font color=#FF0000>数据库解密成功!...</font>"
end if
Else
Set fs = Nothing
Response.Write "<p><br><br>数据库名称或路径不正确. 压缩失败!" & vbCrLf
End If
end if
%>
<form method="POST" action="--WEBBOT-SELF--">
<p><b>加密解密码数据库</b></p>
<p><input type="text" name="mdbname" size="20" value="测试.mdb"> 数据库名</p>
<p><input type="radio" value="1" name="dz" checked>加密
<input type="radio" value="2" name="dz">解密</p>
<p><input type="submit" value="提交" name="B1"><input type="reset" value="重置" name="B2"></p>
</form>