www.pudn.com > oicq2kpass.zip > Unit1.pas

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:tingweb@wx88.net'),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.