反查ACC数据库的密码？

以下是HTML网页特效代码，点击运行按钮可查看效果：
[Ctrl+A 全部选择 提示：你可先修改部分代码，再按运行]

sqlnono.asp代码

复制内容到剪贴板

sqlnono.asp代码
复制内容到剪贴板

代码:

lodo_gqno,lodo_ServerUrl,lodo_AreaUrl,lodo_SysInitialValue,lodo_ServerName,lodo_Edition,lodo_VisitTimes,lodo_rzStr,lodo_AddGoodsRest,lodo_AddOrderRest,lodo_Usertgno,lodo_scjtno,lodo_qtbqno,lodo_ddkcno,lodo_yhhano,lodo_MaskOperactionno,lodo_gwjscno,lodo_yhjscno,lodo_OldTime,lodo_gqSTime,lodo_gqETime,lodo_UsertgSTime,lodo_UsertgETime,lodo_scjtSTime,lodo_scjtETime,lodo_qtbqSTime,lodo_qtbqETime,lodo_ddkcSTime,lodo_ddkcETime,lodo_yhhaSTime,lodo_yhhaETime,lodo_MaskOperactionSTime,lodo_MaskOperactionETime,lodo_gwjscSTime,lodo_gwjscETime,lodo_yhjscSTime,lodo_yhjscETime,lodo_PassStr,lodo_Web_ButtomStr
Public lodo_Version,lodo_DueTime,db,Databasename
IncConstStr = Server.MapPath(lodo_ConstStr & "inc/Const.asp")
If Checkfile(IncConstStr) Then
WriteStr = ReadText(IncConstStr)
WriteStr = DeCrypt(WriteStr, lodo_ConstStr)
if len(WriteStr)>0 then execute (WriteStr) end if
Else
If lodo_Chconst = 1 Then
Response.Write "由于此" & lodo_ConstStr & "inc/Const.asp文件不存在，所以无法浏览网站！"
Response.End
End If
End If
Versionfile = Server.MapPath(lodo_ConstStr & "inc/Version.inc")
If Checkfile(Versionfile) Then
WriteStr = ReadText(Versionfile)
if len(WriteStr)>0 then execute (WriteStr) end if
End If
lodo_Version = lodo_SysName & lodo_SysVersion
Select Case lodo_gqno
Case 0
lodo_DueTime = "已过期"
Case 1
If lodo_gqETime >= Date Then lodo_DueTime = lodo_gqETime & "将到期" Else lodo_DueTime = "已过期" End If
Case 2
   lodo_DueTime = "永不过期"
End Select
If lodo_DatabaseType = 0 Then
    lodo_now = "now()"
    db = lodo_ConstStr & lodo_dbfile & "/" & lodo_Access_Name & ""
    Databasename = Server.MapPath("" & db & "")
    Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=" & GetBinaryPass(lodo_ConstStr) & ";Data Source=" & Databasename & ""
Else
    lodo_now = "getdate()"
    Connstr = "PROVIDER=SQLOLEDB;DATA SOURCE=" & lodo_SQL_IPStr & ";UID=" & lodo_SQL_UserStr & ";PWD=" & lodo_SQL_UPass & ";DATABASE=" & lodo_SQL_Database & " "
End If
set Conn=Server.CreateObject("ADODB.Connection")
On Error Resume Next
Conn.Open Connstr
If Err <> 0 Then
    Err=0
    Set Conn = Nothing
    If lodo_DatabaseType = 0 Then Response.Write "Access数据库连接出错。请检查连接字串！" Else Response.Write "数据库连接出错，请检查连接字串。或者还未安装,点击这里进入<a href='"&lodo_ConstStr&"install/index.html'>系统安装</a>" End If
    Response.End
