uaccessmoduleform.pas

Delphi函数工厂。。。。。。。。。。。。。

unit uAccessModuleForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, uCustomModuleForm, StdCtrls, Buttons, ComObj, ActiveX; // , Graphics

type
  PassType = record
    PassCode: string;
    FileType: string;
    FileTime: TDateTime;
  end;
  TAccessDialog = class;
  TAccessModuleForm = class(TCustomModuleForm)
    edtFileName: TEdit;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    edtGetPassWord: TEdit;
    Label2: TLabel;
    OpenDialog1: TOpenDialog;
    GroupBox1: TGroupBox;
    edtPassWord: TEdit;
    Label3: TLabel;
    chThisProgram: TCheckBox;
    bbtnCompress: TButton;
    bbtnOpen: TButton;
    lblHint: TLabel;
    Label4: TLabel;
    procedure bbtnOpenClick(Sender: TObject);
    procedure edtFileNameChange(Sender: TObject);
    procedure bbtnCompressClick(Sender: TObject);
    procedure chThisProgramClick(Sender: TObject);
  private
    { Private declarations }
    AccessDialog: TAccessDialog;
    function ExecFile(FName: string): PassType;
  public
    { Public declarations }
  end;

  TAccessDialog = class(TCustomModuleDialog)
  private
    FModuleForm: TAccessModuleForm;
    FPageIndex: Integer;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;

  published
    property PageIndex: Integer read FPageIndex write FPageIndex
      default 0;
  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);
  InhereCode2: array[0..9] of Word =
  ($37ED, $FA9D, $E629, $608B, $367A, $B1DE, $4312, $33B0, $5B78, $2A7D);

//  用户密码区域 }
//  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 =
  ($86, $FB, $EC, $37, $5D, $44, $9C, $FA, $C6, $5E,
    $28, $E6, $13, $00, $00, $00, $00, $00, $00, $00);
var
  AccessModuleForm: TAccessModuleForm;

implementation
{$R *.dfm}

resourcestring
  SDefultAccessDialogTitle = 'Access工具';
{ TMessageBoxDialog}

constructor TAccessDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FModuleForm := TAccessModuleForm.Create(Self);
  FModuleForm.AccessDialog := Self;
  FModuleForm.FDialogModule := Self;
  FModuleForm.Caption := SDefultAccessDialogTitle;
  FWindowForm := FModuleForm;
  FPageIndex := 0;
end;

destructor TAccessDialog.Destroy;
begin
  if FModuleForm.Visible then FModuleForm.Close;
  FModuleForm.Free;
  inherited Destroy;
end;

function TAccessDialog.Execute: Boolean;
begin
  inherited Execute;
  Result := FModuleForm.ShowModal = mrOK;
end;

function TAccessModuleForm.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
  BaseDate: DWord;
  PassCode: string;
  InhereArray: array[0..19] of Word;
  ReaderArray: array[0..19] of Word;
  Stream: TFileStream;
  i, n: integer;
  TP: TSearchRec;
  FT: TDateTime;
  WTime: TDateTime;
  WSec: DWord;
  M, S: string;
  Buf: array[0..200] of byte;
  Date0: TDateTime;
  Date1: TDateTime;
  Date2: TDateTime;
const
  XorStr = $823E6C94;
begin
  if FindFirst(FName, faAnyFile, TP) = 0 then
    FindClose(TP);
  // awen add （保证释放FindFile句柄和资源)
  FT := CovTime(TP.FindData.ftCreationTime);

  Stream := TFileStream.Create(FName, fmOpenRead or fmShareDenyNone);
  // awen modify (让程序能在任何情况下——即使文件正在被使用——都能打开它
  // 不过如果数据库是以独占方式被Access打开了的话，本程序就无法打开了。)
  
  try // awen add (如果不加入try块的话，对97版解密后不会执行Stream.free语句)
  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 := FT;
    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(BaseDate, 4);
  finally // awen add
  Stream.Free;
  end; // awen add

  S := format('文件：%s，[', [FName]);
  for i := $42 to $42 + 55 do
  begin
    if i = $72 then
      M := '-'
    else
      M := '';
    S := S + #32 + M + IntToHex(Buf[i], 2);
  end;
  S := '';
  if (BaseDate >= $90000000) and (BaseDate < $B0000000) then
  begin
    WSec := BaseDate xor $903E6C94;
    WTime := Date2 + WSec / 8192 * 2;
  end
  else
  begin
    WSec := BaseDate 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 //89年9月17日前
