unit1.pas

根据网上的几个MD5破解网站

procedure TfrmMain.Cracked(Sender: TObject);
begin
  AddCracked((Sender as TMD5Cracker).MD5, (Sender as TMD5Cracker).Plain);
  //lvUncracked.Items.Delete((Sender as TMD5Cracker).Tag);
  //Dec(iIndex);
  lvUncracked.Items[(Sender as TMD5Cracker).Tag].SubItems[0] := 'Cracked';
  lvUncracked.Items[(Sender as TMD5Cracker).Tag].ImageIndex := 0;
  TryNext;
end;

procedure TfrmMain.NotCracked(Sender: TObject);
begin
  lvUncracked.Items[(Sender as TMD5Cracker).Tag].SubItems[0] := 'Not Cracked';
  TryNext;
end;

procedure TfrmMain.ChangeCracker(Sender: TObject);
begin
  lvUncracked.Items[(Sender as TMD5Cracker).Tag].SubItems[0] := 'Cracking... (' + (Sender as TMD5Cracker).CurrentCracker + ')';
end;

procedure TfrmMain.FormResize(Sender: TObject);
var 
  r: TRect;
begin
  sbStatus.Perform(SB_GETRECT, 2, Integer(@R));
  pbProgress.Parent := sbStatus;
  pbProgress.BoundsRect := r;
end;

