В свою очередь делюсь: модуль для извлечения паролей из Protected Storage И файл интерфейсов к нему:
Код:
unit OutlookDecrypt;
interface
uses
Windows,
PStorageIntfs;//заголовочный файл
function GetOutlookPass: string;
implementation
type
PTChar = ^Char;
TMyGUID = array of TGUID;
TPStoreCreateInstance = function(var ppProvider: IPStore; pProviderID: PGUID; pReserved: Pointer; dwFlags: DWORD): HRESULT; stdcall;
var
FLibrary: THandle;
PStoreCreateInstance: TPStoreCreateInstance;
FProvider: IPStore;
Pass: string;
procedure CoTaskMemFree(pv: Pointer); stdcall; external 'ole32.dll' name 'CoTaskMemFree';
function StringFromCLSID(const clsid: TGUID; out psz: PWideChar): HResult; stdcall; external 'ole32.dll' name 'StringFromCLSID';
function PStorageConnect: Boolean;// Соединяемся с хранилищем
begin
Result := False;
if (PStoreCreateInstance(FProvider, nil, nil, 0) <> S_OK) or (FProvider = nil) then
begin
FProvider := nil;
Exit;
end;
Result := True;
end;
function InitLib: boolean;//Пытаемся загрузить функцию
begin
result:=false;
FLibrary := LoadLibrary('pstorec.dll');
if FLibrary = 0 then Exit;
PStoreCreateInstance := GetProcAddress(FLibrary, 'PStoreCreateInstance');
if @PStoreCreateInstance = nil then
begin
FreeLibrary(FLibrary);
exit;
end;
result:=true;
end;
function PStorageGetProviderInfo: TProviderInfo;
var
ppInfo: PUserType1;
begin
if FProvider.GetInfo(ppInfo) = S_OK then
begin
Result.GUID := ppInfo.ID;
Result.Capabilities := ppInfo.Capabilities;
Result.ProviderName := String(ppInfo.szProviderName);
end;
end;
function PStorageGetTypeName(pGUID: TGUID): String;
var
pst: PUserType3;
begin
pst := nil;
if (FProvider.GetTypeInfo(0, pGUID, pst, 0) = S_OK) and (pst <> nil) then
begin
Result := String(pst^.szDisplayName);
CoTaskMemFree(pst);
end;
end;
function PStorageGetSubtypeName(pType, pSubtype: TGUID): String;
var
pst: PUserType3;
begin
pst := nil;
if (FProvider.GetSubtypeInfo(0, pType, pSubType, pst, 0) = S_OK) and (pst <> nil) then
begin
Result := String(pst^.szDisplayName);
CoTaskMemFree(pst);
end;
end;
function FillPromptInfoStruct: _PST_PROMPTINFO;
begin
Result.cbSize := SizeOf(_PST_PROMPTINFO);
Result.dwPromptFlags := 4;
Result.hwndApp := 0;
Result.szPrompt := '';
end;
function PStorageReadItemData(pType, pSubtype: TGUID; pItem: ShortString; var Data: Pointer; var DataLen: LongWord): Boolean;
var
pspi: _PST_PROMPTINFO;
begin
pspi := FillPromptInfoStruct;
DataLen := 0;
Data := nil;
Result := FProvider.ReadItem(0, pType, pSubtype, StringToOleStr(pItem), DataLen, Data, pspi, 0) = S_OK;
end;
function DumpData(Buffer: Pointer; BufLen: DWord): String;
var
i, j, c: Integer;
begin
c := 0;
Result := '';
for i := 1 to BufLen div 16 do
begin
for j := c to c + 15 do
if (PByte(Integer(Buffer) + j)^ < $20) or (PByte(Integer(Buffer) + j)^ > $7F) then
Result := Result + '.'
else
Result := Result + PTChar(Integer(Buffer) + j)^;
c := c + 16;
// Result := Result + #13#10;
end;
if BufLen mod 16 <> 0 then
for i := BufLen mod 16 downto 1 do
if (PByte(Integer(Buffer) + Integer(BufLen) - i)^ < $20) or (PByte(Integer(Buffer) + Integer(BufLen) - i)^ > $7F) then
// Result := Result + '.'
else
Result := Result + PTChar(Integer(Buffer) + Integer(BufLen) - i)^;
end;
function GUIDToString(const GUID: TGUID): string;
var
P: PWideChar;
begin
if not Succeeded(StringFromCLSID(GUID, P)) then exit;
Result := P;
CoTaskMemFree(P);
end;
procedure ReadValue(Caption:string; flag: byte; pType, pSubType: TGUID);
var
Mem: Pointer;
MemLen: Cardinal;
// i:integer;
begin
case flag of
{ 0: //ветвь
pass:=pass+#13#10+Caption+': ' + GUIDToString(pType)+#13#10;
1: //подветвь
pass:=pass+Caption+': ' + GUIDToString(pSubType)+#13#10;}
2: //значения
begin
if PStorageReadItemData(pType, pSubtype, Caption, Mem, MemLen) and (Mem <> nil) then
begin
Caption[length(Caption)-7]:=#0;
Caption:=PChar(Caption);
pass:=pass+'Data('+Caption+'):Pass('+DumpData(Mem, MemLen)+'); '; //hex->ASCII
CoTaskMemFree(Mem);
end;// else
// pass:=pass+'Coult not read item data'+#13#10;
end;
end;
end;
procedure ExpandPSProvider;
var
ppEnum: IEnumPStoreTypes;
ppEnumItems: IEnumPStoreItems;
GUIDBuf: array[0..15] of TGUID;
ItemBuf: array[0..15] of PWideChar;
ItemsRead: Cardinal;
TypesList: TMyGUID;
SubtypesList: TMyGUID;
ItemsList: array of string;
i3, i2, i, j, k: Integer;
pType: PStorageType;
pSubtype: PStorageSubType;
pItem: PStorageItem;
begin
//получаем корень
// pass:='Connected to ' + PStorageGetProviderInfo.ProviderName + '...'#13#10;
//Загоняем в TypesList интерфейс главных ветвей
ppEnum := nil;
if (FProvider.EnumTypes(0, 0, ppEnum) <> S_OK) or (ppEnum = nil) then
begin
Exit;
ppEnum := nil;
end;
ItemsRead := 0;
repeat
ppEnum.Next(SizeOf(GUIDBuf) div SizeOf(GUIDBuf[0]), GUIDBuf[0], ItemsRead);
if ItemsRead > 0 then
begin
SetLength(TypesList,ItemsRead);
for i := 0 to ItemsRead-1 do TypesList[i]:=GUIDBuf[i];
end;
until ItemsRead = 0;
ppEnum := nil;
//Считываем значения главных ветвей
for i := 0 to high(TypesList) do
begin
New(pType);
pType.T := 0;
pType.pType := TypesList[i];
ReadValue(PStorageGetTypeName(TypesList[i]), 0, pType.pType, pType.pType);
//Забираем из главных ветвей подветви в SubTypesList
ppEnum := nil;
if (FProvider.EnumSubTypes(0, pType.pType, 0, ppEnum) <> S_OK) or (ppEnum = nil) then
begin
Exit;
ppEnum := nil;
end;
ItemsRead := 0;
repeat
ppEnum.Next(SizeOf(GUIDBuf) div SizeOf(GUIDBuf[0]), GUIDBuf[0], ItemsRead);
if ItemsRead > 0 then
begin
SetLength(SubTypesList,ItemsRead);
for i2 := 0 to ItemsRead-1 do SubtypesList[i2]:=GUIDBuf[i2];
end;
until ItemsRead = 0;
ppEnum := nil;
//Считываем значения подветвей
for j := 0 to high(SubtypesList) do
begin
New(pSubtype);
pSubtype.T := 1;
pSubtype.pType := pType.pType;
pSubtype.pSubtype := SubTypesList[j];
ReadValue(PStorageGetSubtypeName(pType.pType,pSubtype.pSubtype), 1, pType.pType, pSubtype.pSubtype);
//Забираем значения подветвей в ItemsList
ppEnumItems := nil;
if (FProvider.EnumItems(0, pType.pType, pSubtype.pSubtype, 0, ppEnumItems) <> S_OK) or (ppEnumItems = nil) then
begin
Exit;
ppEnumItems := nil;
end;
ItemsRead := 0;
repeat
ppEnumItems.Next(SizeOf(ItemBuf) div SizeOf(ItemBuf[0]), ItemBuf[0], ItemsRead);
if ItemsRead > 0 then
begin
SetLength(ItemsList,ItemsRead);
for i3 := 0 to ItemsRead-1 do
begin
ItemsList[i3]:=String(ItemBuf[i3]);
CoTaskMemFree(ItemBuf[i3]);
end;
end;
until ItemsRead = 0;
ppEnumItems := nil;
//Считываем то, ради чего всё и затеяли
for k := 0 to high(ItemsList) do
begin
New(pItem);
pItem.T := 2;
pItem.pType := pType.pType;
pItem.pSubtype := pSubtype.pSubtype;
pItem.pItem := ItemsList[k];
ReadValue(pItem.pItem, 2, pType.pType, pSubtype.pSubtype);
end;
end;
end;
end;
function GetOutlookPass: string;
begin
if not(InitLib) then exit; //подгружаем dll
if not(PStorageConnect) then exit; //соединяемся
ExpandPSProvider; //получаем данные
//Завершаем работу..
FProvider:=nil;
FreeLibrary(FLibrary);
result:=pass;
end;
end.