unit1.pas

通过发送数据到破解md5的网站,实现md5在线破解,本程序支持市面上大多md5网站.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, ExtCtrls, ComCtrls, Buttons, Menus, XPMan,
  CommCtrl, MD5Cracker, ClipBrd, ImgList, IniFiles;

type
  TfrmMain = class(TForm)
    sbStatus: TStatusBar;
    Panel1: TPanel;
    gbCracker: TGroupBox;
    clbCracker: TCheckListBox;
    btnCheckAll: TBitBtn;
    btnUncheckAll: TBitBtn;
    gbSettings: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    chkSaveHashlists: TCheckBox;
    udThreads: TUpDown;
    udTimeout: TUpDown;
    btnAbout: TBitBtn;
    btnStart: TBitBtn;
    btnStop: TBitBtn;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Splitter1: TSplitter;
    lvCracked: TListView;
    lvUncracked: TListView;
    popUncracked: TPopupMenu;
    mnuAddUncracked: TMenuItem;
    mnuEditUncracked: TMenuItem;
    N1: TMenuItem;
    mnuCopyUncracked: TMenuItem;
    mnuPasteUncracked: TMenuItem;
    N2: TMenuItem;
    mnuDeleteUncracked: TMenuItem;
    mnuClearUncracked: TMenuItem;
    N3: TMenuItem;
    mnuSortRemoveDuplicatedUncracked: TMenuItem;
    popCracked: TPopupMenu;
    mnuCopy: TMenuItem;
    mnuCopyMD5Hash: TMenuItem;
    mnuCopyPlainText: TMenuItem;
    N4: TMenuItem;
    mnuCopyBoth: TMenuItem;
    mnuSave: TMenuItem;
    mnuLoadUncracked: TMenuItem;
    N5: TMenuItem;
    mnuSaveUncracked: TMenuItem;
    mnuSaveMD5Hashes: TMenuItem;
    mnuSavePlainTexts: TMenuItem;
    N6: TMenuItem;
    mnuSaveBoth: TMenuItem;
    N7: TMenuItem;
    mnuDeleteCracked: TMenuItem;
    mnuClearCracked: TMenuItem;
    N8: TMenuItem;
    mnuSortRemoveDuplicatedCracked: TMenuItem;
    XPManifest1: TXPManifest;
    pbProgress: TProgressBar;
    imgIIcons: TImageList;
    mnuRemoveNotCrackedUncracked: TMenuItem;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    chkAutoscroll: TCheckBox;
    procedure FormResize(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
    procedure btnCheckAllClick(Sender: TObject);
    procedure btnUncheckAllClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure mnuPasteUncrackedClick(Sender: TObject);
    procedure popUncrackedPopup(Sender: TObject);
    procedure lvUncrackedInsert(Sender: TObject; Item: TListItem);
    procedure lvUncrackedDeletion(Sender: TObject; Item: TListItem);
    procedure lvCrackedDeletion(Sender: TObject; Item: TListItem);
    procedure lvCrackedInsert(Sender: TObject; Item: TListItem);
    procedure popCrackedPopup(Sender: TObject);
    procedure mnuAddUncrackedClick(Sender: TObject);
    procedure mnuEditUncrackedClick(Sender: TObject);
    procedure mnuLoadUncrackedClick(Sender: TObject);
    procedure mnuSaveUncrackedClick(Sender: TObject);
    procedure mnuCopyUncrackedClick(Sender: TObject);
    procedure mnuDeleteUncrackedClick(Sender: TObject);
    procedure mnuClearUncrackedClick(Sender: TObject);
    procedure mnuRemoveNotCrackedUncrackedClick(Sender: TObject);
    procedure mnuSortRemoveDuplicatedUncrackedClick(Sender: TObject);
    procedure mnuCopyMD5HashClick(Sender: TObject);
    procedure mnuCopyPlainTextClick(Sender: TObject);
    procedure mnuCopyBothClick(Sender: TObject);
    procedure mnuSaveMD5HashesClick(Sender: TObject);
    procedure mnuDeleteCrackedClick(Sender: TObject);
    procedure mnuClearCrackedClick(Sender: TObject);
    procedure mnuSortRemoveDuplicatedCrackedClick(Sender: TObject);
    procedure mnuSavePlainTextsClick(Sender: TObject);
    procedure mnuSaveBothClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    bStop, bStarted: Boolean;
    iIndex, iThreads, iMax, iDone: Integer;
    sCracker: String;
    procedure Cracked(Sender: TObject);
    procedure NotCracked(Sender: TObject);
    procedure ChangeCracker(Sender: TObject);
    procedure Init(const bFlag: Boolean);
    procedure MakeThread();
    procedure TryNext;
    function GetCracker: String;
    procedure RemoveCracked;
    //procedure AddUncracked(const s: String);
    procedure LoadUncracked(const s: String);
    function SaveLV(const LV: TListView; const s: String; const bAppend: Boolean): Boolean;
    procedure RemoveDuplicates(const LV: TListView);
    //procedure AddCracked(const sMD5, sPlain: String);
    procedure LoadCracked;
    procedure SaveCracked;
  public
    { Public-Deklarationen }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure Split(const Delimiter: Char; const Input: string; const Strings: TStrings) ;
begin
  Assert(Assigned(Strings));
  Strings.Clear;
  Strings.Delimiter := Delimiter;
  Strings.DelimitedText := Input;
end;

function IsValidMD5Hash(const s: String): Boolean; Inline;
var
  i, l: Integer;
begin
  Result := True;
  l := Length(s);
  if l <> 32 then
  begin
    Result := False;
    Exit;
  end;
  for i := 1 to l do
    if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
    begin
      Result := False;
      Break;
    end;
end;

function AppPath: String; Inline;
begin
  Result := ExtractFilePath(Application.Exename);
end;

function TfrmMain.SaveLV(const LV: TListView; const s: String; const bAppend: Boolean): Boolean;
var
  t: TextFile;
  i: Integer;
begin
  AssignFile(t, s);
  try
    if bAppend then Append(t) else ReWrite(t);
    try
      for i := 0 to Pred(LV.Items.Count) do
        WriteLn(t, LV.Items[i].Caption);
    finally
      CloseFile(t);
      Result := True;
    end;
  except
    Result := False;
  end;
end;

procedure AddUncracked(const s: String); Inline;
begin
  with frmMain.lvUncracked.Items.Add do
  begin
    Caption := s;
    SubItems.Add('');
    ImageIndex := 1;
  end;
end;

procedure TfrmMain.LoadUncracked(const s: String);
var
  t: TextFile;
  sLine: String;
begin
  AssignFile(t, s);
  try
    ReSet(t);
    try
      while not EOF(t) do
      begin
        ReadLn(t, sLine);
        if IsValidMD5Hash(sLine) then AddUncracked(sLine);
      end;
    finally
      CloseFile(t);
    end;
  except
    //
  end;
end;

procedure TfrmMain.RemoveDuplicates(const LV: TListView);
var
  i: Integer;
begin
  LV.Items.BeginUpdate;
  LV.SortType := stText;
  try
    for i := LV.Items.Count - 2 downto 0 do
      if SameText(LV.Items[i].Caption, LV.Items[i + 1].Caption) then LV.Items.Delete(i);
  finally
    LV.SortType := stNone;
    LV.Items.EndUpdate;
  end;
end;

procedure TfrmMain.RemoveCracked;
var
  i: Integer;
begin
  lvUncracked.Items.BeginUpdate;
  try
    for i := Pred(lvUncracked.Items.Count) downto 0 do
      if lvUncracked.Items[i].SubItems[0] = 'Cracked' then
        lvUncracked.Items.Delete(i);
  finally
    lvUncracked.Items.EndUpdate;
  end;
end;

procedure TfrmMain.TryNext;
begin
  if (iIndex <= Pred(iMax)) and (not bStop) then
  begin
    pbProgress.Position := Succ(iIndex);
    sbStatus.Panels[3].Text := 'Working... ' + IntToStr(Succ(iIndex)) + ' of ' + IntToStr(iMax) + ' Hash(es) done (' + IntToStr(Round((Succ(iIndex) / iMax) * 100)) + '%)';
    MakeThread;
    if chkAutoscroll.Checked then lvUncracked.Items[iIndex].MakeVisible(True);
    Inc(iIndex);
  end else
    if iDone >= Pred(iThreads) then
    begin
      RemoveCracked;
      Init(True);
      Application.MessageBox('Crack complete!', 'Info', MB_ICONINFORMATION);
    end else
    begin
      sbStatus.Panels[3].Text := 'Completing... ' + IntToStr(Pred(iThreads - iDone)) + ' Thread(s) remaining';
      Inc(iDone);
    end;
end;

function TfrmMain.GetCracker: String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Pred(clbCracker.Items.Count) do
    if clbCracker.Checked[i] then
      Result := Result + clbCracker.Items[i] + ',';
end;

procedure TfrmMain.Init(const bFlag: Boolean);
begin
  gbCracker.Enabled := bFlag;
  gbSettings.Enabled := bFlag;
  btnAbout.Enabled := bFlag;
  if bFlag then
  begin
    btnStop.Enabled := False;
    btnStart.Enabled := True;
    sbStatus.Panels[3].Text := 'Ready';
    pbProgress.Position := 0;
  end else
  begin
    btnStop.Enabled := True;
    btnStart.Enabled := False;
  end;
  iIndex := 0;
  iDone := 0;
  bStop := bFlag;
  bStarted := not bFlag;
end;

procedure TfrmMain.MakeThread();
var
  Cracker: TMD5Cracker;
begin
  Cracker := TMD5Cracker.Create(lvUncracked.Items[iIndex].Caption, sCracker, udTimeout.Position, iIndex);
  with Cracker do
  begin
    FreeOnTerminate := True;
    OnCracked := Cracked;
    OnNotCracked := NotCracked;
    OnChangeCracker := ChangeCracker;
    Resume;
  end;
end;

procedure AddCracked(const sMD5, sPlain: String); Inline;
begin
  with frmMain.lvCracked.Items.Add do
  begin
    Caption := sMD5;
    SubItems.Add(sPlain);
    ImageIndex := 0;
  end;
end;

procedure TfrmMain.LoadCracked;
var
  t: TextFile;
  sLine: String;
  iPos: Integer;
begin
  AssignFile(t, AppPath + 'cracked.txt');
  try
    ReSet(t);
    try
      while not EOF(t) do
      begin
        ReadLn(t, sLine);
        iPos := Pos(':', sLine);
        if iPos > 0 then
          AddCracked(Copy(sLine, 1, Pred(iPos)), Copy(sLine, Succ(iPos), Length(sLine)));
      end;
    finally
      CloseFile(t);
    end;
  except
    //
  end;
end;

procedure TfrmMain.SaveCracked;
var
  t: TextFile;
  i: Integer;
begin
  AssignFile(t, AppPath + 'cracked.txt');
  try
    ReWrite(t);
    try
      for i := 0 to Pred(lvCracked.Items.Count) do
        WriteLn(t, lvCracked.Items[i].Caption + ':' + lvCracked.Items[i].SubItems[0]);
    finally
      CloseFile(t);
    end;
  except
    //
  end;
end;