20-01-2013, 11:04 PM
السلام عليكم
وجدت سورس كود برنامج لكسر باسورد البالتوك
متطلبات الكسر اليوزر نيم + الباسورد مشفر + سريال نمبر الهارد ديسك
لكن واجهت مشكلة أن البرنامج إذا كان النك نيم عربي لا يتم كسره بشكل صحيح
هذا الكود
أنا حاولت وبحثت أعتقد أن المشكلة في الإسم العربي يجب تحويله إلى unicode قبل عمليه إضافته مع السريال نمبر
لكن لم أعرف إضافتها
أكيد يوجد طريقة لأن برنامج البالتوك نفسه يفتحها
وجدت سورس كود برنامج لكسر باسورد البالتوك
متطلبات الكسر اليوزر نيم + الباسورد مشفر + سريال نمبر الهارد ديسك
لكن واجهت مشكلة أن البرنامج إذا كان النك نيم عربي لا يتم كسره بشكل صحيح
كود :
//This soruce by restive98
// i just added it to my project
// download soruce code form http://www.opensc.ws/delphi-snippets/4326-paltalk-password-decrypter.html
// Abdulrhman-MJ
unit PalPassUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry, XPMan;
type
TPalPass = class(TForm)
UsersCombo: TComboBox;
Label3: TLabel;
SerialLabel1: TStaticText;
EncPassLabel1: TStaticText;
DecPassLabel3: TStaticText;
XPManifest1: TXPManifest;
DecPassLabel: TEdit;
EncPassLabel: TEdit;
SerialLabel: TEdit;
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label5: TLabel;
Button1: TButton;
Edit4: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
procedure FormShow(Sender: TObject);
procedure UsersComboChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function GetVolumeSerial: string;
function GivePassword(UserName, EncPass, VolumeSerial: string): string;
public
{ Public declarations }
end;
var
PalPass: TPalPass;
implementation
uses StrUtils;
{$R *.dfm}
function TPalPass.GivePassword(UserName, EncPass,
VolumeSerial: string): string;
var
i,j,k: Integer;
MixedUserSerial: string;
begin
while (Length(UserName)+Length(VolumeSerial)>0) do
begin
if Length(UserName)>0 then
begin
MixedUserSerial := MixedUserSerial + LeftStr(UserName,1);
Delete(UserName,1,1);
end;
if Length(VolumeSerial)>0 then
begin
MixedUserSerial := MixedUserSerial + LeftStr(VolumeSerial,1);
Delete(VolumeSerial,1,1);
end;
end;
i := Length(MixedUserSerial);
MixedUserSerial := MixedUserSerial + MixedUserSerial + MixedUserSerial;
j := 0;
while Length(EncPass)>0 do
begin
k := StrToInt(LeftStr(EncPass,3));
Delete(EncPass,1,4);
k := k - j - $7A - Byte(MixedUserSerial[i]);
Result := Result + Char(k);
Inc(j);
Inc(i);
end;
end;
procedure TPalPass.Button1Click(Sender: TObject);
begin
edit4.text := GivePassword(Edit1.Text,Edit2.text,edit3.text);
end;
procedure TPalPass.FormCreate(Sender: TObject);
begin
Left:=(Screen.Width-Width) div 2;
Top:=(Screen.Height-Height) div 2;
end;
procedure TPalPass.FormShow(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
if Reg.OpenKey('\Software\Paltalk',False) then
begin
Reg.GetKeyNames(UsersCombo.Items);
if UsersCombo.Items.Count>0 then
UsersCombo.ItemIndex := UsersCombo.Items.IndexOf(Reg.ReadString('cur_user'));
Reg.CloseKey;
end;
Reg.Free;
SerialLabel.text := GetVolumeSerial;
UsersComboChange(Self);
end;
function TPalPass.GetVolumeSerial: string;
var
SerialNo: Cardinal;
Tmp: Cardinal;
begin
GetVolumeInformation('C:\',nil,0,@SerialNo,Tmp,Tmp,nil,0);
Result := IntToHex(SerialNo,8);
end;
procedure TPalPass.UsersComboChange(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
Reg.OpenKey('\Software\Paltalk\'+UsersCombo.Text,False);
EncPassLabel.text := Reg.ReadString('pwd');
Reg.CloseKey;
Reg.Free;
DecPassLabel.text := GivePassword(UsersCombo.Text,EncPassLabel.text,SerialLabel.text);
end;
end.هذا الكود
أنا حاولت وبحثت أعتقد أن المشكلة في الإسم العربي يجب تحويله إلى unicode قبل عمليه إضافته مع السريال نمبر
لكن لم أعرف إضافتها
أكيد يوجد طريقة لأن برنامج البالتوك نفسه يفتحها