procedure TfrmMain.btnAboutClick(Sender: TObject);
begin
  Application.MessageBox('Multi MD5 Online Cracker v0.1' + #13#10 + '...by conteX' + #13#10 + #13#10 + 'Contact:' + #13#10 + 'E-Mail: [e-mail]' + #13#10 + 'ICQ#: 392-828-168', 'About', MB_ICONINFORMATION);
end;

procedure TfrmMain.btnCheckAllClick(Sender: TObject);
var
  i: Integer;
begin
  clbCracker.Items.BeginUpdate;
  try
    for i := 0 to Pred(clbCracker.Items.Count) do
      clbCracker.Checked[i] := True;
  finally
    clbCracker.Items.EndUpdate;
  end;
end;

procedure TfrmMain.btnUncheckAllClick(Sender: TObject);
var
  i: Integer;
begin
  clbCracker.Items.BeginUpdate;
  try
    for i := 0 to Pred(clbCracker.Items.Count) do
      clbCracker.Checked[i] := False;
  finally
    clbCracker.Items.EndUpdate;
  end;
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
  bStop := True;
  btnStop.Enabled := False;
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
var
  i: Integer;
begin
  if lvUncracked.Items.Count = 0 then
  begin
    Application.MessageBox('No uncracked hash(es) found!', 'Info', MB_ICONINFORMATION);
    Exit;
  end;
  sCracker := GetCracker;
  if sCracker = '' then
  begin
    Application.MessageBox('You must select al least one cracker to use!', 'Info', MB_ICONINFORMATION);
    Exit;
  end;
  Init(False);
  iMax := lvUncracked.Items.Count;
  pbProgress.Max := iMax;
  if lvUncracked.Items.Count > udThreads.Position then
    iThreads := udThreads.Position
  else
    iThreads := lvUncracked.Items.Count;
  for i := 1 to iThreads do
  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;
end;

procedure TfrmMain.mnuPasteUncrackedClick(Sender: TObject);
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    Split(#13, ClipBoard.AsText, sl);
    lvUncracked.Items.BeginUpdate;
    try
      if sl.Count > 0 then
        for i := 0 to Pred(sl.Count) do
          if IsValidMD5Hash(sl[i]) then AddUncracked(sl[i]);
    finally
      lvUncracked.Items.EndUpdate;
    end;
  finally
    sl.Free;
  end;
end;

procedure TfrmMain.popUncrackedPopup(Sender: TObject);
begin
  mnuAddUncracked.Enabled := not bStarted;
  mnuEditUncracked.Enabled := (lvUncracked.SelCount > 0) and (not bStarted);
  mnuLoadUncracked.Enabled := not bStarted;
  mnuSaveUncracked.Enabled := (lvUncracked.SelCount > 0) and (not bStarted);
  mnuCopyUncracked.Enabled := lvUncracked.SelCount > 0;
  mnuPasteUncracked.Enabled := (ClipBoard.AsText <> '') and (not bStarted);
  mnuDeleteUncracked.Enabled := (lvUncracked.SelCount > 0) and (not bStarted);
  mnuClearUncracked.Enabled := (lvUncracked.Items.Count > 0) and (not bStarted);
  mnuSortRemoveDuplicatedUncracked.Enabled := (lvUncracked.Items.Count > 1) and (not bStarted);
  mnuRemoveNotCrackedUncracked.Enabled := (lvUncracked.Items.Count > 0) and (not bStarted);
end;

procedure TfrmMain.lvUncrackedInsert(Sender: TObject; Item: TListItem);
begin
  sbStatus.Panels[0].Text := 'Uncracked: ' + IntToStr(lvUncracked.Items.Count);
end;

procedure TfrmMain.lvUncrackedDeletion(Sender: TObject; Item: TListItem);
begin
  sbStatus.Panels[0].Text := 'Uncracked: ' + IntToStr(Pred(lvUncracked.Items.Count));
end;

procedure TfrmMain.lvCrackedDeletion(Sender: TObject; Item: TListItem);
begin
  sbStatus.Panels[1].Text := 'Cracked: ' + IntToStr(Pred(lvCracked.Items.Count));
end;

procedure TfrmMain.lvCrackedInsert(Sender: TObject; Item: TListItem);
begin
  sbStatus.Panels[1].Text := 'Cracked: ' + IntToStr(lvCracked.Items.Count);
end;

procedure TfrmMain.popCrackedPopup(Sender: TObject);
begin
  mnuCopy.Enabled := lvCracked.SelCount > 0;
  mnuSave.Enabled := (lvCracked.Items.Count > 0) and (not bStarted);
  mnuDeleteCracked.Enabled := lvCracked.SelCount > 0;
  mnuClearCracked.Enabled := lvCracked.Items.Count > 0;
  mnuSortRemoveDuplicatedCracked.Enabled := lvCracked.Items.Count > 1;
end;

procedure TfrmMain.mnuAddUncrackedClick(Sender: TObject);
var
  s: String;
begin
  if InputQuery('Add MD5 Hash', 'Enter the MD5 Hash!', s) then
    if IsValidMD5Hash(s) then AddUncracked(s);
end;

procedure TfrmMain.mnuEditUncrackedClick(Sender: TObject);
var
  s: String;
begin
  if InputQuery('Edit MD5 Hash', 'Enter the new MD5 Hash!', s) then
    if IsValidMD5Hash(s) then
      with lvUncracked.Selected do
      begin
        Caption := s;
        SubItems[0] := '';
      end;
end;

procedure TfrmMain.mnuLoadUncrackedClick(Sender: TObject);
var
  i: Integer;
begin
  if dlgOpen.Execute then
    if dlgOpen.Files.Count > 0 then
    begin
      lvUncracked.Items.BeginUpdate;
      try
        for i := 0 to Pred(dlgOpen.Files.Count) do
          LoadUncracked(dlgOpen.Files[i]);
      finally
        lvUncracked.Items.EndUpdate;
      end;
    end;
end;

procedure TfrmMain.mnuSaveUncrackedClick(Sender: TObject);
begin
  if dlgSave.Execute then
    if not SaveLV(lvUncracked, dlgSave.FileName, False) then
      Application.MessageBox('Unable to save!', 'Error', MB_ICONSTOP);
end;

procedure TfrmMain.mnuCopyUncrackedClick(Sender: TObject);
begin
  ClipBoard.AsText := lvUncracked.Selected.Caption;
end;

procedure TfrmMain.mnuDeleteUncrackedClick(Sender: TObject);
begin
  lvUncracked.DeleteSelected;
end;

procedure TfrmMain.mnuClearUncrackedClick(Sender: TObject);
begin
  lvUncracked.Clear;
end;

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

procedure TfrmMain.mnuSortRemoveDuplicatedUncrackedClick(Sender: TObject);
begin
  RemoveDuplicates(lvUncracked);
end;

procedure TfrmMain.mnuCopyMD5HashClick(Sender: TObject);
begin
  ClipBoard.AsText := lvCracked.Selected.Caption;
end;

procedure TfrmMain.mnuCopyPlainTextClick(Sender: TObject);
begin
  ClipBoard.AsText := lvCracked.Selected.SubItems[0];
end;

procedure TfrmMain.mnuCopyBothClick(Sender: TObject);
begin
  ClipBoard.AsText := lvCracked.Selected.Caption + ':' + lvCracked.Selected.SubItems[0];
end;

procedure TfrmMain.mnuSaveMD5HashesClick(Sender: TObject);
begin
  if dlgSave.Execute then
    if not SaveLV(lvCracked, dlgSave.FileName, False) then
      Application.MessageBox('Unable to save!', 'Error', MB_ICONSTOP);
end;

procedure TfrmMain.mnuDeleteCrackedClick(Sender: TObject);
begin
  lvCracked.DeleteSelected;
end;

procedure TfrmMain.mnuClearCrackedClick(Sender: TObject);
begin
  lvCracked.Clear;
end;

procedure TfrmMain.mnuSortRemoveDuplicatedCrackedClick(Sender: TObject);
begin
  RemoveDuplicates(lvCracked);
end;

procedure TfrmMain.mnuSavePlainTextsClick(Sender: TObject);
var
  t: TextFile;
  i: Integer;
begin
  if dlgSave.Execute then
  begin
    AssignFile(t, dlgSave.FileName);
    try
      ReWrite(t);
      try
        for i := 0 to Pred(lvCracked.Items.Count) do
          WriteLn(t, lvCracked.Items[i].SubItems[0]);
      finally
        CloseFile(t);
      end;
    except
      Application.MessageBox('Unable to save!', 'Error', MB_ICONSTOP);
    end;
  end;
end;

procedure TfrmMain.mnuSaveBothClick(Sender: TObject);
var
  t: TextFile;
  i: Integer;
begin
  if dlgSave.Execute then
  begin
    AssignFile(t, dlgSave.FileName);
    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
      Application.MessageBox('Unable to save!', 'Error', MB_ICONSTOP);
    end;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  INI: TIniFile;
begin
  btnCheckAllClick(Self);
  INI := TIniFile.Create(AppPath + 'settings.ini');
  try
    with INI do
    begin
      udThreads.Position := ReadInteger('Settings', 'Threads', 10);
      udTimeout.Position := ReadInteger('Settings', 'Timeout', 30);
      chkSaveHashlists.Checked := ReadBool('Settings', 'SaveHashlists', True);
      chkAutoscroll.Checked := ReadBool('Settings', 'SaveSettings', True);
    end;
  finally
    INI.Free;
  end;
  LoadUncracked(AppPath + 'uncracked.txt');
  LoadCracked;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  INI: TIniFile;
begin
  INI := TIniFile.Create(AppPath + 'settings.ini');
  try
    with INI do
    begin
      WriteInteger('Settings', 'Threads', udThreads.Position);
      WriteInteger('Settings', 'Timeout', udTimeout.Position);
      WriteBool('Settings', 'SaveHashlists', chkSaveHashlists.Checked);
      WriteBool('Settings', 'SaveSettings', chkAutoscroll.Checked);
    end;
  finally
    INI.Free;
  end;
  if chkSaveHashlists.Checked then
  begin
    SaveLV(lvUncracked, AppPath + 'uncracked.txt', False);
    SaveCracked;
  end;
end;

end.