程式師世界 >> 數據庫知識 >> Access數據庫 >> 關於Access數據庫 >> 反查ACC數據庫的密碼？

反查ACC數據庫的密碼？

編輯：關於Access數據庫

以下是Html網頁特效代碼，點擊運行按鈕可查看效果：以下是程序代碼 <html> <head> <title>Encode解密</title> <meta http-equiv="Content-Type" content="text/Html; charset=gb2312"> <script language="Javascript">  </script> </head> <body> <div class="div"> <span class="title">腳本加密與解密</span> <FORM METHOD="post"> <textarea name="codeinput" cols="55" rows="10"></textarea><br><br> <input type="button" value="Encode加密" onclick="this.form.codeinput.value=screncode(this.form.codeinput.value,'JS')"> <input type="button" value="Encode解密" onclick="this.form.codeinput.value=strdec(this.form.codeinput.value)"> <br> <p style="width:100%;padding:0 40px;text-align:left">說明：加密時應只加密腳本部分，不加密腳本標記<script language="Javascript">，並且加密後腳本標記應改為：<script language="JScript.Encode"></p> <INPUT TYPE="button" VALUE="返回" onClick="window.history.go(-1)" style="background-color: #8000FF; color: rgb(255,255,255)"> </form> </div> <br> </body> </Html></font> <a href="http://js.alixixi.com/">歡迎訪問阿裡西西網頁特效代碼站，JS.alixixi.com</a>

[Ctrl+A 全部選擇提示：你可先修改部分代碼，再按運行]

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 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>