uaccesstool.pas

ACCESS 数据库管理工具

unit uAccessTool;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj;
(*文件是否正在使用*)
const
  ENC_KEY = 'zqs+3#&@lph(g3=22_;2t|q8a/zfc>}s';
function IsFileInUse(sFileName: string): Boolean;
(*取得Access数据库文件密码*)
function GetAccessPwd(sFileName: string; var sPWD: string): Boolean;
(*检查Access数据库文件是否正在使用,如果不在使用,则开始破解文件,否则使用AYYSC.txt文件读取数据库密码*)
function GetAccessPwdExt(sFileName: string; var sPWD: string): Boolean;
(*压缩并加密或修改数据库密码*)
function PackDataBase(sFileName: string; OldPass: string; Pass: string): Boolean;
function PackDataBaseExt(sFileName: string; OldPass: string; Pass: string): Boolean;
implementation

function IsFileInUse(sFileName: string): Boolean;
var
  HFileRes: HFILE;
begin
  result := false;
  if not FileExists(sFileName) then
    Exit;
  HFileRes := CreateFile(pChar(sFileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  result := (HFileRes = INVALID_HANDLE_VALUE);
  if not result then
    CloseHandle(HFileRes);
end;

function PackDataBaseExt(sFileName: string; OldPass: string; Pass: string): Boolean;
begin
  result := false;
  if IsFileInUse(sFileName) then (*如果文件正在使用,由于压缩数据库要独占*)
    Exit;
  result := PackDataBase(sFileName, OldPass, Pass);
end;

function PackDataBase(sFileName: string; OldPass: string; Pass: string): Boolean;
const
  SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
    + 'Jet OLEDB:Database Password=%s;';
var
  sPath, SFile: array[0..254] of Char;
  STempFileName: string;
  JE: OLEVariant;
begin
  //GetTempPath(40, sPath); //取得Windows的Temp路径
  //GetTempFileName(sPath, '~CP', 0, SFile); //取得Temp文件名,Windows将自动建立0字节文件
  //STempFileName := SFile ; //PChar->String
  STempFileName := sFileName + '~CP';
  DeleteFile(pChar(STempFileName)); //删除Windows建立的0字节文件
  try
    JE := CreateOleObject('JRO.JetEngine'); //建立OLE对象,函数结束OLE对象超过作用域自动释放
    OleCheck(JE.CompactDatabase(Format(SConnectionString, [sFileName, OldPass]),
      Format(SConnectionString, [STempFileName, Pass]))); //压缩数据库
    //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有到函数的功能
    //result := CopyFile(pChar(STempFileName), pChar(sFileName), false);
    if IsFileInUse(sFileName) then
      Exit;
    if FileExists(sFileName + 'BK') then
      deleteFile(sFileName + 'BK');
    RenameFile(sFileName, sFileName + 'BK');
    RenameFile(STempFileName, sFileName);
    Result := True;
    //DeleteFile(pChar(STempFileName)); //删除临时文件
  except
    result := false; //压缩失败
  end;
end;

function HexToInt(AHex: string): integer;
begin
  result := StrToInt( '0x'+ AHex );
end;

{*******************************************************************************
名称:EncStr
描述:字符串加密函数
参数:AStr: string  需要加密的字符串
     ENC_KEY: string 密匙
返回:String   加密后得到的字符串
日期:2003-07-31
作者:
修改:
*******************************************************************************}

function EncStr(AStr, ENC_KEY: string): string;
var
  i: integer;
  LongKey: string;
  TmpStr: string;
begin
  result := '';
  for i := 0 to (Length(AStr) div Length(ENC_KEY)) do
    LongKey := LongKey + ENC_KEY;
  for i := 1 to Length(AStr) do
  begin
    TmpStr := IntToHex((Ord(AStr[i]) xor Ord(LongKey[i])), 2);
    result := result + TmpStr;
  end;
end;

{*******************************************************************************
名称:DecStr
描述:字符串解密函数
参数:AStr: string  需要解密的字符串
     ENC_KEY: string 密匙
返回:String   解密后得到的字符串
日期:2003-07-31
作者:
修改:
*******************************************************************************}

function DecStr(AStr, ENC_KEY: string): string;
var
  i: integer;
  LongKey: string;
  TmpStr: string;
begin
  result := '';
  for i := 0 to (Length(AStr) div Length(ENC_KEY)) do
    LongKey := LongKey + ENC_KEY;
  for i := 1 to (Length(AStr) div 2) do
    TmpStr := TmpStr + Chr(HexToInt(Copy(AStr, i * 2 - 1, 2)));
  for i := 1 to Length(TmpStr) do
    result := result + Chr((Ord(TmpStr[i]) xor Ord(LongKey[i])));
end;



function GetAccessPwdExt(sFileName: string; var sPWD: string): Boolean;
var Ms: TStringList;
begin
  Ms := TStringList.Create;
  if IsFileInUse(sFileName) then (*如果文件正在使用,使用AYYSC.txt文件读取数据库密码*)
  begin
    if FileExists(ExtractFilePath(sFileName) + 'AYYSC.TXT') then
    begin
    end
    else
    begin
      Ms.Clear;
      Ms.SaveToFile(ExtractFilePath(sFileName) + 'AYYSC.TXT');
    end;
    Ms.LoadFromFile(ExtractFilePath(sFileName) + 'AYYSC.TXT');
    if Ms.Text = '' then
      sPWD := ''
    else
      sPWD := DecStr(Ms.Strings[0], ENC_KEY);
    result := True;
  end
  else (*如果文件不在使用,读取数据库密码*)
  begin
    result := GetAccessPwd(sFileName, sPWD);
    if result then
    begin
      Ms.Clear;
      Ms.Text := EncStr(sPWD, ENC_KEY);
      Ms.SaveToFile(ExtractFilePath(sFileName) + 'AYYSC.TXT');
    end;
  end;
  freeandnil(Ms);
end;

function GetAccessPwd(sFileName: string; var sPWD: string): Boolean;
const
 //2079-06-05前  [EC37  9CFA  28E6  8A60  7B36  DFB1  1343  B133  795B  7C2A ]
//2079-06-05后  [ED37  9DFA  29E6  8B60  7A36  DEB1  1243  B033  785B  7D2A ]
{ 固定密钥 }
  InhereCode: array[0..9] of Word =
  ($37EC, $FA9C, $E628, $608A, $367B, $B1DF, $4313, $33B1, $5B79, $2A7C);

{  活动密钥 }
  UserCode8: array[0..9] of Word = //89年9月17日前
  ($8B86, $345D, $2EC6, $C613, $E454, $02F5, $8477, $DFCF, $1134, $C592);
  UserCode: array[0..9] of Word = //89年9月17日后
  ($7B86, $C45D, $DEC6, $3613, $1454, $F2F5, $7477, $2FCF, $E134, $3592);

  InCode97: array[0..19] of byte = //Access 97 固定密钥
  ($86, $FB, $EC, $37, $5D, $44, $9C, $FA, $C6, $5E,
    $28, $E6, $13, $00, $00, $00, $00, $00, $00, $00);
var sPassCode: string;
  Stream: TFileStream;
  i, n: integer;
  TP: TSearchRec;
  WTime: TDateTime;
  WSec: DWord;
  M, S: string;
  Buf: array[0..200] of byte;
  Date0: TDateTime;
  Date1: TDateTime;
  Date2: TDateTime;
  DateStr: DWord;
  //PassCode: WideString;
  EncodeArray: array[0..19] of Word;
  ReaderArray: array[0..19] of Word;

const
  XorStr = $823E6C94;
begin
  result := false;
  try
    sPWD := '';
    FindFirst(sFileName, faAnyFile, TP);
    Stream := TFileStream.Create(sFileName, fmOpenReadWrite);
    Stream.Seek($00, 00); Stream.Read(Buf[0], 200);
    if Buf[$14] = 0 then begin
      sPassCode := '';
      Stream.Seek($42, 00); Stream.Read(Buf[0], 20);
      for i := 0 to 19 do
        sPassCode := sPassCode + Chr(Buf[i] xor InCode97[i]);
      sPWD := sPassCode;
      Exit; // 按Access97版本处理
    end;

    Date0 := EncodeDate(1978, 7, 01);
    Date1 := EncodeDate(1989, 9, 17);
    Date2 := EncodeDate(2079, 6, 05);

    Stream.Seek($42, 00); Stream.Read(ReaderArray[0], 40);
    Stream.Seek($75, 00); Stream.Read(DateStr, 4);
    Stream.Free;
    for i := $42 to $42 + 55 do begin
      if i = $72 then M := '-' else M := '';
      S := S + #32 + M + IntToHex(Buf[i], 2);
    end;
    delete(S, 1, 1);
    if (DateStr >= $90000000) and (DateStr < $B0000000) then begin
      WSec := DateStr xor $903E6C94;
      WTime := Date2 + WSec / 8192 * 2;
    end else begin
      WSec := DateStr xor $803E6C94;
      WTime := Date1 + WSec / 8192;
      if WSec and $30000000 <> 0 then begin
        WSec := $40000000 - WSec;
        WTime := Date1 - WSec / 8192 / 2;
      end;
    end;
    if WTime < Date1 then begin
      for i := 0 to 9 do begin
        EncodeArray[i * 2] := (Trunc(WTime) - Trunc(Date0)) xor UserCode[i] xor $F000;
      // Xor $F000 就是“高位取反”
        EncodeArray[i * 2 + 1] := InhereCode[i];
      end;
    end;
    if (WTime >= Date1) and (WTime < Date2) then begin
      for i := 0 to 9 do begin
        EncodeArray[i * 2] := (Trunc(WTime) - Trunc(Date1)) xor UserCode[i];
        EncodeArray[i * 2 + 1] := InhereCode[i];
      end;
    end;
    if WTime >= Date2 then begin
      for i := 0 to 9 do begin
        EncodeArray[i * 2] := (Trunc(WTime) - Trunc(Date1)) xor UserCode[i];
        EncodeArray[i * 2 + 1] := InhereCode[i] xor 1;
      // Xor 1 就是“末位取反”
      end;
    end;
    sPassCode := '';
    for i := 0 to 19 do begin
      n := EncodeArray[i] xor ReaderArray[i];
      if n <> 0 then sPassCode := sPassCode + WideChar(n);
    end;
    sPWD := sPassCode;
    result := True;
  except
  end;
end;
end.