unit1.pas

获取OICQ当前用户保存在本地的密码的程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, WizardCtrl, ExtCtrls, RzLabel, TFlatHintUnit,shellapi,
  AHMSystemClass, AHMTFormExplode, AHMTStickyLabel, Mask, AHMTLookupEdit,
  AHMTFolderLookup, RzLnEdit, AHMControls, AHMTOfficeButton;

type
  TForm1 = class(TForm)
    WizardCtrl1: TWizardCtrl;
    Notebook1: TNotebook;
    StringGrid: TStringGrid;
    Image1: TImage;
    Image2: TImage;
    RzLabel1: TRzLabel;
    RzLabel2: TRzLabel;
    RzLabel3: TRzLabel;
    RzURLLabel1: TRzURLLabel;
    FlatHint1: TFlatHint;
    RzURLLabel2: TRzURLLabel;
    RzURLLabel3: TRzURLLabel;
    AHMFormExplode1: TAHMFormExplode;
    AHMFolderLookup1: TAHMFolderLookup;
    RzLabel4: TRzLabel;
    AHMOfficeButton1: TAHMOfficeButton;
    Edit1: TRzLineEdit;
    Function HexToDec(const Value :string) : integer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure WizardCtrl1CancelClick(Sender: TObject);
    procedure WizardCtrl1HelpClick(Sender: TObject);
    procedure AHMOfficeButton1Click(Sender: TObject);
    procedure WizardCtrl1FinishClick(Sender: TObject);


  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Function Tform1.HexToDec(const Value :string) : integer;
CONST HEX : ARRAY['A'..'F'] OF INTEGER = (10,11,12,13,14,15);
VAR
  str : String;
  Int : Integer;
  i : integer;
BEGIN
  Str := UpperCase(Value);
  Int := 0;
  FOR i := 1 TO Length(str) DO
    IF str[i] < 'A' THEN
    Int := Int * 16 + ORD(str[i]) - 48
  ELSE
    Int := Int * 16 + HEX[str[i]];
  Result := Int;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid.ClientWidth := StringGrid.ColCount * (StringGrid.DefaultColWidth + 1);
  StringGrid.ClientHeight := StringGrid.RowCount * (StringGrid.DefaultRowHeight + 1);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then Close;
end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  S: string;
  W, H: Integer;
begin
  W := Rect.Right - Rect.Left +1;
  H := Rect.Bottom - Rect.Top + 1;
  with Sender as TStringGrid do
  begin
    S := Chr((ARow + 2) * 16 + ACol );
    Canvas.TextOut(Rect.Left + W div 2 - Canvas.TextWidth(S) div 2, Rect.Top + H div 2 - Canvas.TextHeight(S) div 2, S);
  end;
end;

procedure TForm1.WizardCtrl1CancelClick(Sender: TObject);
begin
close;
end;

procedure TForm1.WizardCtrl1HelpClick(Sender: TObject);
begin
ShellExecute(handle,nil,('mailto:[e-mail]'),nil,nil,sw_shownormal);
end;

procedure TForm1.AHMOfficeButton1Click(Sender: TObject);
var
  i,f1,len,asinum: integer;
  str,strhex: string;
begin
if (AHMFolderLookup1.Text<>'') or (fileexists(AHMFolderLookup1.Text+'\dat\oicq2000.cfg')) then
  begin
    edit1.Text:='';
    try
    f1 := fileopen(AHMFolderLookup1.Text+'\dat\oicq2000.cfg', fmOpenRead);
    if f1 > 0 then
    begin
      len := fileseek(f1, 0, 2);
      fileseek(f1, 0, 0);
      str := stringofchar(#0, len);
      fileread(f1, str[1], len);
      fileclose(f1);
     for i:=9 to (HexToDec(format('%x',[ord(str[5])]))+9) do
      begin
      strhex:=format('%x',[ord(str[i])]);
      asinum:=255-HexToDec(strhex);
      edit1.Text:=edit1.Text+chr(asinum);
      end;
    end;      
    except
      showmessage('暂时无法处理密码文件！请联系作者。');
      exit;
    end;
  end
  else
  begin
    showmessage('无法定位OICQ目录！请重新选择！');
    exit;
  end;
end;

procedure TForm1.WizardCtrl1FinishClick(Sender: TObject);
begin
close;
end;

end.