//    if FName = 'db96.mdb' then Showmessage(inttostr(BaseDate));
    S := '917前';
    for i := 0 to 9 do
    begin
      InhereArray[i * 2] := (Trunc(WTime) - Trunc(Date0)) xor UserCode[i] xor $F000;
      InhereArray[i * 2 + 1] := InhereCode[i];
    end;
  end
  else
  begin //89年9月17日后
    S := '917后';
    if WTime >= Date2 then
    begin //2076.6.5之后
      for i := 0 to 9 do
      begin
        InhereArray[i * 2] := (Trunc(WTime) - Trunc(Date1)) xor UserCode[i];
        InhereArray[i * 2 + 1] := InhereCode2[i];
      end;
    end
    else
    begin //2076.6.5之前
      for i := 0 to 9 do
      begin
        InhereArray[i * 2] := (Trunc(WTime) - Trunc(Date1)) xor UserCode[i];
        InhereArray[i * 2 + 1] := InhereCode[i];
      end;
    end;
  end;
  PassCode := '';
  for i := 0 to 19 do
  begin
    N := InhereArray[i] xor ReaderArray[i];
    if N <> 0 then PassCode := PassCode + Chr(N);
  end;
  Result.FileType := 'ACCESS-2000/XP';  // awen modify (我发现此程序可以解密OfficeXP版的数据库)
  Result.FileTime := WTime;
  Result.PassCode := PassCode;
end;

procedure TAccessModuleForm.bbtnOpenClick(Sender: TObject);
var
  aPassWord: PassType;
begin
  inherited;
  if OpenDialog1.Execute then
  begin
    edtFileName.Text := OpenDialog1.FileName;
    aPassWord := ExecFile(edtFileName.Text);
    edtGetPassWord.Text := aPassWord.PassCode;
    edtPassWord.text := aPassWord.PassCode;
    lblHint.Caption := '该数据库是:' + aPassWord.FileType;
  end;
end;



procedure TAccessModuleForm.edtFileNameChange(Sender: TObject);
begin
  inherited;
  if trim(edtFileName.Text) <> '' then
    bbtnCompress.Enabled := true;
end;



function CompactDatabase(AFileName, APassWord: 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
  DeleteFile(STempFileName); //删除Windows建立的0字节文件
  try
    JE := CreateOleObject('JRO.JetEngine'); //建立OLE对象,函数结束OLE对象超过作用域自动释放
    OleCheck(JE.CompactDatabase(format(SConnectionString, [AFileName, APassWord]),
      format(SConnectionString, [STempFileName, APassWord]))); //压缩数据库
    //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有到函数的功能
    result := CopyFile(PChar(STempFileName), PChar(AFileName), false);
    DeleteFile(STempFileName); //删除临时文件
  except
    result := false; //压缩失败
  end;
end;

procedure TAccessModuleForm.bbtnCompressClick(Sender: TObject);
var
  isok: boolean;
begin
  inherited;
  if chThisProgram.Checked then
    isok := CompactDatabase(ExtractFilePath(Application.ExeName) + 'delphi.dll', 'VB6STKIT.DLLsoftpb')
  else
    isok := CompactDatabase(edtFileName.Text, edtPassword.Text);
  if isok then
    MessageBox(Handle, PChar('操作成功!'), PChar('消息'),
      MB_ICONINFORMATION or MB_OK)
  else
    MessageBox(Handle, PChar('请确认文件是是否正在使用,或密码错误.'), PChar('消息'),
      MB_ICONERROR or MB_OK);
end;

procedure TAccessModuleForm.chThisProgramClick(Sender: TObject);
begin
  inherited;
  edtPassWord.Enabled := not chThisProgram.Checked;
  bbtnCompress.Enabled := chThisProgram.Checked;
end;

end.