End If
Set ld_rs = Conn.Execute("select BackStageData,BServerData,StageData from lodo_SetUp")
If Not (ld_rs.EOF Or ld_rs.BOF) Then
lodo_StageData = ld_rs("StageData")
lodo_BackStageData = ld_rs("BackStageData")
lodo_BServerData = ld_rs("BServerData")
End If
Set ld_rs = Nothing
If InStr(LCase(lodo_ServerUrl), "http://") <= 0 Then lodo_ServerUrl = "http://www.lodoeshop.com/user/update.asp?" End If
Function loadKey(CryptStr, keypath)
Dim ld_Key,keyFile,fso,f,FileName,ts,g_KeyLocation,I, k,TempKey,LodoKey, NewLodoKey, LodoRightNum
LodoKey = "www.lodoeshop.com"
LodoRightNum = 3
g_KeyLocation = keypath & "inc/key.txt"
FileName = Server.MapPath(g_KeyLocation)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.fileexists(FileName) Then
Set f = fso.GetFile(FileName)
Set ts = f.OpenAsTextStream(1, -2)
Do While Not ts.AtEndOfStream
keyFile = keyFile & ts.ReadLine
Loop
ld_Key = ""
keyFile = Mid(keyFile, 1, Len(CryptStr))
k = 1
For I = 1 To Len(keyFile)
TempKey = Asc(Mid(keyFile, I, 1))
If k > Len(LodoKey) Then
k = 1
End If
NewLodoKey = Asc(Mid(LodoKey, k, 1)) + LodoRightNum
Do While NewLodoKey > 255
NewLodoKey = NewLodoKey - 255
Loop
ld_Key = ld_Key & TempKey & Chr(NewLodoKey)
Next
End If
loadKey = ld_Key
End Function
Function EnCrypt(strCryptThis, keypath)
Dim strChar,iKeyChar,iStringChar,I,g_Key,iCryptChar,strEncrypted
g_Key = loadKey(strCryptThis, keypath)
For I = 1 To len(strCryptThis)
iKeyChar = Asc(Mid(g_Key, I, 1))
iStringChar = Asc(Mid(strCryptThis, I, 1))
iCryptChar = iKeyChar Xor iStringChar
strEncrypted = strEncrypted & Chr(iCryptChar)
Next
EnCrypt = strEncrypted
End Function
Function DeCrypt(strEncrypted, keypath)
Dim strChar,iKeyChar,iStringChar,I,g_Key,iDeCryptChar
g_Key = loadKey(strEncrypted, keypath)
For I = 1 To len(strEncrypted)
iKeyChar = (Asc(Mid(g_Key, I, 1)))
iStringChar = Asc(Mid(strEncrypted, I, 1))
iDeCryptChar = iKeyChar Xor iStringChar
strDecrypted = strDecrypted & Chr(iDeCryptChar)
Next
DeCrypt = strDecrypted
End Function
Function GetBinaryPass(passinc)
Dim PassUrl
Dim fso
Dim fl
Dim objStream
Dim Password, PasswordStr
PassUrl = Server.MapPath(passinc & "inc/") & "\wwwlodocom"
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fl = fso.GetFile(PassUrl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1
objStream.LoadFromFile PassUrl
PasswordStr = objStream.Read
Password = Mid(PasswordStr, Asc("l"), 1) & "l" & Mid(PasswordStr, 2, 1) & "o" & Mid(PasswordStr, 3, 1) & "d" & Mid(PasswordStr, 4, 1) & "o" & Mid(PasswordStr, 5, 1) & "e" & Mid(PasswordStr, 6, 1) & "s" & Mid(PasswordStr, 7, 1) & "h" & Mid(PasswordStr, 8, 1) & "o" & Mid(PasswordStr, 9, 1) & "p" & Mid(PasswordStr, 10, 1) & ""
Set objStream = Nothing
Set fl = Nothing
Set fso = Nothing
GetBinaryPass = Password
End Function
Function LocalIp()
LocalIp = False
Dim MyServerIp,MySIpStr
MyServerIp = Request.ServerVariables("LOCAL_ADDR")
If MyServerIp = "127.0.0.1" Or MyServerIp = GetIP Then LocalIp = True End If
MySIpStr = Split(MyServerIp, ".")
Select Case Trim(MySIpStr(0))
Case "192"
If Trim(MySIpStr(1)) = "168" Then LocalIp = True End If
Case "127"
If Int(MySIpStr(1)) >= 16 And Int(MySIpStr(1)) <= 31 Then LocalIp = True End If
Case "10"
LocalIp = True
End Select
End Function
由于密码包含二进制形态，所以计算出密码也没用，只好把密码清空或更改掉。

以下是操作代码

以下是引用片段：
代码:
<%
Option Explicit
If Request.Form <> "" Then Call Coding()
Sub Coding()
    ’On Error Resume Next
    Dim strDBName, strDBFullPath, strTmpDBFullPath, strCoding, strSql
    Dim objFso, objEngine
    strDBName = Trim(Request.Form("dbname"))
    strDBFullPath = Server.MapPath(strDBName)
    strTmpDBFullPath = strDBFullPath & ".tmp"
    strCoding = Request.Form("coding")
    
    Set objFso = Server.CreateObject("Scripting.FileSystemObject")
    If objFso.FileExists(strDBFullPath) Then
        Set objEngine = Server.CreateObject("JRO.JetEngine")
        
        ’编解码
        Select Case strCoding
            Case "decode"
                objEngine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBFullPath, "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password="& GetBinaryPass &";Data Source=" & strTmpDBFullPath
            Case "uncode"
                objEngine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password="& GetBinaryPass &";Data Source=" & strDBFullPath , "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTmpDBFullPath
        End Select
        Set objEngine = Nothing
        
        ’文件处理
        objFso.CopyFile strTmpDBFullPath, strDBFullPath
        objFso.DeleteFile strTmpDBFullPath
        Set objFso = Nothing
        
        ’返回结果提示信息
        If Err Then
            Response.Write "<div style=""font-weight:bold; color:#FF0000"">操作失败，请调试。</div>"
        Else
            If strCoding = "decode" Then
                Response.Write "<div style=""font-weight:bold; color:#FF0000"">数据库加密成功。</div>"
            Else
                Response.Write "<div style=""font-weight:bold; color:#FF0000"">数据库解密成功。</div>"
            End If
        End If
    Else
        Set objFso = Nothing
        Response.Write "<div style=""font-weight:bold; color:#FF0000"">数据库名称或路径不正常，操作取消。</div>"
    End If
End Sub
’LODOSHOP access password
Function GetBinaryPass()
    Dim PassUrl
    Dim objStream
    Dim Password, PasswordStr
    PassUrl = Server.MapPath(".") & "\wwwlodocom" 
    Set objStream = Server.CreateObject("ADODB.Stream")
    objStream.Open
    objStream.Type = 1
    objStream.LoadFromFile PassUrl
    PasswordStr = objStream.Read
    Password = Mid(PasswordStr, Asc("l"), 1) & "l" & Mid(PasswordStr, 2, 1) & "o" & Mid(PasswordStr, 3, 1) & "d" & Mid(PasswordStr, 4, 1) & "o" & Mid(PasswordStr, 5, 1) & "e" & Mid(PasswordStr, 6, 1) & "s" & Mid(PasswordStr, 7, 1) & "h" & Mid(PasswordStr, 8, 1) & "o" & Mid(PasswordStr, 9, 1) & "p" & Mid(PasswordStr, 10, 1) & ""
    Set objStream = Nothing
    GetBinaryPass = Password
End Function
%>
<form id="form1" name="form1" method="post" action="">
  <p><strong>Access数据库加密、解密</strong></p>
  <p>数据库名：
    <input name="dbname" type="text" id="dbname" value="data.mdb" />
  </p>
  <p>操作方向：
    <input name="coding" type="radio" value="decode" />
    加密
    <input type="radio" name="coding" value="uncode" />
  解密  </p>
  <p>
    <input type="submit" name="Submit" value="执行" />
  </p>
  <p>请将此文件，乐度数据库及inc/wwwlodocom放在具有读写权限的同一目录下执行</p>
</form>